--- /dev/null
+/* 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)
+{
+}
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* do not edit automatically generated by mc from ASCII. */
+/* ASCII.mod dummy companion module for the definition.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _ASCII_H
+#define _ASCII_C
+
+
+# define ASCII_nul (char) 000
+# define ASCII_soh (char) 001
+# define ASCII_stx (char) 002
+# define ASCII_etx (char) 003
+# define ASCII_eot (char) 004
+# define ASCII_enq (char) 005
+# define ASCII_ack (char) 006
+# define ASCII_bel (char) 007
+# define ASCII_bs (char) 010
+# define ASCII_ht (char) 011
+# define ASCII_nl (char) 012
+# define ASCII_vt (char) 013
+# define ASCII_np (char) 014
+# define ASCII_cr (char) 015
+# define ASCII_so (char) 016
+# define ASCII_si (char) 017
+# define ASCII_dle (char) 020
+# define ASCII_dc1 (char) 021
+# define ASCII_dc2 (char) 022
+# define ASCII_dc3 (char) 023
+# define ASCII_dc4 (char) 024
+# define ASCII_nak (char) 025
+# define ASCII_syn (char) 026
+# define ASCII_etb (char) 027
+# define ASCII_can (char) 030
+# define ASCII_em (char) 031
+# define ASCII_sub (char) 032
+# define ASCII_esc (char) 033
+# define ASCII_fs (char) 034
+# define ASCII_gs (char) 035
+# define ASCII_rs (char) 036
+# define ASCII_us (char) 037
+# define ASCII_sp (char) 040
+# define ASCII_lf ASCII_nl
+# define ASCII_ff ASCII_np
+# define ASCII_eof ASCII_eot
+# define ASCII_tab ASCII_ht
+# define ASCII_del (char) 0177
+# define ASCII_EOL ASCII_nl
+
+extern "C" void _M2_ASCII_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_ASCII_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Args. */
+/* Args.mod provide access to command line arguments.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Args_H
+#define _Args_C
+
+# include "GUnixArgs.h"
+# include "GASCII.h"
+
+# define MaxArgs 255
+# define MaxString 4096
+typedef struct Args__T2_a Args__T2;
+
+typedef Args__T2 *Args__T1;
+
+typedef struct Args__T3_a Args__T3;
+
+struct Args__T2_a { Args__T3 * array[MaxArgs+1]; };
+struct Args__T3_a { char array[MaxString+1]; };
+static Args__T1 Source;
+
+/*
+ GetArg - returns the nth argument from the command line.
+ The success of the operation is returned.
+*/
+
+extern "C" unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n);
+
+/*
+ Narg - returns the number of arguments available from
+ command line.
+*/
+
+extern "C" unsigned int Args_Narg (void);
+
+
+/*
+ GetArg - returns the nth argument from the command line.
+ The success of the operation is returned.
+*/
+
+extern "C" unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n)
+{
+ int i;
+ unsigned int High;
+ unsigned int j;
+
+ i = (int ) (n);
+ j = 0;
+ High = _a_high;
+ if (i < (UnixArgs_GetArgC ()))
+ {
+ Source = static_cast<Args__T1> (UnixArgs_GetArgV ());
+ while ((j < High) && ((*(*Source).array[i]).array[j] != ASCII_nul))
+ {
+ a[j] = (*(*Source).array[i]).array[j];
+ j += 1;
+ }
+ }
+ if (j <= High)
+ {
+ a[j] = ASCII_nul;
+ }
+ return i < (UnixArgs_GetArgC ());
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Narg - returns the number of arguments available from
+ command line.
+*/
+
+extern "C" unsigned int Args_Narg (void)
+{
+ return UnixArgs_GetArgC ();
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_Args_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Args_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Assertion. */
+/* Assertion.mod provides an assert procedure.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Assertion_H
+#define _Assertion_C
+
+# include "GStrIO.h"
+# include "GM2RTS.h"
+
+
+/*
+ Assert - tests the boolean Condition, if it fails then HALT is called.
+*/
+
+extern "C" void Assertion_Assert (unsigned int Condition);
+
+
+/*
+ Assert - tests the boolean Condition, if it fails then HALT is called.
+*/
+
+extern "C" void Assertion_Assert (unsigned int Condition)
+{
+ if (! Condition)
+ {
+ StrIO_WriteString ((const char *) "assert failed - halting system", 30);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+extern "C" void _M2_Assertion_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Assertion_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Break. */
+/* Break.mod provides a dummy compatibility library for legacy systems.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Break_H
+#define _Break_C
+
+
+
+extern "C" void _M2_Break_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Break_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from CmdArgs. */
+/* CmdArgs.mod provides procedures to retrieve arguments from strings.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _CmdArgs_H
+#define _CmdArgs_C
+
+# include "GASCII.h"
+# include "GStrLib.h"
+
+# define esc '\\'
+# define space ' '
+# define squote '\''
+# define dquote '"'
+# define tab ' '
+
+/*
+ GetArg - takes a command line and attempts to extract argument, n,
+ from CmdLine. The resulting argument is placed into, a.
+ The result of the operation is returned.
+*/
+
+extern "C" unsigned int CmdArgs_GetArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int n, char *Argi, unsigned int _Argi_high);
+
+/*
+ Narg - returns the number of arguments available from
+ command line, CmdLine.
+*/
+
+extern "C" unsigned int CmdArgs_Narg (const char *CmdLine_, unsigned int _CmdLine_high);
+
+/*
+ GetNextArg - Returns true if another argument may be found.
+ The argument is taken from CmdLine at position Index,
+ Arg is filled with the found argument.
+*/
+
+static unsigned int GetNextArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int *CmdIndex, char *Arg, unsigned int _Arg_high);
+
+/*
+ CopyUntilSpace - copies characters until a Space character is found.
+*/
+
+static void CopyUntilSpace (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh);
+
+/*
+ CopyUntil - copies characters until the UntilChar is found.
+*/
+
+static void CopyUntil (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh, char UntilChar);
+
+/*
+ CopyChar - copies a character from string From to string To and
+ takes into consideration escape characters. ie \x
+ Where x is any character.
+*/
+
+static void CopyChar (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh);
+static unsigned int Escape (char ch);
+static unsigned int Space (char ch);
+static unsigned int DoubleQuote (char ch);
+static unsigned int SingleQuote (char ch);
+
+
+/*
+ GetNextArg - Returns true if another argument may be found.
+ The argument is taken from CmdLine at position Index,
+ Arg is filled with the found argument.
+*/
+
+static unsigned int GetNextArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int *CmdIndex, char *Arg, unsigned int _Arg_high)
+{
+ unsigned int ArgIndex;
+ unsigned int HighA;
+ unsigned int HighC;
+ char CmdLine[_CmdLine_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (CmdLine, CmdLine_, _CmdLine_high+1);
+
+ HighA = _Arg_high; /* Index into Arg */
+ HighC = StrLib_StrLen ((const char *) CmdLine, _CmdLine_high);
+ ArgIndex = 0;
+ /* Skip spaces */
+ while (((*CmdIndex) < HighC) && (Space (CmdLine[(*CmdIndex)])))
+ {
+ (*CmdIndex) += 1;
+ }
+ if ((*CmdIndex) < HighC)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (SingleQuote (CmdLine[(*CmdIndex)]))
+ {
+ /* Skip over the single quote */
+ (*CmdIndex) += 1;
+ CopyUntil ((const char *) CmdLine, _CmdLine_high, CmdIndex, HighC, (char *) Arg, _Arg_high, &ArgIndex, HighA, squote);
+ (*CmdIndex) += 1;
+ }
+ else if (DoubleQuote (CmdLine[(*CmdIndex)]))
+ {
+ /* avoid dangling else. */
+ /* Skip over the double quote */
+ (*CmdIndex) += 1;
+ CopyUntil ((const char *) CmdLine, _CmdLine_high, CmdIndex, HighC, (char *) Arg, _Arg_high, &ArgIndex, HighA, dquote);
+ (*CmdIndex) += 1;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ CopyUntilSpace ((const char *) CmdLine, _CmdLine_high, CmdIndex, HighC, (char *) Arg, _Arg_high, &ArgIndex, HighA);
+ }
+ }
+ /* Skip spaces */
+ while (((*CmdIndex) < HighC) && (Space (CmdLine[(*CmdIndex)])))
+ {
+ (*CmdIndex) += 1;
+ }
+ if (ArgIndex < HighA)
+ {
+ Arg[ArgIndex] = ASCII_nul;
+ }
+ return (*CmdIndex) < HighC;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CopyUntilSpace - copies characters until a Space character is found.
+*/
+
+static void CopyUntilSpace (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh)
+{
+ char From[_From_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (From, From_, _From_high+1);
+
+ while ((((*FromIndex) < FromHigh) && ((*ToIndex) < ToHigh)) && (! (Space (From[(*FromIndex)]))))
+ {
+ CopyChar ((const char *) From, _From_high, FromIndex, FromHigh, (char *) To, _To_high, ToIndex, ToHigh);
+ }
+}
+
+
+/*
+ CopyUntil - copies characters until the UntilChar is found.
+*/
+
+static void CopyUntil (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh, char UntilChar)
+{
+ char From[_From_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (From, From_, _From_high+1);
+
+ while ((((*FromIndex) < FromHigh) && ((*ToIndex) < ToHigh)) && (From[(*FromIndex)] != UntilChar))
+ {
+ CopyChar ((const char *) From, _From_high, FromIndex, FromHigh, (char *) To, _To_high, ToIndex, ToHigh);
+ }
+}
+
+
+/*
+ CopyChar - copies a character from string From to string To and
+ takes into consideration escape characters. ie \x
+ Where x is any character.
+*/
+
+static void CopyChar (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh)
+{
+ char From[_From_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (From, From_, _From_high+1);
+
+ if (((*FromIndex) < FromHigh) && ((*ToIndex) < ToHigh))
+ {
+ if (Escape (From[(*FromIndex)]))
+ {
+ /* Skip over Escape Character */
+ (*FromIndex) += 1;
+ }
+ if ((*FromIndex) < FromHigh)
+ {
+ /* Copy Normal Character */
+ To[(*ToIndex)] = From[(*FromIndex)];
+ (*ToIndex) += 1;
+ (*FromIndex) += 1;
+ }
+ }
+}
+
+static unsigned int Escape (char ch)
+{
+ return ch == esc;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+static unsigned int Space (char ch)
+{
+ return (ch == space) || (ch == tab);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+static unsigned int DoubleQuote (char ch)
+{
+ return ch == dquote;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+static unsigned int SingleQuote (char ch)
+{
+ return ch == squote;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetArg - takes a command line and attempts to extract argument, n,
+ from CmdLine. The resulting argument is placed into, a.
+ The result of the operation is returned.
+*/
+
+extern "C" unsigned int CmdArgs_GetArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int n, char *Argi, unsigned int _Argi_high)
+{
+ unsigned int Index;
+ unsigned int i;
+ unsigned int Another;
+ char CmdLine[_CmdLine_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (CmdLine, CmdLine_, _CmdLine_high+1);
+
+ Index = 0;
+ /* Continually retrieve an argument until we get the n th argument. */
+ i = 0;
+ do {
+ Another = GetNextArg ((const char *) CmdLine, _CmdLine_high, &Index, (char *) Argi, _Argi_high);
+ i += 1;
+ } while (! ((i > n) || ! Another));
+ return i > n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Narg - returns the number of arguments available from
+ command line, CmdLine.
+*/
+
+extern "C" unsigned int CmdArgs_Narg (const char *CmdLine_, unsigned int _CmdLine_high)
+{
+ typedef struct Narg__T1_a Narg__T1;
+
+ struct Narg__T1_a { char array[1000+1]; };
+ Narg__T1 a;
+ unsigned int ArgNo;
+ char CmdLine[_CmdLine_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (CmdLine, CmdLine_, _CmdLine_high+1);
+
+ ArgNo = 0;
+ while (CmdArgs_GetArg ((const char *) CmdLine, _CmdLine_high, ArgNo, (char *) &a.array[0], 1000))
+ {
+ ArgNo += 1;
+ }
+ /*
+ IF ArgNo>0
+ THEN
+ DEC(ArgNo)
+ END ;
+ */
+ return ArgNo;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_CmdArgs_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_CmdArgs_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Debug. */
+/* Debug.mod provides some simple debugging routines.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Debug_H
+#define _Debug_C
+
+# include "GASCII.h"
+# include "GNumberIO.h"
+# include "GStdIO.h"
+# include "Glibc.h"
+# include "GM2RTS.h"
+
+# define MaxNoOfDigits 12
+
+/*
+ Halt - writes a message in the format:
+ Module:Line:Message
+
+ It then terminates by calling HALT.
+*/
+
+extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high);
+
+/*
+ DebugString - writes a string to the debugging device (Scn.Write).
+ It interprets
+ as carriage return, linefeed.
+*/
+
+extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high);
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+static void WriteLn (void);
+
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+static void WriteLn (void)
+{
+ StdIO_Write (ASCII_cr);
+ StdIO_Write (ASCII_lf);
+}
+
+
+/*
+ Halt - writes a message in the format:
+ Module:Line:Message
+
+ It then terminates by calling HALT.
+*/
+
+extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high)
+{
+ typedef struct Halt__T1_a Halt__T1;
+
+ struct Halt__T1_a { char array[MaxNoOfDigits+1]; };
+ Halt__T1 No;
+ char Message[_Message_high+1];
+ char Module[_Module_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (Message, Message_, _Message_high+1);
+ memcpy (Module, Module_, _Module_high+1);
+
+ Debug_DebugString ((const char *) Module, _Module_high); /* should be large enough for most source files.. */
+ NumberIO_CardToStr (LineNo, 0, (char *) &No.array[0], MaxNoOfDigits);
+ Debug_DebugString ((const char *) ":", 1);
+ Debug_DebugString ((const char *) &No.array[0], MaxNoOfDigits);
+ Debug_DebugString ((const char *) ":", 1);
+ Debug_DebugString ((const char *) Message, _Message_high);
+ Debug_DebugString ((const char *) "\\n", 2);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ DebugString - writes a string to the debugging device (Scn.Write).
+ It interprets
+ as carriage return, linefeed.
+*/
+
+extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high)
+{
+ unsigned int n;
+ unsigned int high;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ high = _a_high;
+ n = 0;
+ while ((n <= high) && (a[n] != ASCII_nul))
+ {
+ if (a[n] == '\\')
+ {
+ /* avoid dangling else. */
+ if ((n+1) <= high)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a[n+1] == 'n')
+ {
+ WriteLn ();
+ n += 1;
+ }
+ else if (a[n+1] == '\\')
+ {
+ /* avoid dangling else. */
+ StdIO_Write ('\\');
+ n += 1;
+ }
+ }
+ }
+ else
+ {
+ StdIO_Write (a[n]);
+ }
+ n += 1;
+ }
+}
+
+extern "C" void _M2_Debug_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Debug_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from DynamicStrings. */
+/* DynamicStrings.mod provides a dynamic string type and procedures.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _DynamicStrings_H
+#define _DynamicStrings_C
+
+# include "Glibc.h"
+# include "GStrLib.h"
+# include "GStorage.h"
+# include "GAssertion.h"
+# include "GSYSTEM.h"
+# include "GASCII.h"
+# include "GM2RTS.h"
+
+# define MaxBuf 127
+# define PoisonOn FALSE
+# define DebugOn FALSE
+# define CheckOn FALSE
+# define TraceOn FALSE
+typedef struct DynamicStrings_Contents_r DynamicStrings_Contents;
+
+typedef struct DynamicStrings_DebugInfo_r DynamicStrings_DebugInfo;
+
+typedef struct DynamicStrings_stringRecord_r DynamicStrings_stringRecord;
+
+typedef struct DynamicStrings_descriptor_r DynamicStrings_descriptor;
+
+typedef DynamicStrings_descriptor *DynamicStrings_Descriptor;
+
+typedef struct DynamicStrings_frameRec_r DynamicStrings_frameRec;
+
+typedef DynamicStrings_frameRec *DynamicStrings_frame;
+
+typedef struct DynamicStrings__T3_a DynamicStrings__T3;
+
+typedef enum {DynamicStrings_inuse, DynamicStrings_marked, DynamicStrings_onlist, DynamicStrings_poisoned} DynamicStrings_desState;
+
+typedef DynamicStrings_stringRecord *DynamicStrings_String;
+
+struct DynamicStrings_DebugInfo_r {
+ DynamicStrings_String next;
+ void *file;
+ unsigned int line;
+ void *proc;
+ };
+
+struct DynamicStrings_descriptor_r {
+ unsigned int charStarUsed;
+ void *charStar;
+ unsigned int charStarSize;
+ unsigned int charStarValid;
+ DynamicStrings_desState state;
+ DynamicStrings_String garbage;
+ };
+
+struct DynamicStrings_frameRec_r {
+ DynamicStrings_String alloc;
+ DynamicStrings_String dealloc;
+ DynamicStrings_frame next;
+ };
+
+struct DynamicStrings__T3_a { char array[(MaxBuf-1)+1]; };
+struct DynamicStrings_Contents_r {
+ DynamicStrings__T3 buf;
+ unsigned int len;
+ DynamicStrings_String next;
+ };
+
+struct DynamicStrings_stringRecord_r {
+ DynamicStrings_Contents contents;
+ DynamicStrings_Descriptor head;
+ DynamicStrings_DebugInfo debug;
+ };
+
+static unsigned int Initialized;
+static DynamicStrings_frame frameHead;
+static DynamicStrings_String captured;
+
+/*
+ InitString - creates and returns a String type object.
+ Initial contents are, a.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high);
+
+/*
+ KillString - frees String, s, and its contents.
+ NIL is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s);
+
+/*
+ Fin - finishes with a string, it calls KillString with, s.
+ The purpose of the procedure is to provide a short cut
+ to calling KillString and then testing the return result.
+*/
+
+extern "C" void DynamicStrings_Fin (DynamicStrings_String s);
+
+/*
+ InitStringCharStar - initializes and returns a String to contain the C string.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a);
+
+/*
+ InitStringChar - initializes and returns a String to contain the single character, ch.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch);
+
+/*
+ Mark - marks String, s, ready for garbage collection.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s);
+
+/*
+ Length - returns the length of the String, s.
+*/
+
+extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s);
+
+/*
+ ConCat - returns String, a, after the contents of, b, have been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ ConCatChar - returns String, a, after character, ch, has been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch);
+
+/*
+ Assign - assigns the contents of, b, into, a.
+ String, a, is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ Dup - duplicate a String, s, returning the copy of s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s);
+
+/*
+ Add - returns a new String which contains the contents of a and b.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ Equal - returns TRUE if String, a, and, b, are equal.
+*/
+
+extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ EqualCharStar - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a);
+
+/*
+ EqualArray - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high);
+
+/*
+ Mult - returns a new string which is n concatenations of String, s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n);
+
+/*
+ Slice - returns a new string which contains the elements
+ low..high-1
+
+ strings start at element 0
+ Slice(s, 0, 2) will return elements 0, 1 but not 2
+ Slice(s, 1, 3) will return elements 1, 2 but not 3
+ Slice(s, 2, 0) will return elements 2..max
+ Slice(s, 3, -1) will return elements 3..max-1
+ Slice(s, 4, -2) will return elements 4..max-2
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high);
+
+/*
+ Index - returns the indice of the first occurance of, ch, in
+ String, s. -1 is returned if, ch, does not exist.
+ The search starts at position, o.
+*/
+
+extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o);
+
+/*
+ RIndex - returns the indice of the last occurance of, ch,
+ in String, s. The search starts at position, o.
+ -1 is returned if, ch, is not found.
+*/
+
+extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o);
+
+/*
+ RemoveComment - assuming that, comment, is a comment delimiter
+ which indicates anything to its right is a comment
+ then strip off the comment and also any white space
+ on the remaining right hand side.
+ It leaves any white space on the left hand side alone.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment);
+
+/*
+ RemoveWhitePrefix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s);
+
+/*
+ RemoveWhitePostfix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s);
+
+/*
+ ToUpper - returns string, s, after it has had its lower case characters
+ replaced by upper case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s);
+
+/*
+ ToLower - returns string, s, after it has had its upper case characters
+ replaced by lower case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s);
+
+/*
+ CopyOut - copies string, s, to a.
+*/
+
+extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s);
+
+/*
+ char - returns the character, ch, at position, i, in String, s.
+*/
+
+extern "C" char DynamicStrings_char (DynamicStrings_String s, int i);
+
+/*
+ string - returns the C style char * of String, s.
+*/
+
+extern "C" void * DynamicStrings_string (DynamicStrings_String s);
+
+/*
+ InitStringDB - the debug version of InitString.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ InitStringCharStarDB - the debug version of InitStringCharStar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ InitStringCharDB - the debug version of InitStringChar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ MultDB - the debug version of MultDB.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ DupDB - the debug version of Dup.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ SliceDB - debug version of Slice.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ PushAllocation - pushes the current allocation/deallocation lists.
+*/
+
+extern "C" void DynamicStrings_PushAllocation (void);
+
+/*
+ PopAllocation - test to see that all strings are deallocated since
+ the last push. Then it pops to the previous
+ allocation/deallocation lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" void DynamicStrings_PopAllocation (unsigned int halt);
+
+/*
+ PopAllocationExemption - test to see that all strings are deallocated, except
+ string, e, since the last push.
+ Then it pops to the previous allocation/deallocation
+ lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e);
+
+/*
+ writeStringDesc write out debugging information about string, s. */
+
+static void writeStringDesc (DynamicStrings_String s);
+
+/*
+ writeNspace -
+*/
+
+static void writeNspace (unsigned int n);
+
+/*
+ DumpStringInfo -
+*/
+
+static void DumpStringInfo (DynamicStrings_String s, unsigned int i);
+
+/*
+ DumpStringInfo -
+*/
+
+static void stop (void);
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void);
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s);
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void);
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s);
+static unsigned int Capture (DynamicStrings_String s);
+
+/*
+ Min -
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b);
+
+/*
+ Max -
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b);
+
+/*
+ writeString - writes a string to stdout.
+*/
+
+static void writeString (const char *a_, unsigned int _a_high);
+
+/*
+ writeCstring - writes a C string to stdout.
+*/
+
+static void writeCstring (void * a);
+
+/*
+ writeCard -
+*/
+
+static void writeCard (unsigned int c);
+
+/*
+ writeLongcard -
+*/
+
+static void writeLongcard (long unsigned int l);
+
+/*
+ writeAddress -
+*/
+
+static void writeAddress (void * a);
+
+/*
+ writeLn - writes a newline.
+*/
+
+static void writeLn (void);
+
+/*
+ AssignDebug - assigns, file, and, line, information to string, s.
+*/
+
+static DynamicStrings_String AssignDebug (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line, const char *proc_, unsigned int _proc_high);
+
+/*
+ IsOn - returns TRUE if, s, is on one of the debug lists.
+*/
+
+static unsigned int IsOn (DynamicStrings_String list, DynamicStrings_String s);
+
+/*
+ AddTo - adds string, s, to, list.
+*/
+
+static void AddTo (DynamicStrings_String *list, DynamicStrings_String s);
+
+/*
+ SubFrom - removes string, s, from, list.
+*/
+
+static void SubFrom (DynamicStrings_String *list, DynamicStrings_String s);
+
+/*
+ AddAllocated - adds string, s, to the head of the allocated list.
+*/
+
+static void AddAllocated (DynamicStrings_String s);
+
+/*
+ AddDeallocated - adds string, s, to the head of the deallocated list.
+*/
+
+static void AddDeallocated (DynamicStrings_String s);
+
+/*
+ IsOnAllocated - returns TRUE if the string, s, has ever been allocated.
+*/
+
+static unsigned int IsOnAllocated (DynamicStrings_String s);
+
+/*
+ IsOnDeallocated - returns TRUE if the string, s, has ever been deallocated.
+*/
+
+static unsigned int IsOnDeallocated (DynamicStrings_String s);
+
+/*
+ SubAllocated - removes string, s, from the list of allocated strings.
+*/
+
+static void SubAllocated (DynamicStrings_String s);
+
+/*
+ SubDeallocated - removes string, s, from the list of deallocated strings.
+*/
+
+static void SubDeallocated (DynamicStrings_String s);
+
+/*
+ SubDebugInfo - removes string, s, from the list of allocated strings.
+*/
+
+static void SubDebugInfo (DynamicStrings_String s);
+
+/*
+ AddDebugInfo - adds string, s, to the list of allocated strings.
+*/
+
+static void AddDebugInfo (DynamicStrings_String s);
+
+/*
+ ConcatContents - add the contents of string, a, where, h, is the
+ total length of, a. The offset is in, o.
+*/
+
+static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned int _a_high, unsigned int h, unsigned int o);
+
+/*
+ DeallocateCharStar - deallocates any charStar.
+*/
+
+static void DeallocateCharStar (DynamicStrings_String s);
+
+/*
+ CheckPoisoned - checks for a poisoned string, s.
+*/
+
+static DynamicStrings_String CheckPoisoned (DynamicStrings_String s);
+
+/*
+ MarkInvalid - marks the char * version of String, s, as invalid.
+*/
+
+static void MarkInvalid (DynamicStrings_String s);
+
+/*
+ ConcatContentsAddress - concatenate the string, a, where, h, is the
+ total length of, a.
+*/
+
+static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigned int h);
+
+/*
+ AddToGarbage - adds String, b, onto the garbage list of, a. Providing
+ the state of b is marked. The state is then altered to
+ onlist. String, a, is returned.
+*/
+
+static DynamicStrings_String AddToGarbage (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ IsOnGarbage - returns TRUE if, s, is on string, e, garbage list.
+*/
+
+static unsigned int IsOnGarbage (DynamicStrings_String e, DynamicStrings_String s);
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch);
+
+/*
+ DumpState -
+*/
+
+static void DumpState (DynamicStrings_String s);
+
+/*
+ DumpStringSynopsis -
+*/
+
+static void DumpStringSynopsis (DynamicStrings_String s);
+
+/*
+ DumpString - displays the contents of string, s.
+*/
+
+static void DumpString (DynamicStrings_String s);
+
+/*
+ Init - initialize the module.
+*/
+
+static void Init (void);
+
+
+/*
+ writeStringDesc write out debugging information about string, s. */
+
+static void writeStringDesc (DynamicStrings_String s)
+{
+ writeCstring (s->debug.file);
+ writeString ((const char *) ":", 1);
+ writeCard (s->debug.line);
+ writeString ((const char *) ":", 1);
+ writeCstring (s->debug.proc);
+ writeString ((const char *) " ", 1);
+ writeAddress (reinterpret_cast<void *> (s));
+ writeString ((const char *) " ", 1);
+ switch (s->head->state)
+ {
+ case DynamicStrings_inuse:
+ writeString ((const char *) "still in use (", 14);
+ writeCard (s->contents.len);
+ writeString ((const char *) ") characters", 12);
+ break;
+
+ case DynamicStrings_marked:
+ writeString ((const char *) "marked", 6);
+ break;
+
+ case DynamicStrings_onlist:
+ writeString ((const char *) "on a (lost) garbage list", 24);
+ break;
+
+ case DynamicStrings_poisoned:
+ writeString ((const char *) "poisoned", 8);
+ break;
+
+
+ default:
+ writeString ((const char *) "unknown state", 13);
+ break;
+ }
+}
+
+
+/*
+ writeNspace -
+*/
+
+static void writeNspace (unsigned int n)
+{
+ while (n > 0)
+ {
+ writeString ((const char *) " ", 1);
+ n -= 1;
+ }
+}
+
+
+/*
+ DumpStringInfo -
+*/
+
+static void DumpStringInfo (DynamicStrings_String s, unsigned int i)
+{
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ writeNspace (i);
+ writeStringDesc (s);
+ writeLn ();
+ if (s->head->garbage != NULL)
+ {
+ writeNspace (i);
+ writeString ((const char *) "garbage list:", 13);
+ writeLn ();
+ do {
+ s = s->head->garbage;
+ DumpStringInfo (s, i+1);
+ writeLn ();
+ } while (! (s == NULL));
+ }
+ }
+}
+
+
+/*
+ DumpStringInfo -
+*/
+
+static void stop (void)
+{
+}
+
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void)
+{
+ if (CheckOn)
+ {
+ DynamicStrings_PushAllocation ();
+ }
+}
+
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s)
+{
+ if (CheckOn)
+ {
+ s = DynamicStrings_PopAllocationExemption (TRUE, s);
+ }
+}
+
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void)
+{
+}
+
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s)
+{
+}
+
+static unsigned int Capture (DynamicStrings_String s)
+{
+ /*
+ * #undef GM2_DEBUG_DYNAMICSTINGS
+ * #if defined(GM2_DEBUG_DYNAMICSTINGS)
+ * # define DSdbEnter doDSdbEnter
+ * # define DSdbExit doDSdbExit
+ * # define CheckOn TRUE
+ * # define TraceOn TRUE
+ * #endif
+ */
+ captured = s;
+ return 1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Min -
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Max -
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ writeString - writes a string to stdout.
+*/
+
+static void writeString (const char *a_, unsigned int _a_high)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = static_cast<int> (libc_write (1, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
+}
+
+
+/*
+ writeCstring - writes a C string to stdout.
+*/
+
+static void writeCstring (void * a)
+{
+ int i;
+
+ if (a == NULL)
+ {
+ writeString ((const char *) "(null)", 6);
+ }
+ else
+ {
+ i = static_cast<int> (libc_write (1, a, libc_strlen (a)));
+ }
+}
+
+
+/*
+ writeCard -
+*/
+
+static void writeCard (unsigned int c)
+{
+ char ch;
+ int i;
+
+ if (c > 9)
+ {
+ writeCard (c / 10);
+ writeCard (c % 10);
+ }
+ else
+ {
+ ch = ((char) ( ((unsigned int) ('0'))+c));
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+ }
+}
+
+
+/*
+ writeLongcard -
+*/
+
+static void writeLongcard (long unsigned int l)
+{
+ char ch;
+ int i;
+
+ if (l > 16)
+ {
+ writeLongcard (l / 16);
+ writeLongcard (l % 16);
+ }
+ else if (l < 10)
+ {
+ /* avoid dangling else. */
+ ch = ((char) ( ((unsigned int) ('0'))+((unsigned int ) (l))));
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+ }
+ else if (l < 16)
+ {
+ /* avoid dangling else. */
+ ch = ((char) (( ((unsigned int) ('a'))+((unsigned int ) (l)))-10));
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+ }
+}
+
+
+/*
+ writeAddress -
+*/
+
+static void writeAddress (void * a)
+{
+ writeLongcard ((long unsigned int ) (a));
+}
+
+
+/*
+ writeLn - writes a newline.
+*/
+
+static void writeLn (void)
+{
+ char ch;
+ int i;
+
+ ch = ASCII_lf;
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+}
+
+
+/*
+ AssignDebug - assigns, file, and, line, information to string, s.
+*/
+
+static DynamicStrings_String AssignDebug (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line, const char *proc_, unsigned int _proc_high)
+{
+ void * f;
+ void * p;
+ char file[_file_high+1];
+ char proc[_proc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+ memcpy (proc, proc_, _proc_high+1);
+
+ f = &file;
+ p = &proc;
+ Storage_ALLOCATE (&s->debug.file, (StrLib_StrLen ((const char *) file, _file_high))+1);
+ if ((libc_strncpy (s->debug.file, f, (StrLib_StrLen ((const char *) file, _file_high))+1)) == NULL)
+ {} /* empty. */
+ s->debug.line = line;
+ Storage_ALLOCATE (&s->debug.proc, (StrLib_StrLen ((const char *) proc, _proc_high))+1);
+ if ((libc_strncpy (s->debug.proc, p, (StrLib_StrLen ((const char *) proc, _proc_high))+1)) == NULL)
+ {} /* empty. */
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsOn - returns TRUE if, s, is on one of the debug lists.
+*/
+
+static unsigned int IsOn (DynamicStrings_String list, DynamicStrings_String s)
+{
+ while ((list != s) && (list != NULL))
+ {
+ list = list->debug.next;
+ }
+ return list == s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AddTo - adds string, s, to, list.
+*/
+
+static void AddTo (DynamicStrings_String *list, DynamicStrings_String s)
+{
+ if ((*list) == NULL)
+ {
+ (*list) = s;
+ s->debug.next = NULL;
+ }
+ else
+ {
+ s->debug.next = (*list);
+ (*list) = s;
+ }
+}
+
+
+/*
+ SubFrom - removes string, s, from, list.
+*/
+
+static void SubFrom (DynamicStrings_String *list, DynamicStrings_String s)
+{
+ DynamicStrings_String p;
+
+ if ((*list) == s)
+ {
+ (*list) = s->debug.next;
+ }
+ else
+ {
+ p = (*list);
+ while ((p->debug.next != NULL) && (p->debug.next != s))
+ {
+ p = p->debug.next;
+ }
+ if (p->debug.next == s)
+ {
+ p->debug.next = s->debug.next;
+ }
+ else
+ {
+ /* not found, quit */
+ return ;
+ }
+ }
+ s->debug.next = NULL;
+}
+
+
+/*
+ AddAllocated - adds string, s, to the head of the allocated list.
+*/
+
+static void AddAllocated (DynamicStrings_String s)
+{
+ Init ();
+ AddTo (&frameHead->alloc, s);
+}
+
+
+/*
+ AddDeallocated - adds string, s, to the head of the deallocated list.
+*/
+
+static void AddDeallocated (DynamicStrings_String s)
+{
+ Init ();
+ AddTo (&frameHead->dealloc, s);
+}
+
+
+/*
+ IsOnAllocated - returns TRUE if the string, s, has ever been allocated.
+*/
+
+static unsigned int IsOnAllocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->alloc, s))
+ {
+ return TRUE;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsOnDeallocated - returns TRUE if the string, s, has ever been deallocated.
+*/
+
+static unsigned int IsOnDeallocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->dealloc, s))
+ {
+ return TRUE;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SubAllocated - removes string, s, from the list of allocated strings.
+*/
+
+static void SubAllocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->alloc, s))
+ {
+ SubFrom (&f->alloc, s);
+ return ;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+}
+
+
+/*
+ SubDeallocated - removes string, s, from the list of deallocated strings.
+*/
+
+static void SubDeallocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->dealloc, s))
+ {
+ SubFrom (&f->dealloc, s);
+ return ;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+}
+
+
+/*
+ SubDebugInfo - removes string, s, from the list of allocated strings.
+*/
+
+static void SubDebugInfo (DynamicStrings_String s)
+{
+ if (IsOnDeallocated (s))
+ {
+ Assertion_Assert (! DebugOn);
+ /* string has already been deallocated */
+ return ;
+ }
+ if (IsOnAllocated (s))
+ {
+ SubAllocated (s);
+ AddDeallocated (s);
+ }
+ else
+ {
+ /* string has not been allocated */
+ Assertion_Assert (! DebugOn);
+ }
+}
+
+
+/*
+ AddDebugInfo - adds string, s, to the list of allocated strings.
+*/
+
+static void AddDebugInfo (DynamicStrings_String s)
+{
+ s->debug.next = NULL;
+ s->debug.file = NULL;
+ s->debug.line = 0;
+ s->debug.proc = NULL;
+ if (CheckOn)
+ {
+ AddAllocated (s);
+ }
+}
+
+
+/*
+ ConcatContents - add the contents of string, a, where, h, is the
+ total length of, a. The offset is in, o.
+*/
+
+static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned int _a_high, unsigned int h, unsigned int o)
+{
+ unsigned int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = (*c).len;
+ while ((o < h) && (i < MaxBuf))
+ {
+ (*c).buf.array[i] = a[o];
+ o += 1;
+ i += 1;
+ }
+ if (o < h)
+ {
+ (*c).len = MaxBuf;
+ Storage_ALLOCATE ((void **) &(*c).next, sizeof (DynamicStrings_stringRecord));
+ (*c).next->head = NULL;
+ (*c).next->contents.len = 0;
+ (*c).next->contents.next = NULL;
+ ConcatContents (&(*c).next->contents, (const char *) a, _a_high, h, o);
+ AddDebugInfo ((*c).next);
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 722, (const char *) "ConcatContents", 14);
+ }
+ else
+ {
+ (*c).len = i;
+ }
+}
+
+
+/*
+ DeallocateCharStar - deallocates any charStar.
+*/
+
+static void DeallocateCharStar (DynamicStrings_String s)
+{
+ if ((s != NULL) && (s->head != NULL))
+ {
+ if (s->head->charStarUsed && (s->head->charStar != NULL))
+ {
+ Storage_DEALLOCATE (&s->head->charStar, s->head->charStarSize);
+ }
+ s->head->charStarUsed = FALSE;
+ s->head->charStar = NULL;
+ s->head->charStarSize = 0;
+ s->head->charStarValid = FALSE;
+ }
+}
+
+
+/*
+ CheckPoisoned - checks for a poisoned string, s.
+*/
+
+static DynamicStrings_String CheckPoisoned (DynamicStrings_String s)
+{
+ if (((PoisonOn && (s != NULL)) && (s->head != NULL)) && (s->head->state == DynamicStrings_poisoned))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ MarkInvalid - marks the char * version of String, s, as invalid.
+*/
+
+static void MarkInvalid (DynamicStrings_String s)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (s->head != NULL)
+ {
+ s->head->charStarValid = FALSE;
+ }
+}
+
+
+/*
+ ConcatContentsAddress - concatenate the string, a, where, h, is the
+ total length of, a.
+*/
+
+static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigned int h)
+{
+ typedef char *ConcatContentsAddress__T1;
+
+ ConcatContentsAddress__T1 p;
+ unsigned int i;
+ unsigned int j;
+
+ j = 0;
+ i = (*c).len;
+ p = static_cast<ConcatContentsAddress__T1> (a);
+ while ((j < h) && (i < MaxBuf))
+ {
+ (*c).buf.array[i] = (*p);
+ i += 1;
+ j += 1;
+ p += 1;
+ }
+ if (j < h)
+ {
+ /* avoid dangling else. */
+ (*c).len = MaxBuf;
+ Storage_ALLOCATE ((void **) &(*c).next, sizeof (DynamicStrings_stringRecord));
+ (*c).next->head = NULL;
+ (*c).next->contents.len = 0;
+ (*c).next->contents.next = NULL;
+ ConcatContentsAddress (&(*c).next->contents, reinterpret_cast<void *> (p), h-j);
+ AddDebugInfo ((*c).next);
+ if (TraceOn)
+ {
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 917, (const char *) "ConcatContentsAddress", 21);
+ }
+ }
+ else
+ {
+ (*c).len = i;
+ (*c).next = NULL;
+ }
+}
+
+
+/*
+ AddToGarbage - adds String, b, onto the garbage list of, a. Providing
+ the state of b is marked. The state is then altered to
+ onlist. String, a, is returned.
+*/
+
+static DynamicStrings_String AddToGarbage (DynamicStrings_String a, DynamicStrings_String b)
+{
+ DynamicStrings_String c;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ /*
+ IF (a#NIL) AND (a#b) AND (a^.head^.state=marked)
+ THEN
+ writeString('warning trying to add to a marked string') ; writeLn
+ END ;
+ */
+ if (((((a != b) && (a != NULL)) && (b != NULL)) && (b->head->state == DynamicStrings_marked)) && (a->head->state == DynamicStrings_inuse))
+ {
+ c = a;
+ while (c->head->garbage != NULL)
+ {
+ c = c->head->garbage;
+ }
+ c->head->garbage = b;
+ b->head->state = DynamicStrings_onlist;
+ if (CheckOn)
+ {
+ SubDebugInfo (b);
+ }
+ }
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsOnGarbage - returns TRUE if, s, is on string, e, garbage list.
+*/
+
+static unsigned int IsOnGarbage (DynamicStrings_String e, DynamicStrings_String s)
+{
+ if ((e != NULL) && (s != NULL))
+ {
+ while (e->head->garbage != NULL)
+ {
+ if (e->head->garbage == s)
+ {
+ return TRUE;
+ }
+ else
+ {
+ e = e->head->garbage;
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch)
+{
+ return (ch == ' ') || (ch == ASCII_tab);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DumpState -
+*/
+
+static void DumpState (DynamicStrings_String s)
+{
+ switch (s->head->state)
+ {
+ case DynamicStrings_inuse:
+ writeString ((const char *) "still in use (", 14);
+ writeCard (s->contents.len);
+ writeString ((const char *) ") characters", 12);
+ break;
+
+ case DynamicStrings_marked:
+ writeString ((const char *) "marked", 6);
+ break;
+
+ case DynamicStrings_onlist:
+ writeString ((const char *) "on a garbage list", 17);
+ break;
+
+ case DynamicStrings_poisoned:
+ writeString ((const char *) "poisoned", 8);
+ break;
+
+
+ default:
+ writeString ((const char *) "unknown state", 13);
+ break;
+ }
+}
+
+
+/*
+ DumpStringSynopsis -
+*/
+
+static void DumpStringSynopsis (DynamicStrings_String s)
+{
+ writeCstring (s->debug.file);
+ writeString ((const char *) ":", 1);
+ writeCard (s->debug.line);
+ writeString ((const char *) ":", 1);
+ writeCstring (s->debug.proc);
+ writeString ((const char *) " string ", 8);
+ writeAddress (reinterpret_cast<void *> (s));
+ writeString ((const char *) " ", 1);
+ DumpState (s);
+ if (IsOnAllocated (s))
+ {
+ writeString ((const char *) " globally allocated", 19);
+ }
+ else if (IsOnDeallocated (s))
+ {
+ /* avoid dangling else. */
+ writeString ((const char *) " globally deallocated", 21);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ writeString ((const char *) " globally unknown", 17);
+ }
+ writeLn ();
+}
+
+
+/*
+ DumpString - displays the contents of string, s.
+*/
+
+static void DumpString (DynamicStrings_String s)
+{
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ DumpStringSynopsis (s);
+ if ((s->head != NULL) && (s->head->garbage != NULL))
+ {
+ writeString ((const char *) "display chained strings on the garbage list", 43);
+ writeLn ();
+ t = s->head->garbage;
+ while (t != NULL)
+ {
+ DumpStringSynopsis (t);
+ t = t->head->garbage;
+ }
+ }
+ }
+}
+
+
+/*
+ Init - initialize the module.
+*/
+
+static void Init (void)
+{
+ if (! Initialized)
+ {
+ Initialized = TRUE;
+ frameHead = NULL;
+ DynamicStrings_PushAllocation ();
+ }
+}
+
+
+/*
+ InitString - creates and returns a String type object.
+ Initial contents are, a.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high)
+{
+ DynamicStrings_String s;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ Storage_ALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord));
+ s->contents.len = 0;
+ s->contents.next = NULL;
+ ConcatContents (&s->contents, (const char *) a, _a_high, StrLib_StrLen ((const char *) a, _a_high), 0);
+ Storage_ALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor));
+ s->head->charStarUsed = FALSE;
+ s->head->charStar = NULL;
+ s->head->charStarSize = 0;
+ s->head->charStarValid = FALSE;
+ s->head->garbage = NULL;
+ s->head->state = DynamicStrings_inuse;
+ AddDebugInfo (s);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 758, (const char *) "InitString", 10);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillString - frees String, s, and its contents.
+ NIL is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s)
+{
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (s != NULL)
+ {
+ if (CheckOn)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (IsOnAllocated (s))
+ {
+ SubAllocated (s);
+ }
+ else if (IsOnDeallocated (s))
+ {
+ /* avoid dangling else. */
+ SubDeallocated (s);
+ }
+ }
+ if (s->head != NULL)
+ {
+ s->head->state = DynamicStrings_poisoned;
+ s->head->garbage = DynamicStrings_KillString (s->head->garbage);
+ if (! PoisonOn)
+ {
+ DeallocateCharStar (s);
+ }
+ if (! PoisonOn)
+ {
+ Storage_DEALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor));
+ s->head = NULL;
+ }
+ }
+ t = DynamicStrings_KillString (s->contents.next);
+ if (! PoisonOn)
+ {
+ Storage_DEALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord));
+ }
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Fin - finishes with a string, it calls KillString with, s.
+ The purpose of the procedure is to provide a short cut
+ to calling KillString and then testing the return result.
+*/
+
+extern "C" void DynamicStrings_Fin (DynamicStrings_String s)
+{
+ if ((DynamicStrings_KillString (s)) != NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ InitStringCharStar - initializes and returns a String to contain the C string.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a)
+{
+ DynamicStrings_String s;
+
+ Storage_ALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord));
+ s->contents.len = 0;
+ s->contents.next = NULL;
+ if (a != NULL)
+ {
+ ConcatContentsAddress (&s->contents, a, static_cast<unsigned int> (libc_strlen (a)));
+ }
+ Storage_ALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor));
+ s->head->charStarUsed = FALSE;
+ s->head->charStar = NULL;
+ s->head->charStarSize = 0;
+ s->head->charStarValid = FALSE;
+ s->head->garbage = NULL;
+ s->head->state = DynamicStrings_inuse;
+ AddDebugInfo (s);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 957, (const char *) "InitStringCharStar", 18);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringChar - initializes and returns a String to contain the single character, ch.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch)
+{
+ typedef struct InitStringChar__T4_a InitStringChar__T4;
+
+ struct InitStringChar__T4_a { char array[1+1]; };
+ InitStringChar__T4 a;
+ DynamicStrings_String s;
+
+ a.array[0] = ch;
+ a.array[1] = ASCII_nul;
+ s = DynamicStrings_InitString ((const char *) &a.array[0], 1);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 977, (const char *) "InitStringChar", 14);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Mark - marks String, s, ready for garbage collection.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if ((s != NULL) && (s->head->state == DynamicStrings_inuse))
+ {
+ s->head->state = DynamicStrings_marked;
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Length - returns the length of the String, s.
+*/
+
+extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s)
+{
+ if (s == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ return s->contents.len+(DynamicStrings_Length (s->contents.next));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConCat - returns String, a, after the contents of, b, have been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b)
+{
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ if (a == b)
+ {
+ return DynamicStrings_ConCat (a, DynamicStrings_Mark (DynamicStrings_Dup (b)));
+ }
+ else if (a != NULL)
+ {
+ /* avoid dangling else. */
+ a = AddToGarbage (a, b);
+ MarkInvalid (a);
+ t = a;
+ while (b != NULL)
+ {
+ while ((t->contents.len == MaxBuf) && (t->contents.next != NULL))
+ {
+ t = t->contents.next;
+ }
+ ConcatContents (&t->contents, (const char *) &b->contents.buf.array[0], (MaxBuf-1), b->contents.len, 0);
+ b = b->contents.next;
+ }
+ }
+ if ((a == NULL) && (b != NULL))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConCatChar - returns String, a, after character, ch, has been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch)
+{
+ typedef struct ConCatChar__T5_a ConCatChar__T5;
+
+ struct ConCatChar__T5_a { char array[1+1]; };
+ ConCatChar__T5 b;
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ }
+ b.array[0] = ch;
+ b.array[1] = ASCII_nul;
+ t = a;
+ MarkInvalid (a);
+ while ((t->contents.len == MaxBuf) && (t->contents.next != NULL))
+ {
+ t = t->contents.next;
+ }
+ ConcatContents (&t->contents, (const char *) &b.array[0], 1, 1, 0);
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Assign - assigns the contents of, b, into, a.
+ String, a, is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b)
+{
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ if ((a != NULL) && (b != NULL))
+ {
+ a->contents.next = DynamicStrings_KillString (a->contents.next);
+ a->contents.len = 0;
+ }
+ return DynamicStrings_ConCat (a, b);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Dup - duplicate a String, s, returning the copy of s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ s = DynamicStrings_Assign (DynamicStrings_InitString ((const char *) "", 0), s);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1173, (const char *) "Dup", 3);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Add - returns a new String which contains the contents of a and b.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b)
+{
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ a = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "", 0), a), b);
+ if (TraceOn)
+ {
+ a = AssignDebug (a, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1193, (const char *) "Add", 3);
+ }
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Equal - returns TRUE if String, a, and, b, are equal.
+*/
+
+extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b)
+{
+ unsigned int i;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ if ((DynamicStrings_Length (a)) == (DynamicStrings_Length (b)))
+ {
+ while ((a != NULL) && (b != NULL))
+ {
+ i = 0;
+ Assertion_Assert (a->contents.len == b->contents.len);
+ while (i < a->contents.len)
+ {
+ if (a->contents.buf.array[i] != b->contents.buf.array[i])
+ {
+ return FALSE;
+ }
+ i += 1;
+ }
+ a = a->contents.next;
+ b = b->contents.next;
+ }
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EqualCharStar - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a)
+{
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ t = DynamicStrings_InitStringCharStar (a);
+ if (TraceOn)
+ {
+ t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1250, (const char *) "EqualCharStar", 13);
+ }
+ t = AddToGarbage (t, s);
+ if (DynamicStrings_Equal (t, s))
+ {
+ t = DynamicStrings_KillString (t);
+ return TRUE;
+ }
+ else
+ {
+ t = DynamicStrings_KillString (t);
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EqualArray - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high)
+{
+ DynamicStrings_String t;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ t = DynamicStrings_InitString ((const char *) a, _a_high);
+ if (TraceOn)
+ {
+ t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1280, (const char *) "EqualArray", 10);
+ }
+ t = AddToGarbage (t, s);
+ if (DynamicStrings_Equal (t, s))
+ {
+ t = DynamicStrings_KillString (t);
+ return TRUE;
+ }
+ else
+ {
+ t = DynamicStrings_KillString (t);
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Mult - returns a new string which is n concatenations of String, s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (n <= 0)
+ {
+ s = AddToGarbage (DynamicStrings_InitString ((const char *) "", 0), s);
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_Mult (s, n-1), s);
+ }
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1312, (const char *) "Mult", 4);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Slice - returns a new string which contains the elements
+ low..high-1
+
+ strings start at element 0
+ Slice(s, 0, 2) will return elements 0, 1 but not 2
+ Slice(s, 1, 3) will return elements 1, 2 but not 3
+ Slice(s, 2, 0) will return elements 2..max
+ Slice(s, 3, -1) will return elements 3..max-1
+ Slice(s, 4, -2) will return elements 4..max-2
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high)
+{
+ DynamicStrings_String d;
+ DynamicStrings_String t;
+ int start;
+ int end;
+ int o;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (low < 0)
+ {
+ low = ((int ) (DynamicStrings_Length (s)))+low;
+ }
+ if (high <= 0)
+ {
+ high = ((int ) (DynamicStrings_Length (s)))+high;
+ }
+ else
+ {
+ /* make sure high is <= Length (s) */
+ high = Min (DynamicStrings_Length (s), static_cast<unsigned int> (high));
+ }
+ d = DynamicStrings_InitString ((const char *) "", 0);
+ d = AddToGarbage (d, s);
+ o = 0;
+ t = d;
+ while (s != NULL)
+ {
+ if (low < (o+((int ) (s->contents.len))))
+ {
+ if (o > high)
+ {
+ s = NULL;
+ }
+ else
+ {
+ /* found sliceable unit */
+ if (low < o)
+ {
+ start = 0;
+ }
+ else
+ {
+ start = low-o;
+ }
+ end = Max (Min (MaxBuf, static_cast<unsigned int> (high-o)), 0);
+ while (t->contents.len == MaxBuf)
+ {
+ if (t->contents.next == NULL)
+ {
+ Storage_ALLOCATE ((void **) &t->contents.next, sizeof (DynamicStrings_stringRecord));
+ t->contents.next->head = NULL;
+ t->contents.next->contents.len = 0;
+ AddDebugInfo (t->contents.next);
+ if (TraceOn)
+ {
+ t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1380, (const char *) "Slice", 5);
+ }
+ }
+ t = t->contents.next;
+ }
+ ConcatContentsAddress (&t->contents, &s->contents.buf.array[start], static_cast<unsigned int> (end-start));
+ o += s->contents.len;
+ s = s->contents.next;
+ }
+ }
+ else
+ {
+ o += s->contents.len;
+ s = s->contents.next;
+ }
+ }
+ if (TraceOn)
+ {
+ d = AssignDebug (d, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1397, (const char *) "Slice", 5);
+ }
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Index - returns the indice of the first occurance of, ch, in
+ String, s. -1 is returned if, ch, does not exist.
+ The search starts at position, o.
+*/
+
+extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o)
+{
+ unsigned int i;
+ unsigned int k;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ k = 0;
+ while (s != NULL)
+ {
+ if ((k+s->contents.len) < o)
+ {
+ k += s->contents.len;
+ }
+ else
+ {
+ i = o-k;
+ while (i < s->contents.len)
+ {
+ if (s->contents.buf.array[i] == ch)
+ {
+ return k+i;
+ }
+ i += 1;
+ }
+ k += i;
+ o = k;
+ }
+ s = s->contents.next;
+ }
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RIndex - returns the indice of the last occurance of, ch,
+ in String, s. The search starts at position, o.
+ -1 is returned if, ch, is not found.
+*/
+
+extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o)
+{
+ unsigned int i;
+ unsigned int k;
+ int j;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ j = -1;
+ k = 0;
+ while (s != NULL)
+ {
+ if ((k+s->contents.len) < o)
+ {
+ k += s->contents.len;
+ }
+ else
+ {
+ if (o < k)
+ {
+ i = 0;
+ }
+ else
+ {
+ i = o-k;
+ }
+ while (i < s->contents.len)
+ {
+ if (s->contents.buf.array[i] == ch)
+ {
+ j = k;
+ }
+ k += 1;
+ i += 1;
+ }
+ }
+ s = s->contents.next;
+ }
+ return j;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveComment - assuming that, comment, is a comment delimiter
+ which indicates anything to its right is a comment
+ then strip off the comment and also any white space
+ on the remaining right hand side.
+ It leaves any white space on the left hand side alone.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment)
+{
+ int i;
+
+ i = DynamicStrings_Index (s, comment, 0);
+ if (i == 0)
+ {
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ }
+ else if (i > 0)
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_RemoveWhitePostfix (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i));
+ }
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1509, (const char *) "RemoveComment", 13);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveWhitePrefix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s)
+{
+ unsigned int i;
+
+ i = 0;
+ while (IsWhite (DynamicStrings_char (s, static_cast<int> (i))))
+ {
+ i += 1;
+ }
+ s = DynamicStrings_Slice (s, (int ) (i), 0);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1621, (const char *) "RemoveWhitePrefix", 17);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveWhitePostfix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s)
+{
+ int i;
+
+ i = ((int ) (DynamicStrings_Length (s)))-1;
+ while ((i >= 0) && (IsWhite (DynamicStrings_char (s, i))))
+ {
+ i -= 1;
+ }
+ s = DynamicStrings_Slice (s, 0, i+1);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1643, (const char *) "RemoveWhitePostfix", 18);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ToUpper - returns string, s, after it has had its lower case characters
+ replaced by upper case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s)
+{
+ char ch;
+ unsigned int i;
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ MarkInvalid (s);
+ t = s;
+ while (t != NULL)
+ {
+ i = 0;
+ while (i < t->contents.len)
+ {
+ ch = t->contents.buf.array[i];
+ if ((ch >= 'a') && (ch <= 'z'))
+ {
+ t->contents.buf.array[i] = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('a')))+ ((unsigned int) ('A'))));
+ }
+ i += 1;
+ }
+ t = t->contents.next;
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ToLower - returns string, s, after it has had its upper case characters
+ replaced by lower case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s)
+{
+ char ch;
+ unsigned int i;
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ MarkInvalid (s);
+ t = s;
+ while (t != NULL)
+ {
+ i = 0;
+ while (i < t->contents.len)
+ {
+ ch = t->contents.buf.array[i];
+ if ((ch >= 'A') && (ch <= 'Z'))
+ {
+ t->contents.buf.array[i] = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))));
+ }
+ i += 1;
+ }
+ t = t->contents.next;
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CopyOut - copies string, s, to a.
+*/
+
+extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s)
+{
+ unsigned int i;
+ unsigned int l;
+
+ l = Min (_a_high+1, DynamicStrings_Length (s));
+ i = 0;
+ while (i < l)
+ {
+ a[i] = DynamicStrings_char (s, static_cast<int> (i));
+ i += 1;
+ }
+ if (i <= _a_high)
+ {
+ a[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ char - returns the character, ch, at position, i, in String, s.
+*/
+
+extern "C" char DynamicStrings_char (DynamicStrings_String s, int i)
+{
+ unsigned int c;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (i < 0)
+ {
+ c = (unsigned int ) (((int ) (DynamicStrings_Length (s)))+i);
+ }
+ else
+ {
+ c = i;
+ }
+ while ((s != NULL) && (c >= s->contents.len))
+ {
+ c -= s->contents.len;
+ s = s->contents.next;
+ }
+ if ((s == NULL) || (c >= s->contents.len))
+ {
+ return ASCII_nul;
+ }
+ else
+ {
+ return s->contents.buf.array[c];
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ string - returns the C style char * of String, s.
+*/
+
+extern "C" void * DynamicStrings_string (DynamicStrings_String s)
+{
+ typedef char *string__T2;
+
+ DynamicStrings_String a;
+ unsigned int l;
+ unsigned int i;
+ string__T2 p;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (s == NULL)
+ {
+ return NULL;
+ }
+ else
+ {
+ if (! s->head->charStarValid)
+ {
+ l = DynamicStrings_Length (s);
+ if (! (s->head->charStarUsed && (s->head->charStarSize > l)))
+ {
+ DeallocateCharStar (s);
+ Storage_ALLOCATE (&s->head->charStar, l+1);
+ s->head->charStarSize = l+1;
+ s->head->charStarUsed = TRUE;
+ }
+ p = static_cast<string__T2> (s->head->charStar);
+ a = s;
+ while (a != NULL)
+ {
+ i = 0;
+ while (i < a->contents.len)
+ {
+ (*p) = a->contents.buf.array[i];
+ i += 1;
+ p += 1;
+ }
+ a = a->contents.next;
+ }
+ (*p) = ASCII_nul;
+ s->head->charStarValid = TRUE;
+ }
+ return s->head->charStar;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringDB - the debug version of InitString.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char a[_a_high+1];
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_InitString ((const char *) a, _a_high), (const char *) file, _file_high, line, (const char *) "InitString", 10);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringCharStarDB - the debug version of InitStringCharStar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_InitStringCharStar (a), (const char *) file, _file_high, line, (const char *) "InitStringCharStar", 18);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringCharDB - the debug version of InitStringChar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_InitStringChar (ch), (const char *) file, _file_high, line, (const char *) "InitStringChar", 14);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ MultDB - the debug version of MultDB.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_Mult (s, n), (const char *) file, _file_high, line, (const char *) "Mult", 4);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DupDB - the debug version of Dup.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_Dup (s), (const char *) file, _file_high, line, (const char *) "Dup", 3);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SliceDB - debug version of Slice.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ DSdbEnter ();
+ s = AssignDebug (DynamicStrings_Slice (s, low, high), (const char *) file, _file_high, line, (const char *) "Slice", 5);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PushAllocation - pushes the current allocation/deallocation lists.
+*/
+
+extern "C" void DynamicStrings_PushAllocation (void)
+{
+ DynamicStrings_frame f;
+
+ if (CheckOn)
+ {
+ Init ();
+ Storage_ALLOCATE ((void **) &f, sizeof (DynamicStrings_frameRec));
+ f->next = frameHead;
+ f->alloc = NULL;
+ f->dealloc = NULL;
+ frameHead = f;
+ }
+}
+
+
+/*
+ PopAllocation - test to see that all strings are deallocated since
+ the last push. Then it pops to the previous
+ allocation/deallocation lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" void DynamicStrings_PopAllocation (unsigned int halt)
+{
+ if (CheckOn)
+ {
+ if ((DynamicStrings_PopAllocationExemption (halt, NULL)) == NULL)
+ {} /* empty. */
+ }
+}
+
+
+/*
+ PopAllocationExemption - test to see that all strings are deallocated, except
+ string, e, since the last push.
+ Then it pops to the previous allocation/deallocation
+ lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e)
+{
+ DynamicStrings_String s;
+ DynamicStrings_frame f;
+ unsigned int b;
+
+ Init ();
+ if (CheckOn)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (frameHead == NULL)
+ {
+ stop ();
+ /* writeString ("mismatched number of PopAllocation's compared to PushAllocation's") */
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
+ }
+ else
+ {
+ if (frameHead->alloc != NULL)
+ {
+ b = FALSE;
+ s = frameHead->alloc;
+ while (s != NULL)
+ {
+ if (! (((e == s) || (IsOnGarbage (e, s))) || (IsOnGarbage (s, e))))
+ {
+ if (! b)
+ {
+ writeString ((const char *) "the following strings have been lost", 36);
+ writeLn ();
+ b = TRUE;
+ }
+ DumpStringInfo (s, 0);
+ }
+ s = s->debug.next;
+ }
+ if (b && halt)
+ {
+ libc_exit (1);
+ }
+ }
+ frameHead = frameHead->next;
+ }
+ }
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_DynamicStrings_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Initialized = FALSE;
+ Init ();
+}
+
+extern "C" void _M2_DynamicStrings_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Environment. */
+/* Environment.mod provides access to the environment settings of a process.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _Environment_H
+#define _Environment_C
+
+# include "GSYSTEM.h"
+# include "Glibc.h"
+# include "GASCII.h"
+# include "GStrLib.h"
+
+
+/*
+ GetEnvironment - gets the environment variable Env and places
+ a copy of its value into string, dest.
+ It returns TRUE if the string Env was found in
+ the processes environment.
+*/
+
+extern "C" unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *dest, unsigned int _dest_high);
+
+/*
+ PutEnvironment - change or add an environment variable definition EnvDef.
+ TRUE is returned if the environment variable was
+ set or changed successfully.
+*/
+
+extern "C" unsigned int Environment_PutEnvironment (const char *EnvDef_, unsigned int _EnvDef_high);
+
+
+/*
+ GetEnvironment - gets the environment variable Env and places
+ a copy of its value into string, dest.
+ It returns TRUE if the string Env was found in
+ the processes environment.
+*/
+
+extern "C" unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *dest, unsigned int _dest_high)
+{
+ typedef char *GetEnvironment__T1;
+
+ unsigned int High;
+ unsigned int i;
+ GetEnvironment__T1 Addr;
+ char Env[_Env_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (Env, Env_, _Env_high+1);
+
+ i = 0;
+ High = _dest_high;
+ Addr = static_cast<GetEnvironment__T1> (libc_getenv (&Env));
+ while (((i < High) && (Addr != NULL)) && ((*Addr) != ASCII_nul))
+ {
+ dest[i] = (*Addr);
+ Addr += 1;
+ i += 1;
+ }
+ if (i < High)
+ {
+ dest[i] = ASCII_nul;
+ }
+ return Addr != NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutEnvironment - change or add an environment variable definition EnvDef.
+ TRUE is returned if the environment variable was
+ set or changed successfully.
+*/
+
+extern "C" unsigned int Environment_PutEnvironment (const char *EnvDef_, unsigned int _EnvDef_high)
+{
+ char EnvDef[_EnvDef_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (EnvDef, EnvDef_, _EnvDef_high+1);
+
+ return (libc_putenv (&EnvDef)) == 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_Environment_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Environment_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from FIO. */
+/* FIO.mod provides a simple buffered file input/output library.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _FIO_H
+#define _FIO_C
+
+# include "GSYSTEM.h"
+# include "GASCII.h"
+# include "GStrLib.h"
+# include "GStorage.h"
+# include "GNumberIO.h"
+# include "Glibc.h"
+# include "GIndexing.h"
+# include "GM2RTS.h"
+
+typedef unsigned int FIO_File;
+
+FIO_File FIO_StdErr;
+FIO_File FIO_StdOut;
+FIO_File FIO_StdIn;
+# define SEEK_SET 0
+# define SEEK_END 2
+# define UNIXREADONLY 0
+# define UNIXWRITEONLY 1
+# define CreatePermissions 0666
+# define MaxBufferLength (1024*16)
+# define MaxErrorString (1024*8)
+typedef struct FIO_NameInfo_r FIO_NameInfo;
+
+typedef struct FIO_buf_r FIO_buf;
+
+typedef FIO_buf *FIO_Buffer;
+
+typedef struct FIO_fds_r FIO_fds;
+
+typedef FIO_fds *FIO_FileDescriptor;
+
+typedef struct FIO__T7_a FIO__T7;
+
+typedef char *FIO_PtrToChar;
+
+typedef enum {FIO_successful, FIO_outofmemory, FIO_toomanyfilesopen, FIO_failed, FIO_connectionfailure, FIO_endofline, FIO_endoffile} FIO_FileStatus;
+
+typedef enum {FIO_unused, FIO_openedforread, FIO_openedforwrite, FIO_openedforrandom} FIO_FileUsage;
+
+struct FIO_NameInfo_r {
+ void *address;
+ unsigned int size;
+ };
+
+struct FIO_buf_r {
+ unsigned int valid;
+ long int bufstart;
+ unsigned int position;
+ void *address;
+ unsigned int filled;
+ unsigned int size;
+ unsigned int left;
+ FIO__T7 *contents;
+ };
+
+struct FIO__T7_a { char array[MaxBufferLength+1]; };
+struct FIO_fds_r {
+ int unixfd;
+ FIO_NameInfo name;
+ FIO_FileStatus state;
+ FIO_FileUsage usage;
+ unsigned int output;
+ FIO_Buffer buffer;
+ long int abspos;
+ };
+
+static Indexing_Index FileInfo;
+static FIO_File Error;
+
+/*
+ IsNoError - returns a TRUE if no error has occured on file, f.
+*/
+
+extern "C" unsigned int FIO_IsNoError (FIO_File f);
+
+/*
+ IsActive - returns TRUE if the file, f, is still active.
+*/
+
+extern "C" unsigned int FIO_IsActive (FIO_File f);
+extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile);
+
+/*
+ Close - close a file which has been previously opened using:
+ OpenToRead, OpenToWrite, OpenForRandom.
+ It is correct to close a file which has an error status.
+*/
+
+extern "C" void FIO_Close (FIO_File f);
+
+/*
+ exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int FIO_exists (void * fname, unsigned int flength);
+
+/*
+ openToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength);
+
+/*
+ openToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength);
+
+/*
+ openForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+*/
+
+extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile);
+
+/*
+ FlushBuffer - flush contents of file, f.
+*/
+
+extern "C" void FIO_FlushBuffer (FIO_File f);
+
+/*
+ ReadNBytes - reads nBytes of a file into memory area, dest, returning
+ the number of bytes actually read.
+ This function will consume from the buffer and then
+ perform direct libc reads. It is ideal for large reads.
+*/
+
+extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest);
+
+/*
+ ReadAny - reads HIGH(a) bytes into, a. All input
+ is fully buffered, unlike ReadNBytes and thus is more
+ suited to small reads.
+*/
+
+extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high);
+
+/*
+ WriteNBytes - writes nBytes from memory area src to a file
+ returning the number of bytes actually written.
+ This function will flush the buffer and then
+ write the nBytes using a direct write from libc.
+ It is ideal for large writes.
+*/
+
+extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src);
+
+/*
+ WriteAny - writes HIGH(a) bytes onto, file, f. All output
+ is fully buffered, unlike WriteNBytes and thus is more
+ suited to small writes.
+*/
+
+extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high);
+
+/*
+ WriteChar - writes a single character to file, f.
+*/
+
+extern "C" void FIO_WriteChar (FIO_File f, char ch);
+
+/*
+ EOF - tests to see whether a file, f, has reached end of file.
+*/
+
+extern "C" unsigned int FIO_EOF (FIO_File f);
+
+/*
+ EOLN - tests to see whether a file, f, is upon a newline.
+ It does NOT consume the newline.
+*/
+
+extern "C" unsigned int FIO_EOLN (FIO_File f);
+
+/*
+ WasEOLN - tests to see whether a file, f, has just seen a newline.
+*/
+
+extern "C" unsigned int FIO_WasEOLN (FIO_File f);
+
+/*
+ ReadChar - returns a character read from file f.
+ Sensible to check with IsNoError or EOF after calling
+ this function.
+*/
+
+extern "C" char FIO_ReadChar (FIO_File f);
+
+/*
+ UnReadChar - replaces a character, ch, back into file f.
+ This character must have been read by ReadChar
+ and it does not allow successive calls. It may
+ only be called if the previous read was successful
+ or end of file was seen.
+ If the state was previously endoffile then it
+ is altered to successful.
+ Otherwise it is left alone.
+*/
+
+extern "C" void FIO_UnReadChar (FIO_File f, char ch);
+
+/*
+ WriteLine - writes out a linefeed to file, f.
+*/
+
+extern "C" void FIO_WriteLine (FIO_File f);
+
+/*
+ WriteString - writes a string to file, f.
+*/
+
+extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high);
+
+/*
+ ReadString - reads a string from file, f, into string, a.
+ It terminates the string if HIGH is reached or
+ if a newline is seen or an error occurs.
+*/
+
+extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high);
+
+/*
+ WriteCardinal - writes a CARDINAL to file, f.
+ It writes the binary image of the cardinal
+ to file, f.
+*/
+
+extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c);
+
+/*
+ ReadCardinal - reads a CARDINAL from file, f.
+ It reads a binary image of a CARDINAL
+ from a file, f.
+*/
+
+extern "C" unsigned int FIO_ReadCardinal (FIO_File f);
+
+/*
+ GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+*/
+
+extern "C" int FIO_GetUnixFileDescriptor (FIO_File f);
+
+/*
+ SetPositionFromBeginning - sets the position from the beginning of the file.
+*/
+
+extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos);
+
+/*
+ SetPositionFromEnd - sets the position from the end of the file.
+*/
+
+extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos);
+
+/*
+ FindPosition - returns the current absolute position in file, f.
+*/
+
+extern "C" long int FIO_FindPosition (FIO_File f);
+
+/*
+ GetFileName - assigns, a, with the filename associated with, f.
+*/
+
+extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high);
+
+/*
+ getFileName - returns the address of the filename associated with, f.
+*/
+
+extern "C" void * FIO_getFileName (FIO_File f);
+
+/*
+ getFileNameLength - returns the number of characters associated with filename, f.
+*/
+
+extern "C" unsigned int FIO_getFileNameLength (FIO_File f);
+
+/*
+ FlushOutErr - flushes, StdOut, and, StdErr.
+ It is also called when the application calls M2RTS.Terminate.
+ (which is automatically placed in program modules by the GM2
+ scaffold).
+*/
+
+extern "C" void FIO_FlushOutErr (void);
+
+/*
+ Max - returns the maximum of two values.
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b);
+
+/*
+ Min - returns the minimum of two values.
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b);
+
+/*
+ GetNextFreeDescriptor - returns the index to the FileInfo array indicating
+ the next free slot.
+*/
+
+static FIO_File GetNextFreeDescriptor (void);
+
+/*
+ SetState - sets the field, state, of file, f, to, s.
+*/
+
+static void SetState (FIO_File f, FIO_FileStatus s);
+
+/*
+ InitializeFile - initialize a file descriptor
+*/
+
+static FIO_File InitializeFile (FIO_File f, void * fname, unsigned int flength, FIO_FileStatus fstate, FIO_FileUsage use, unsigned int towrite, unsigned int buflength);
+
+/*
+ ConnectToUnix - connects a FIO file to a UNIX file descriptor.
+*/
+
+static void ConnectToUnix (FIO_File f, unsigned int towrite, unsigned int newfile);
+
+/*
+ ReadFromBuffer - attempts to read, nBytes, from file, f.
+ It firstly consumes the buffer and then performs
+ direct unbuffered reads. This should only be used
+ when wishing to read large files.
+
+ The actual number of bytes read is returned.
+ -1 is returned if EOF is reached.
+*/
+
+static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes);
+
+/*
+ BufferedRead - will read, nBytes, through the buffer.
+ Similar to ReadFromBuffer, but this function will always
+ read into the buffer before copying into memory.
+
+ Useful when performing small reads.
+*/
+
+static int BufferedRead (FIO_File f, unsigned int nBytes, void * a);
+
+/*
+ HandleEscape - translates
+ and \t into their respective ascii codes.
+*/
+
+static void HandleEscape (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, unsigned int *i, unsigned int *j, unsigned int HighSrc, unsigned int HighDest);
+
+/*
+ Cast - casts a := b
+*/
+
+static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high);
+
+/*
+ StringFormat1 - converts string, src, into, dest, together with encapsulated
+ entity, w. It only formats the first %s or %d with n.
+*/
+
+static void StringFormat1 (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ FormatError - provides a orthoganal counterpart to the procedure below.
+*/
+
+static void FormatError (const char *a_, unsigned int _a_high);
+
+/*
+ FormatError1 - generic error procedure taking standard format string
+ and single parameter.
+*/
+
+static void FormatError1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ FormatError2 - generic error procedure taking standard format string
+ and two parameters.
+*/
+
+static void FormatError2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+
+/*
+ CheckAccess - checks to see whether a file f has been
+ opened for read/write.
+*/
+
+static void CheckAccess (FIO_File f, FIO_FileUsage use, unsigned int towrite);
+
+/*
+ SetEndOfLine -
+*/
+
+static void SetEndOfLine (FIO_File f, char ch);
+
+/*
+ BufferedWrite - will write, nBytes, through the buffer.
+ Similar to WriteNBytes, but this function will always
+ write into the buffer before copying into memory.
+
+ Useful when performing small writes.
+*/
+
+static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a);
+
+/*
+ PreInitialize - preinitialize the file descriptor.
+*/
+
+static void PreInitialize (FIO_File f, const char *fname_, unsigned int _fname_high, FIO_FileStatus state, FIO_FileUsage use, unsigned int towrite, int osfd, unsigned int bufsize);
+
+/*
+ Init - initialize the modules, global variables.
+*/
+
+static void Init (void);
+
+
+/*
+ Max - returns the maximum of two values.
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Min - returns the minimum of two values.
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetNextFreeDescriptor - returns the index to the FileInfo array indicating
+ the next free slot.
+*/
+
+static FIO_File GetNextFreeDescriptor (void)
+{
+ FIO_File f;
+ FIO_File h;
+ FIO_FileDescriptor fd;
+
+ f = Error+1;
+ h = Indexing_HighIndice (FileInfo);
+ for (;;)
+ {
+ if (f <= h)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ return f;
+ }
+ }
+ f += 1;
+ if (f > h)
+ {
+ Indexing_PutIndice (FileInfo, f, NULL); /* create new slot */
+ return f; /* create new slot */
+ }
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetState - sets the field, state, of file, f, to, s.
+*/
+
+static void SetState (FIO_File f, FIO_FileStatus s)
+{
+ FIO_FileDescriptor fd;
+
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ fd->state = s;
+}
+
+
+/*
+ InitializeFile - initialize a file descriptor
+*/
+
+static FIO_File InitializeFile (FIO_File f, void * fname, unsigned int flength, FIO_FileStatus fstate, FIO_FileUsage use, unsigned int towrite, unsigned int buflength)
+{
+ FIO_PtrToChar p;
+ FIO_FileDescriptor fd;
+
+ Storage_ALLOCATE ((void **) &fd, sizeof (FIO_fds));
+ if (fd == NULL)
+ {
+ SetState (Error, FIO_outofmemory);
+ return Error;
+ }
+ else
+ {
+ Indexing_PutIndice (FileInfo, f, reinterpret_cast<void *> (fd));
+ fd->name.size = flength+1; /* need to guarantee the nul for C */
+ fd->usage = use; /* need to guarantee the nul for C */
+ fd->output = towrite;
+ Storage_ALLOCATE (&fd->name.address, fd->name.size);
+ if (fd->name.address == NULL)
+ {
+ fd->state = FIO_outofmemory;
+ return f;
+ }
+ fd->name.address = libc_strncpy (fd->name.address, fname, flength);
+ /* and assign nul to the last byte */
+ p = static_cast<FIO_PtrToChar> (fd->name.address);
+ p += flength;
+ (*p) = ASCII_nul;
+ fd->abspos = 0;
+ /* now for the buffer */
+ Storage_ALLOCATE ((void **) &fd->buffer, sizeof (FIO_buf));
+ if (fd->buffer == NULL)
+ {
+ SetState (Error, FIO_outofmemory);
+ return Error;
+ }
+ else
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->bufstart = 0;
+ fd->buffer->size = buflength;
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ if (fd->buffer->size == 0)
+ {
+ fd->buffer->address = NULL;
+ }
+ else
+ {
+ Storage_ALLOCATE (&fd->buffer->address, fd->buffer->size);
+ if (fd->buffer->address == NULL)
+ {
+ fd->state = FIO_outofmemory;
+ return f;
+ }
+ }
+ if (towrite)
+ {
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->buffer->left = 0;
+ }
+ fd->buffer->contents = reinterpret_cast<FIO__T7 *> (fd->buffer->address); /* provides easy access for reading characters */
+ fd->state = fstate; /* provides easy access for reading characters */
+ }
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConnectToUnix - connects a FIO file to a UNIX file descriptor.
+*/
+
+static void ConnectToUnix (FIO_File f, unsigned int towrite, unsigned int newfile)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if (towrite)
+ {
+ if (newfile)
+ {
+ fd->unixfd = libc_creat (fd->name.address, CreatePermissions);
+ }
+ else
+ {
+ fd->unixfd = libc_open (fd->name.address, UNIXWRITEONLY, 0);
+ }
+ }
+ else
+ {
+ fd->unixfd = libc_open (fd->name.address, UNIXREADONLY, 0);
+ }
+ if (fd->unixfd < 0)
+ {
+ fd->state = FIO_connectionfailure;
+ }
+ }
+ }
+}
+
+
+/*
+ ReadFromBuffer - attempts to read, nBytes, from file, f.
+ It firstly consumes the buffer and then performs
+ direct unbuffered reads. This should only be used
+ when wishing to read large files.
+
+ The actual number of bytes read is returned.
+ -1 is returned if EOF is reached.
+*/
+
+static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes)
+{
+ typedef unsigned char *ReadFromBuffer__T1;
+
+ void * t;
+ int result;
+ unsigned int total;
+ unsigned int n;
+ ReadFromBuffer__T1 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ total = 0; /* how many bytes have we read */
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f)); /* how many bytes have we read */
+ /* extract from the buffer first */
+ if ((fd->buffer != NULL) && fd->buffer->valid)
+ {
+ if (fd->buffer->left > 0)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (nBytes == 1)
+ {
+ /* too expensive to call memcpy for 1 character */
+ p = static_cast<ReadFromBuffer__T1> (a);
+ (*p) = static_cast<unsigned char> ((*fd->buffer->contents).array[fd->buffer->position]);
+ fd->buffer->left -= 1; /* remove consumed bytes */
+ fd->buffer->position += 1; /* move onwards n bytes */
+ nBytes = 0;
+ /* read */
+ return 1;
+ }
+ else
+ {
+ n = Min (fd->buffer->left, nBytes);
+ t = fd->buffer->address;
+ t = reinterpret_cast<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
+ p = static_cast<ReadFromBuffer__T1> (libc_memcpy (a, t, static_cast<size_t> (n)));
+ fd->buffer->left -= n; /* remove consumed bytes */
+ fd->buffer->position += n; /* move onwards n bytes */
+ /* move onwards ready for direct reads */
+ a = reinterpret_cast<void *> (reinterpret_cast<char *> (a)+n);
+ nBytes -= n; /* reduce the amount for future direct */
+ /* read */
+ total += n;
+ return total; /* much cleaner to return now, */
+ }
+ /* difficult to record an error if */
+ }
+ /* the read below returns -1 */
+ }
+ if (nBytes > 0)
+ {
+ /* still more to read */
+ result = static_cast<int> (libc_read (fd->unixfd, a, static_cast<size_t> ((int ) (nBytes))));
+ if (result > 0)
+ {
+ /* avoid dangling else. */
+ total += result;
+ fd->abspos += result;
+ /* now disable the buffer as we read directly into, a. */
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ }
+ }
+ else
+ {
+ if (result == 0)
+ {
+ /* eof reached */
+ fd->state = FIO_endoffile;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ }
+ /* indicate buffer is empty */
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->left = 0;
+ fd->buffer->position = 0;
+ if (fd->buffer->address != NULL)
+ {
+ (*fd->buffer->contents).array[fd->buffer->position] = ASCII_nul;
+ }
+ }
+ return -1;
+ }
+ }
+ return total;
+ }
+ else
+ {
+ return -1;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ BufferedRead - will read, nBytes, through the buffer.
+ Similar to ReadFromBuffer, but this function will always
+ read into the buffer before copying into memory.
+
+ Useful when performing small reads.
+*/
+
+static int BufferedRead (FIO_File f, unsigned int nBytes, void * a)
+{
+ typedef unsigned char *BufferedRead__T3;
+
+ void * t;
+ int result;
+ int total;
+ int n;
+ BufferedRead__T3 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ total = 0; /* how many bytes have we read */
+ if (fd != NULL) /* how many bytes have we read */
+ {
+ /* extract from the buffer first */
+ if (fd->buffer != NULL)
+ {
+ while (nBytes > 0)
+ {
+ if ((fd->buffer->left > 0) && fd->buffer->valid)
+ {
+ if (nBytes == 1)
+ {
+ /* too expensive to call memcpy for 1 character */
+ p = static_cast<BufferedRead__T3> (a);
+ (*p) = static_cast<unsigned char> ((*fd->buffer->contents).array[fd->buffer->position]);
+ fd->buffer->left -= 1; /* remove consumed byte */
+ fd->buffer->position += 1; /* move onwards n byte */
+ total += 1; /* move onwards n byte */
+ return total;
+ }
+ else
+ {
+ n = Min (fd->buffer->left, nBytes);
+ t = fd->buffer->address;
+ t = reinterpret_cast<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
+ p = static_cast<BufferedRead__T3> (libc_memcpy (a, t, static_cast<size_t> (n)));
+ fd->buffer->left -= n; /* remove consumed bytes */
+ fd->buffer->position += n; /* move onwards n bytes */
+ /* move onwards ready for direct reads */
+ a = reinterpret_cast<void *> (reinterpret_cast<char *> (a)+n);
+ nBytes -= n; /* reduce the amount for future direct */
+ /* read */
+ total += n;
+ }
+ }
+ else
+ {
+ /* refill buffer */
+ n = static_cast<int> (libc_read (fd->unixfd, fd->buffer->address, static_cast<size_t> (fd->buffer->size)));
+ if (n >= 0)
+ {
+ /* avoid dangling else. */
+ fd->buffer->valid = TRUE;
+ fd->buffer->position = 0;
+ fd->buffer->left = n;
+ fd->buffer->filled = n;
+ fd->buffer->bufstart = fd->abspos;
+ fd->abspos += n;
+ if (n == 0)
+ {
+ /* eof reached */
+ fd->state = FIO_endoffile;
+ return -1;
+ }
+ }
+ else
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->position = 0;
+ fd->buffer->left = 0;
+ fd->buffer->filled = 0;
+ fd->state = FIO_failed;
+ return total;
+ }
+ }
+ }
+ return total;
+ }
+ }
+ }
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ HandleEscape - translates
+ and \t into their respective ascii codes.
+*/
+
+static void HandleEscape (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, unsigned int *i, unsigned int *j, unsigned int HighSrc, unsigned int HighDest)
+{
+ char src[_src_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (src, src_, _src_high+1);
+
+ if (((((*i)+1) < HighSrc) && (src[(*i)] == '\\')) && ((*j) < HighDest))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (src[(*i)+1] == 'n')
+ {
+ /* requires a newline */
+ dest[(*j)] = ASCII_nl;
+ (*j) += 1;
+ (*i) += 2;
+ }
+ else if (src[(*i)+1] == 't')
+ {
+ /* avoid dangling else. */
+ /* requires a tab (yuck) tempted to fake this but I better not.. */
+ dest[(*j)] = ASCII_tab;
+ (*j) += 1;
+ (*i) += 2;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ /* copy escaped character */
+ (*i) += 1;
+ dest[(*j)] = src[(*i)];
+ (*j) += 1;
+ (*i) += 1;
+ }
+ }
+}
+
+
+/*
+ Cast - casts a := b
+*/
+
+static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (b, b_, _b_high+1);
+
+ if (_a_high == _b_high)
+ {
+ for (i=0; i<=_a_high; i++)
+ {
+ a[i] = b[i];
+ }
+ }
+ else
+ {
+ FormatError ((const char *) "cast failed", 11);
+ }
+}
+
+
+/*
+ StringFormat1 - converts string, src, into, dest, together with encapsulated
+ entity, w. It only formats the first %s or %d with n.
+*/
+
+static void StringFormat1 (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, const unsigned char *w_, unsigned int _w_high)
+{
+ typedef struct StringFormat1__T8_a StringFormat1__T8;
+
+ typedef char *StringFormat1__T4;
+
+ struct StringFormat1__T8_a { char array[MaxErrorString+1]; };
+ unsigned int HighSrc;
+ unsigned int HighDest;
+ unsigned int c;
+ unsigned int i;
+ unsigned int j;
+ StringFormat1__T8 str;
+ StringFormat1__T4 p;
+ char src[_src_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (src, src_, _src_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ HighSrc = StrLib_StrLen ((const char *) src, _src_high);
+ HighDest = _dest_high;
+ p = NULL;
+ c = 0;
+ i = 0;
+ j = 0;
+ while ((((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest)) && (src[i] != '%'))
+ {
+ if (src[i] == '\\')
+ {
+ HandleEscape ((char *) dest, _dest_high, (const char *) src, _src_high, &i, &j, HighSrc, HighDest);
+ }
+ else
+ {
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ }
+ if ((((i+1) < HighSrc) && (src[i] == '%')) && (j < HighDest))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (src[i+1] == 's')
+ {
+ Cast ((unsigned char *) &p, (sizeof (p)-1), (const unsigned char *) w, _w_high);
+ while ((j < HighDest) && ((*p) != ASCII_nul))
+ {
+ dest[j] = (*p);
+ j += 1;
+ p += 1;
+ }
+ if (j < HighDest)
+ {
+ dest[j] = ASCII_nul;
+ }
+ j = StrLib_StrLen ((const char *) dest, _dest_high);
+ i += 2;
+ }
+ else if (src[i+1] == 'd')
+ {
+ /* avoid dangling else. */
+ dest[j] = ASCII_nul;
+ Cast ((unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) w, _w_high);
+ NumberIO_CardToStr (c, 0, (char *) &str.array[0], MaxErrorString);
+ StrLib_StrConCat ((const char *) dest, _dest_high, (const char *) &str.array[0], MaxErrorString, (char *) dest, _dest_high);
+ j = StrLib_StrLen ((const char *) dest, _dest_high);
+ i += 2;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ }
+ /* and finish off copying src into dest */
+ while (((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest))
+ {
+ if (src[i] == '\\')
+ {
+ HandleEscape ((char *) dest, _dest_high, (const char *) src, _src_high, &i, &j, HighSrc, HighDest);
+ }
+ else
+ {
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ }
+ if (j < HighDest)
+ {
+ dest[j] = ASCII_nul;
+ }
+}
+
+
+/*
+ FormatError - provides a orthoganal counterpart to the procedure below.
+*/
+
+static void FormatError (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ FIO_WriteString (FIO_StdErr, (const char *) a, _a_high);
+}
+
+
+/*
+ FormatError1 - generic error procedure taking standard format string
+ and single parameter.
+*/
+
+static void FormatError1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high)
+{
+ typedef struct FormatError1__T9_a FormatError1__T9;
+
+ struct FormatError1__T9_a { char array[MaxErrorString+1]; };
+ FormatError1__T9 s;
+ char a[_a_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ StringFormat1 ((char *) &s.array[0], MaxErrorString, (const char *) a, _a_high, (const unsigned char *) w, _w_high);
+ FormatError ((const char *) &s.array[0], MaxErrorString);
+}
+
+
+/*
+ FormatError2 - generic error procedure taking standard format string
+ and two parameters.
+*/
+
+static void FormatError2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high)
+{
+ typedef struct FormatError2__T10_a FormatError2__T10;
+
+ struct FormatError2__T10_a { char array[MaxErrorString+1]; };
+ FormatError2__T10 s;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+
+ StringFormat1 ((char *) &s.array[0], MaxErrorString, (const char *) a, _a_high, (const unsigned char *) w1, _w1_high);
+ FormatError1 ((const char *) &s.array[0], MaxErrorString, (const unsigned char *) w2, _w2_high);
+}
+
+
+/*
+ CheckAccess - checks to see whether a file f has been
+ opened for read/write.
+*/
+
+static void CheckAccess (FIO_File f, FIO_FileUsage use, unsigned int towrite)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ /* avoid dangling else. */
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ if (f != FIO_StdErr)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ }
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ if ((use == FIO_openedforwrite) && (fd->usage == FIO_openedforread))
+ {
+ FormatError1 ((const char *) "this file (%s) has been opened for reading but is now being written\\n", 69, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else if ((use == FIO_openedforread) && (fd->usage == FIO_openedforwrite))
+ {
+ /* avoid dangling else. */
+ FormatError1 ((const char *) "this file (%s) has been opened for writing but is now being read\\n", 66, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else if (fd->state == FIO_connectionfailure)
+ {
+ /* avoid dangling else. */
+ FormatError1 ((const char *) "this file (%s) was not successfully opened\\n", 44, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else if (towrite != fd->output)
+ {
+ /* avoid dangling else. */
+ if (fd->output)
+ {
+ FormatError1 ((const char *) "this file (%s) was opened for writing but is now being read\\n", 61, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ FormatError1 ((const char *) "this file (%s) was opened for reading but is now being written\\n", 64, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ }
+ }
+ }
+ else
+ {
+ FormatError ((const char *) "this file has not been opened successfully\\n", 44);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ SetEndOfLine -
+*/
+
+static void SetEndOfLine (FIO_File f, char ch)
+{
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (ch == ASCII_nl)
+ {
+ fd->state = FIO_endofline;
+ }
+ else
+ {
+ fd->state = FIO_successful;
+ }
+ }
+}
+
+
+/*
+ BufferedWrite - will write, nBytes, through the buffer.
+ Similar to WriteNBytes, but this function will always
+ write into the buffer before copying into memory.
+
+ Useful when performing small writes.
+*/
+
+static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a)
+{
+ typedef unsigned char *BufferedWrite__T5;
+
+ void * t;
+ int result;
+ int total;
+ int n;
+ BufferedWrite__T5 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ total = 0; /* how many bytes have we read */
+ if (fd->buffer != NULL) /* how many bytes have we read */
+ {
+ /* place into the buffer first */
+ while (nBytes > 0)
+ {
+ if (fd->buffer->left > 0)
+ {
+ if (nBytes == 1)
+ {
+ /* too expensive to call memcpy for 1 character */
+ p = static_cast<BufferedWrite__T5> (a);
+ (*fd->buffer->contents).array[fd->buffer->position] = static_cast<char> ((*p));
+ fd->buffer->left -= 1; /* reduce space */
+ fd->buffer->position += 1; /* move onwards n byte */
+ total += 1; /* move onwards n byte */
+ return total;
+ }
+ else
+ {
+ n = Min (fd->buffer->left, nBytes);
+ t = fd->buffer->address;
+ t = reinterpret_cast<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
+ p = static_cast<BufferedWrite__T5> (libc_memcpy (a, t, static_cast<size_t> ((unsigned int ) (n))));
+ fd->buffer->left -= n; /* remove consumed bytes */
+ fd->buffer->position += n; /* move onwards n bytes */
+ /* move ready for further writes */
+ a = reinterpret_cast<void *> (reinterpret_cast<char *> (a)+n);
+ nBytes -= n; /* reduce the amount for future writes */
+ total += n; /* reduce the amount for future writes */
+ }
+ }
+ else
+ {
+ FIO_FlushBuffer (f);
+ if ((fd->state != FIO_successful) && (fd->state != FIO_endofline))
+ {
+ nBytes = 0;
+ }
+ }
+ }
+ return total;
+ }
+ }
+ }
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PreInitialize - preinitialize the file descriptor.
+*/
+
+static void PreInitialize (FIO_File f, const char *fname_, unsigned int _fname_high, FIO_FileStatus state, FIO_FileUsage use, unsigned int towrite, int osfd, unsigned int bufsize)
+{
+ FIO_FileDescriptor fd;
+ FIO_FileDescriptor fe;
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ if ((InitializeFile (f, &fname, StrLib_StrLen ((const char *) fname, _fname_high), state, use, towrite, bufsize)) == f)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (f == Error)
+ {
+ fe = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, FIO_StdErr));
+ if (fe == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ fd->unixfd = fe->unixfd; /* the error channel */
+ }
+ }
+ else
+ {
+ fd->unixfd = osfd;
+ }
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ Init - initialize the modules, global variables.
+*/
+
+static void Init (void)
+{
+ FileInfo = Indexing_InitIndex (0);
+ Error = 0;
+ PreInitialize (Error, (const char *) "error", 5, FIO_toomanyfilesopen, FIO_unused, FALSE, -1, 0);
+ FIO_StdIn = 1;
+ PreInitialize (FIO_StdIn, (const char *) "<stdin>", 7, FIO_successful, FIO_openedforread, FALSE, 0, MaxBufferLength);
+ FIO_StdOut = 2;
+ PreInitialize (FIO_StdOut, (const char *) "<stdout>", 8, FIO_successful, FIO_openedforwrite, TRUE, 1, MaxBufferLength);
+ FIO_StdErr = 3;
+ PreInitialize (FIO_StdErr, (const char *) "<stderr>", 8, FIO_successful, FIO_openedforwrite, TRUE, 2, MaxBufferLength);
+ if (! (M2RTS_InstallTerminationProcedure ((PROC ) {(PROC_t) FIO_FlushOutErr})))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ IsNoError - returns a TRUE if no error has occured on file, f.
+*/
+
+extern "C" unsigned int FIO_IsNoError (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f == Error)
+ {
+ return FALSE;
+ }
+ else
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ return (fd != NULL) && (((fd->state == FIO_successful) || (fd->state == FIO_endoffile)) || (fd->state == FIO_endofline));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsActive - returns TRUE if the file, f, is still active.
+*/
+
+extern "C" unsigned int FIO_IsActive (FIO_File f)
+{
+ if (f == Error)
+ {
+ return FALSE;
+ }
+ else
+ {
+ return (Indexing_GetIndice (FileInfo, f)) != NULL;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ /*
+ The following functions are wrappers for the above.
+ */
+ return FIO_exists (&fname, StrLib_StrLen ((const char *) fname, _fname_high));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ return FIO_openToRead (&fname, StrLib_StrLen ((const char *) fname, _fname_high));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ return FIO_openToWrite (&fname, StrLib_StrLen ((const char *) fname, _fname_high));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ return FIO_openForRandom (&fname, StrLib_StrLen ((const char *) fname, _fname_high), towrite, newfile);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Close - close a file which has been previously opened using:
+ OpenToRead, OpenToWrite, OpenForRandom.
+ It is correct to close a file which has an error status.
+*/
+
+extern "C" void FIO_Close (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ /*
+ we allow users to close files which have an error status
+ */
+ if (fd != NULL)
+ {
+ FIO_FlushBuffer (f);
+ if (fd->unixfd >= 0)
+ {
+ if ((libc_close (fd->unixfd)) != 0)
+ {
+ FormatError1 ((const char *) "failed to close file (%s)\\n", 27, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ fd->state = FIO_failed; /* --fixme-- too late to notify user (unless we return a BOOLEAN) */
+ }
+ }
+ if (fd->name.address != NULL)
+ {
+ Storage_DEALLOCATE (&fd->name.address, fd->name.size);
+ }
+ if (fd->buffer != NULL)
+ {
+ if (fd->buffer->address != NULL)
+ {
+ Storage_DEALLOCATE (&fd->buffer->address, fd->buffer->size);
+ }
+ Storage_DEALLOCATE ((void **) &fd->buffer, sizeof (FIO_buf));
+ fd->buffer = NULL;
+ }
+ Storage_DEALLOCATE ((void **) &fd, sizeof (FIO_fds));
+ Indexing_PutIndice (FileInfo, f, NULL);
+ }
+ }
+}
+
+
+/*
+ exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int FIO_exists (void * fname, unsigned int flength)
+{
+ FIO_File f;
+
+ f = FIO_openToRead (fname, flength);
+ if (FIO_IsNoError (f))
+ {
+ FIO_Close (f);
+ return TRUE;
+ }
+ else
+ {
+ FIO_Close (f);
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength)
+{
+ FIO_File f;
+
+ f = GetNextFreeDescriptor ();
+ if (f == Error)
+ {
+ SetState (f, FIO_toomanyfilesopen);
+ }
+ else
+ {
+ f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforread, FALSE, MaxBufferLength);
+ ConnectToUnix (f, FALSE, FALSE);
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength)
+{
+ FIO_File f;
+
+ f = GetNextFreeDescriptor ();
+ if (f == Error)
+ {
+ SetState (f, FIO_toomanyfilesopen);
+ }
+ else
+ {
+ f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforwrite, TRUE, MaxBufferLength);
+ ConnectToUnix (f, TRUE, TRUE);
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+*/
+
+extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile)
+{
+ FIO_File f;
+
+ f = GetNextFreeDescriptor ();
+ if (f == Error)
+ {
+ SetState (f, FIO_toomanyfilesopen);
+ }
+ else
+ {
+ f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforrandom, towrite, MaxBufferLength);
+ ConnectToUnix (f, towrite, newfile);
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FlushBuffer - flush contents of file, f.
+*/
+
+extern "C" void FIO_FlushBuffer (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if (fd->output && (fd->buffer != NULL))
+ {
+ if ((fd->buffer->position == 0) || ((libc_write (fd->unixfd, fd->buffer->address, static_cast<size_t> (fd->buffer->position))) == ((int ) (fd->buffer->position))))
+ {
+ fd->abspos += fd->buffer->position;
+ fd->buffer->bufstart = fd->abspos;
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ }
+ }
+ }
+ }
+}
+
+
+/*
+ ReadNBytes - reads nBytes of a file into memory area, dest, returning
+ the number of bytes actually read.
+ This function will consume from the buffer and then
+ perform direct libc reads. It is ideal for large reads.
+*/
+
+extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest)
+{
+ typedef char *ReadNBytes__T2;
+
+ int n;
+ ReadNBytes__T2 p;
+
+ if (f != Error)
+ {
+ CheckAccess (f, FIO_openedforread, FALSE);
+ n = ReadFromBuffer (f, dest, nBytes);
+ if (n <= 0)
+ {
+ return 0;
+ }
+ else
+ {
+ p = static_cast<ReadNBytes__T2> (dest);
+ p += n-1;
+ SetEndOfLine (f, (*p));
+ return n;
+ }
+ }
+ else
+ {
+ return 0;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ReadAny - reads HIGH(a) bytes into, a. All input
+ is fully buffered, unlike ReadNBytes and thus is more
+ suited to small reads.
+*/
+
+extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high)
+{
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if ((BufferedRead (f, _a_high, a)) == ((int ) (_a_high)))
+ {
+ SetEndOfLine (f, static_cast<char> (a[_a_high]));
+ }
+}
+
+
+/*
+ WriteNBytes - writes nBytes from memory area src to a file
+ returning the number of bytes actually written.
+ This function will flush the buffer and then
+ write the nBytes using a direct write from libc.
+ It is ideal for large writes.
+*/
+
+extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src)
+{
+ int total;
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforwrite, TRUE);
+ FIO_FlushBuffer (f);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ total = static_cast<int> (libc_write (fd->unixfd, src, static_cast<size_t> ((int ) (nBytes))));
+ if (total < 0)
+ {
+ fd->state = FIO_failed;
+ return 0;
+ }
+ else
+ {
+ fd->abspos += (unsigned int ) (total);
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->bufstart = fd->abspos;
+ }
+ return (unsigned int ) (total);
+ }
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteAny - writes HIGH(a) bytes onto, file, f. All output
+ is fully buffered, unlike WriteNBytes and thus is more
+ suited to small writes.
+*/
+
+extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high)
+{
+ CheckAccess (f, FIO_openedforwrite, TRUE);
+ if ((BufferedWrite (f, _a_high, a)) == ((int ) (_a_high)))
+ {} /* empty. */
+}
+
+
+/*
+ WriteChar - writes a single character to file, f.
+*/
+
+extern "C" void FIO_WriteChar (FIO_File f, char ch)
+{
+ CheckAccess (f, FIO_openedforwrite, TRUE);
+ if ((BufferedWrite (f, sizeof (ch), &ch)) == ((int ) (sizeof (ch))))
+ {} /* empty. */
+}
+
+
+/*
+ EOF - tests to see whether a file, f, has reached end of file.
+*/
+
+extern "C" unsigned int FIO_EOF (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ return fd->state == FIO_endoffile;
+ }
+ }
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EOLN - tests to see whether a file, f, is upon a newline.
+ It does NOT consume the newline.
+*/
+
+extern "C" unsigned int FIO_EOLN (FIO_File f)
+{
+ char ch;
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ /*
+ we will read a character and then push it back onto the input stream,
+ having noted the file status, we also reset the status.
+ */
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if ((fd->state == FIO_successful) || (fd->state == FIO_endofline))
+ {
+ ch = FIO_ReadChar (f);
+ if ((fd->state == FIO_successful) || (fd->state == FIO_endofline))
+ {
+ FIO_UnReadChar (f, ch);
+ }
+ return ch == ASCII_nl;
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WasEOLN - tests to see whether a file, f, has just seen a newline.
+*/
+
+extern "C" unsigned int FIO_WasEOLN (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f == Error)
+ {
+ return FALSE;
+ }
+ else
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ return (fd != NULL) && (fd->state == FIO_endofline);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ReadChar - returns a character read from file f.
+ Sensible to check with IsNoError or EOF after calling
+ this function.
+*/
+
+extern "C" char FIO_ReadChar (FIO_File f)
+{
+ char ch;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if ((BufferedRead (f, sizeof (ch), &ch)) == ((int ) (sizeof (ch))))
+ {
+ SetEndOfLine (f, ch);
+ return ch;
+ }
+ else
+ {
+ return ASCII_nul;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ UnReadChar - replaces a character, ch, back into file f.
+ This character must have been read by ReadChar
+ and it does not allow successive calls. It may
+ only be called if the previous read was successful
+ or end of file was seen.
+ If the state was previously endoffile then it
+ is altered to successful.
+ Otherwise it is left alone.
+*/
+
+extern "C" void FIO_UnReadChar (FIO_File f, char ch)
+{
+ FIO_FileDescriptor fd;
+ unsigned int n;
+ void * a;
+ void * b;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (((fd->state == FIO_successful) || (fd->state == FIO_endoffile)) || (fd->state == FIO_endofline))
+ {
+ /* avoid dangling else. */
+ if ((fd->buffer != NULL) && fd->buffer->valid)
+ {
+ /* we assume that a ReadChar has occurred, we will check just in case. */
+ if (fd->state == FIO_endoffile)
+ {
+ fd->buffer->position = MaxBufferLength;
+ fd->buffer->left = 0;
+ fd->buffer->filled = 0;
+ fd->state = FIO_successful;
+ }
+ if (fd->buffer->position > 0)
+ {
+ fd->buffer->position -= 1;
+ fd->buffer->left += 1;
+ (*fd->buffer->contents).array[fd->buffer->position] = ch;
+ }
+ else
+ {
+ /* if possible make room and store ch */
+ if (fd->buffer->filled == fd->buffer->size)
+ {
+ FormatError1 ((const char *) "performing too many UnReadChar calls on file (%d)\\n", 51, (const unsigned char *) &f, (sizeof (f)-1));
+ }
+ else
+ {
+ n = fd->buffer->filled-fd->buffer->position;
+ b = &(*fd->buffer->contents).array[fd->buffer->position];
+ a = &(*fd->buffer->contents).array[fd->buffer->position+1];
+ a = libc_memcpy (a, b, static_cast<size_t> (n));
+ fd->buffer->filled += 1;
+ (*fd->buffer->contents).array[fd->buffer->position] = ch;
+ }
+ }
+ }
+ }
+ else
+ {
+ FormatError1 ((const char *) "UnReadChar can only be called if the previous read was successful or end of file, error on file (%d)\\n", 102, (const unsigned char *) &f, (sizeof (f)-1));
+ }
+ }
+}
+
+
+/*
+ WriteLine - writes out a linefeed to file, f.
+*/
+
+extern "C" void FIO_WriteLine (FIO_File f)
+{
+ FIO_WriteChar (f, ASCII_nl);
+}
+
+
+/*
+ WriteString - writes a string to file, f.
+*/
+
+extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high)
+{
+ unsigned int l;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ l = StrLib_StrLen ((const char *) a, _a_high);
+ if ((FIO_WriteNBytes (f, l, &a)) != l)
+ {} /* empty. */
+}
+
+
+/*
+ ReadString - reads a string from file, f, into string, a.
+ It terminates the string if HIGH is reached or
+ if a newline is seen or an error occurs.
+*/
+
+extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high)
+{
+ unsigned int high;
+ unsigned int i;
+ char ch;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ high = _a_high;
+ i = 0;
+ do {
+ ch = FIO_ReadChar (f);
+ if (i <= high)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (((ch == ASCII_nl) || (! (FIO_IsNoError (f)))) || (FIO_EOF (f)))
+ {
+ a[i] = ASCII_nul;
+ i += 1;
+ }
+ else
+ {
+ a[i] = ch;
+ i += 1;
+ }
+ }
+ } while (! ((((ch == ASCII_nl) || (i > high)) || (! (FIO_IsNoError (f)))) || (FIO_EOF (f))));
+}
+
+
+/*
+ WriteCardinal - writes a CARDINAL to file, f.
+ It writes the binary image of the cardinal
+ to file, f.
+*/
+
+extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c)
+{
+ FIO_WriteAny (f, (unsigned char *) &c, (sizeof (c)-1));
+}
+
+
+/*
+ ReadCardinal - reads a CARDINAL from file, f.
+ It reads a binary image of a CARDINAL
+ from a file, f.
+*/
+
+extern "C" unsigned int FIO_ReadCardinal (FIO_File f)
+{
+ unsigned int c;
+
+ FIO_ReadAny (f, (unsigned char *) &c, (sizeof (c)-1));
+ return c;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+*/
+
+extern "C" int FIO_GetUnixFileDescriptor (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ return fd->unixfd;
+ }
+ }
+ FormatError1 ((const char *) "file %d has not been opened or is out of range\\n", 48, (const unsigned char *) &f, (sizeof (f)-1));
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetPositionFromBeginning - sets the position from the beginning of the file.
+*/
+
+extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos)
+{
+ long int offset;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ /* always force the lseek, until we are confident that abspos is always correct,
+ basically it needs some hard testing before we should remove the OR TRUE. */
+ if ((fd->abspos != pos) || TRUE)
+ {
+ FIO_FlushBuffer (f);
+ if (fd->buffer != NULL)
+ {
+ if (fd->output)
+ {
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->buffer->left = 0;
+ }
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ }
+ offset = libc_lseek (fd->unixfd, pos, SEEK_SET);
+ if ((offset >= 0) && (pos == offset))
+ {
+ fd->abspos = pos;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ fd->abspos = 0;
+ }
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->bufstart = fd->abspos;
+ }
+ }
+ }
+ }
+}
+
+
+/*
+ SetPositionFromEnd - sets the position from the end of the file.
+*/
+
+extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos)
+{
+ long int offset;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ FIO_FlushBuffer (f);
+ if (fd->buffer != NULL)
+ {
+ if (fd->output)
+ {
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->buffer->left = 0;
+ }
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ }
+ offset = libc_lseek (fd->unixfd, pos, SEEK_END);
+ if (offset >= 0)
+ {
+ fd->abspos = offset;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ fd->abspos = 0;
+ offset = 0;
+ }
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->bufstart = offset;
+ }
+ }
+ }
+}
+
+
+/*
+ FindPosition - returns the current absolute position in file, f.
+*/
+
+extern "C" long int FIO_FindPosition (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if ((fd->buffer == NULL) || ! fd->buffer->valid)
+ {
+ return fd->abspos;
+ }
+ else
+ {
+ return fd->buffer->bufstart+((long int ) (fd->buffer->position));
+ }
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetFileName - assigns, a, with the filename associated with, f.
+*/
+
+extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high)
+{
+ typedef char *GetFileName__T6;
+
+ unsigned int i;
+ GetFileName__T6 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ if (fd->name.address == NULL)
+ {
+ StrLib_StrCopy ((const char *) "", 0, (char *) a, _a_high);
+ }
+ else
+ {
+ p = static_cast<GetFileName__T6> (fd->name.address);
+ i = 0;
+ while (((*p) != ASCII_nul) && (i <= _a_high))
+ {
+ a[i] = (*p);
+ p += 1;
+ i += 1;
+ }
+ }
+ }
+ }
+}
+
+
+/*
+ getFileName - returns the address of the filename associated with, f.
+*/
+
+extern "C" void * FIO_getFileName (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return fd->name.address;
+ }
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getFileNameLength - returns the number of characters associated with filename, f.
+*/
+
+extern "C" unsigned int FIO_getFileNameLength (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return fd->name.size;
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FlushOutErr - flushes, StdOut, and, StdErr.
+ It is also called when the application calls M2RTS.Terminate.
+ (which is automatically placed in program modules by the GM2
+ scaffold).
+*/
+
+extern "C" void FIO_FlushOutErr (void)
+{
+ if (FIO_IsNoError (FIO_StdOut))
+ {
+ FIO_FlushBuffer (FIO_StdOut);
+ }
+ if (FIO_IsNoError (FIO_StdErr))
+ {
+ FIO_FlushBuffer (FIO_StdErr);
+ }
+}
+
+extern "C" void _M2_FIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_FIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ FIO_FlushOutErr ();
+}
--- /dev/null
+/* do not edit automatically generated by mc from FormatStrings. */
+/* FormatStrings.mod provides a pseudo printf capability.
+
+Copyright (C) 2005-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _FormatStrings_H
+#define _FormatStrings_C
+
+# include "GDynamicStrings.h"
+# include "GStringConvert.h"
+# include "GSYSTEM.h"
+# include "GASCII.h"
+# include "GM2RTS.h"
+
+
+/*
+ Sprintf0 - returns a String containing, s, after it has had its
+ escape sequences translated.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt);
+
+/*
+ Sprintf1 - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d with n.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ Sprintf2 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf2 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+
+/*
+ Sprintf3 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf3 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+
+/*
+ Sprintf4 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf4 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high);
+
+/*
+ HandleEscape - translates \a, \b, \e, \f,
+, \r, \x[hex] \[octal] into
+ their respective ascii codes. It also converts \[any] into
+ a single [any] character.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s);
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void);
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s);
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void);
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s);
+
+/*
+ IsDigit - returns TRUE if ch lies in the range: 0..9
+*/
+
+static unsigned int IsDigit (char ch);
+
+/*
+ Cast - casts a := b
+*/
+
+static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high);
+
+/*
+ isHex -
+*/
+
+static unsigned int isHex (char ch);
+
+/*
+ toHex -
+*/
+
+static unsigned int toHex (char ch);
+
+/*
+ toOct -
+*/
+
+static unsigned int toOct (char ch);
+
+/*
+ isOct -
+*/
+
+static unsigned int isOct (char ch);
+
+/*
+ FormatString - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d or %u with n.
+ A new string is returned.
+*/
+
+static DynamicStrings_String FormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ FormatString - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d or %u with n.
+ A new string is returned.
+*/
+
+static DynamicStrings_String PerformFormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ Copy - copies, fmt[start:end] -> in and returns in. Providing that start >= 0.
+*/
+
+static DynamicStrings_String Copy (DynamicStrings_String fmt, DynamicStrings_String in, int start, int end);
+
+/*
+ HandlePercent - pre-condition: s, is a string.
+ Post-condition: a new string is returned which is a copy of,
+ s, except %% is transformed into %.
+*/
+
+static DynamicStrings_String HandlePercent (DynamicStrings_String fmt, DynamicStrings_String s, int startpos);
+
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void)
+{
+ DynamicStrings_PushAllocation ();
+}
+
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s)
+{
+ s = DynamicStrings_PopAllocationExemption (TRUE, s);
+}
+
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void)
+{
+}
+
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s)
+{
+}
+
+
+/*
+ IsDigit - returns TRUE if ch lies in the range: 0..9
+*/
+
+static unsigned int IsDigit (char ch)
+{
+ return (ch >= '0') && (ch <= '9');
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Cast - casts a := b
+*/
+
+static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (b, b_, _b_high+1);
+
+ if (_a_high == _b_high)
+ {
+ for (i=0; i<=_a_high; i++)
+ {
+ a[i] = b[i];
+ }
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ isHex -
+*/
+
+static unsigned int isHex (char ch)
+{
+ return (((ch >= '0') && (ch <= '9')) || ((ch >= 'A') && (ch <= 'F'))) || ((ch >= 'a') && (ch <= 'f'));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ toHex -
+*/
+
+static unsigned int toHex (char ch)
+{
+ if ((ch >= '0') && (ch <= '9'))
+ {
+ return ((unsigned int) (ch))- ((unsigned int) ('0'));
+ }
+ else if ((ch >= 'A') && (ch <= 'F'))
+ {
+ /* avoid dangling else. */
+ return ( ((unsigned int) (ch))- ((unsigned int) ('A')))+10;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return ( ((unsigned int) (ch))- ((unsigned int) ('a')))+10;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ toOct -
+*/
+
+static unsigned int toOct (char ch)
+{
+ return ((unsigned int) (ch))- ((unsigned int) ('0'));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isOct -
+*/
+
+static unsigned int isOct (char ch)
+{
+ return (ch >= '0') && (ch <= '8');
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FormatString - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d or %u with n.
+ A new string is returned.
+*/
+
+static DynamicStrings_String FormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high)
+{
+ DynamicStrings_String s;
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w, w_, _w_high+1);
+
+ DSdbEnter ();
+ if ((*startpos) >= 0)
+ {
+ s = PerformFormatString (fmt, startpos, in, (const unsigned char *) w, _w_high);
+ }
+ else
+ {
+ s = DynamicStrings_Dup (in);
+ }
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FormatString - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d or %u with n.
+ A new string is returned.
+*/
+
+static DynamicStrings_String PerformFormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high)
+{
+ unsigned int left;
+ unsigned int u;
+ int c;
+ int width;
+ int nextperc;
+ int afterperc;
+ int endpos;
+ char leader;
+ char ch;
+ char ch2;
+ DynamicStrings_String p;
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w, w_, _w_high+1);
+
+ while ((*startpos) >= 0)
+ {
+ nextperc = DynamicStrings_Index (fmt, '%', static_cast<unsigned int> ((*startpos)));
+ afterperc = nextperc;
+ if (nextperc >= 0)
+ {
+ afterperc += 1;
+ if ((DynamicStrings_char (fmt, afterperc)) == '-')
+ {
+ left = TRUE;
+ afterperc += 1;
+ }
+ else
+ {
+ left = FALSE;
+ }
+ ch = DynamicStrings_char (fmt, afterperc);
+ if (ch == '0')
+ {
+ leader = '0';
+ }
+ else
+ {
+ leader = ' ';
+ }
+ width = 0;
+ while (IsDigit (ch))
+ {
+ width = (width*10)+((int ) ( ((unsigned int) (ch))- ((unsigned int) ('0'))));
+ afterperc += 1;
+ ch = DynamicStrings_char (fmt, afterperc);
+ }
+ if ((ch == 'c') || (ch == 's'))
+ {
+ afterperc += 1;
+ if (ch == 'c')
+ {
+ ch2 = static_cast<char> (w[0]);
+ p = DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "", 0), ch2);
+ }
+ else
+ {
+ Cast ((unsigned char *) &p, (sizeof (p)-1), (const unsigned char *) w, _w_high);
+ p = DynamicStrings_Dup (p);
+ }
+ if ((width > 0) && (((int ) (DynamicStrings_Length (p))) < width))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (left)
+ {
+ /* place trailing spaces after, p. */
+ p = DynamicStrings_ConCat (p, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " ", 1)), static_cast<unsigned int> (width-((int ) (DynamicStrings_Length (p)))))));
+ }
+ else
+ {
+ /* padd string, p, with leading spaces. */
+ p = DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " ", 1)), static_cast<unsigned int> (width-((int ) (DynamicStrings_Length (p))))), DynamicStrings_Mark (p));
+ }
+ }
+ /* include string, p, into, in. */
+ if (nextperc > 0)
+ {
+ in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc));
+ }
+ in = DynamicStrings_ConCat (in, p);
+ (*startpos) = afterperc;
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ }
+ else if (ch == 'd')
+ {
+ /* avoid dangling else. */
+ afterperc += 1;
+ Cast ((unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) w, _w_high);
+ in = Copy (fmt, in, (*startpos), nextperc);
+ in = DynamicStrings_ConCat (in, StringConvert_IntegerToString (c, static_cast<unsigned int> (width), leader, FALSE, 10, FALSE));
+ (*startpos) = afterperc;
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ }
+ else if (ch == 'x')
+ {
+ /* avoid dangling else. */
+ afterperc += 1;
+ Cast ((unsigned char *) &u, (sizeof (u)-1), (const unsigned char *) w, _w_high);
+ in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc));
+ in = DynamicStrings_ConCat (in, StringConvert_CardinalToString (u, static_cast<unsigned int> (width), leader, 16, TRUE));
+ (*startpos) = afterperc;
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ }
+ else if (ch == 'u')
+ {
+ /* avoid dangling else. */
+ afterperc += 1;
+ Cast ((unsigned char *) &u, (sizeof (u)-1), (const unsigned char *) w, _w_high);
+ in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc));
+ in = DynamicStrings_ConCat (in, StringConvert_CardinalToString (u, static_cast<unsigned int> (width), leader, 10, FALSE));
+ (*startpos) = afterperc;
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ afterperc += 1;
+ /* copy format string. */
+ if (nextperc > 0)
+ {
+ in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc));
+ }
+ /* and the character after the %. */
+ in = DynamicStrings_ConCat (in, DynamicStrings_Mark (DynamicStrings_InitStringChar (ch)));
+ }
+ (*startpos) = afterperc;
+ }
+ else
+ {
+ /* nothing to do. */
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ }
+ }
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Copy - copies, fmt[start:end] -> in and returns in. Providing that start >= 0.
+*/
+
+static DynamicStrings_String Copy (DynamicStrings_String fmt, DynamicStrings_String in, int start, int end)
+{
+ if (start >= 0)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (end > 0)
+ {
+ in = DynamicStrings_ConCat (in, DynamicStrings_Mark (DynamicStrings_Slice (fmt, start, end)));
+ }
+ else if (end < 0)
+ {
+ /* avoid dangling else. */
+ in = DynamicStrings_ConCat (in, DynamicStrings_Mark (DynamicStrings_Slice (fmt, start, 0)));
+ }
+ }
+ return in;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ HandlePercent - pre-condition: s, is a string.
+ Post-condition: a new string is returned which is a copy of,
+ s, except %% is transformed into %.
+*/
+
+static DynamicStrings_String HandlePercent (DynamicStrings_String fmt, DynamicStrings_String s, int startpos)
+{
+ int prevpos;
+ DynamicStrings_String result;
+
+ if ((startpos == ((int ) (DynamicStrings_Length (fmt)))) || (startpos < 0))
+ {
+ return s;
+ }
+ else
+ {
+ prevpos = startpos;
+ while ((startpos >= 0) && (prevpos < ((int ) (DynamicStrings_Length (fmt)))))
+ {
+ startpos = DynamicStrings_Index (fmt, '%', static_cast<unsigned int> (startpos));
+ if (startpos >= prevpos)
+ {
+ if (startpos > 0)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Slice (fmt, prevpos, startpos)));
+ }
+ startpos += 1;
+ if ((DynamicStrings_char (fmt, startpos)) == '%')
+ {
+ s = DynamicStrings_ConCatChar (s, '%');
+ startpos += 1;
+ }
+ prevpos = startpos;
+ }
+ }
+ if (prevpos < ((int ) (DynamicStrings_Length (fmt))))
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Slice (fmt, prevpos, 0)));
+ }
+ return s;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Sprintf0 - returns a String containing, s, after it has had its
+ escape sequences translated.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt)
+{
+ DynamicStrings_String s;
+
+ DSdbEnter ();
+ fmt = FormatStrings_HandleEscape (fmt);
+ s = HandlePercent (fmt, DynamicStrings_InitString ((const char *) "", 0), 0);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Sprintf1 - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d with n.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high)
+{
+ int i;
+ DynamicStrings_String s;
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w, w_, _w_high+1);
+
+ DSdbEnter ();
+ fmt = FormatStrings_HandleEscape (fmt);
+ i = 0;
+ s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w, _w_high);
+ s = HandlePercent (fmt, s, i);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Sprintf2 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf2 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high)
+{
+ int i;
+ DynamicStrings_String s;
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+
+ DSdbEnter ();
+ fmt = FormatStrings_HandleEscape (fmt);
+ i = 0;
+ s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w1, _w1_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w2, _w2_high);
+ s = HandlePercent (fmt, s, i);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Sprintf3 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf3 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high)
+{
+ int i;
+ DynamicStrings_String s;
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+
+ DSdbEnter ();
+ fmt = FormatStrings_HandleEscape (fmt);
+ i = 0;
+ s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w1, _w1_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w2, _w2_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w3, _w3_high);
+ s = HandlePercent (fmt, s, i);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Sprintf4 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf4 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high)
+{
+ int i;
+ DynamicStrings_String s;
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+ unsigned char w4[_w4_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+ memcpy (w4, w4_, _w4_high+1);
+
+ DSdbEnter ();
+ fmt = FormatStrings_HandleEscape (fmt);
+ i = 0;
+ s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w1, _w1_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w2, _w2_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w3, _w3_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w4, _w4_high);
+ s = HandlePercent (fmt, s, i);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ HandleEscape - translates \a, \b, \e, \f,
+, \r, \x[hex] \[octal] into
+ their respective ascii codes. It also converts \[any] into
+ a single [any] character.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s)
+{
+ DynamicStrings_String d;
+ int i;
+ int j;
+ char ch;
+ unsigned char b;
+
+ DSdbEnter ();
+ d = DynamicStrings_InitString ((const char *) "", 0);
+ i = DynamicStrings_Index (s, '\\', 0);
+ j = 0;
+ while (i >= 0)
+ {
+ if (i > 0)
+ {
+ /* initially i might be zero which means the end of the string, which is not what we want. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Slice (s, j, i));
+ }
+ ch = DynamicStrings_char (s, i+1);
+ if (ch == 'a')
+ {
+ /* requires a bell. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_bel)));
+ }
+ else if (ch == 'b')
+ {
+ /* avoid dangling else. */
+ /* requires a backspace. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_bs)));
+ }
+ else if (ch == 'e')
+ {
+ /* avoid dangling else. */
+ /* requires a escape. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_esc)));
+ }
+ else if (ch == 'f')
+ {
+ /* avoid dangling else. */
+ /* requires a formfeed. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_ff)));
+ }
+ else if (ch == 'n')
+ {
+ /* avoid dangling else. */
+ /* requires a newline. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_nl)));
+ }
+ else if (ch == 'r')
+ {
+ /* avoid dangling else. */
+ /* requires a carriage return. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_cr)));
+ }
+ else if (ch == 't')
+ {
+ /* avoid dangling else. */
+ /* requires a tab. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_tab)));
+ }
+ else if (ch == 'x')
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if (isHex (DynamicStrings_char (s, i+1)))
+ {
+ b = (unsigned char ) (toHex (DynamicStrings_char (s, i+1)));
+ i += 1;
+ if (isHex (DynamicStrings_char (s, i+1)))
+ {
+ b = (unsigned char ) ((((unsigned int ) (b))*0x010)+(toHex (DynamicStrings_char (s, i+1))));
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar ((char ) (b))));
+ }
+ }
+ }
+ else if (isOct (ch))
+ {
+ /* avoid dangling else. */
+ b = (unsigned char ) (toOct (ch));
+ i += 1;
+ if (isOct (DynamicStrings_char (s, i+1)))
+ {
+ b = (unsigned char ) ((((unsigned int ) (b))*8)+(toOct (DynamicStrings_char (s, i+1))));
+ i += 1;
+ if (isOct (DynamicStrings_char (s, i+1)))
+ {
+ b = (unsigned char ) ((((unsigned int ) (b))*8)+(toOct (DynamicStrings_char (s, i+1))));
+ }
+ }
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar ((char ) (b))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ /* copy escaped character. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ch)));
+ }
+ i += 2;
+ j = i;
+ i = DynamicStrings_Index (s, '\\', (unsigned int ) (i));
+ }
+ /* s := Assign(s, Mark(ConCat(d, Mark(Slice(s, j, 0))))) ; dont Mark(s) in the Slice as we Assign contents */
+ s = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), j, 0)));
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_FormatStrings_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_FormatStrings_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from FpuIO. */
+/* FpuIO.mod implements a fixed format input/output for REAL/LONGREAL.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#define _FpuIO_H
+#define _FpuIO_C
+
+# include "GStrIO.h"
+# include "GStrLib.h"
+# include "GASCII.h"
+# include "GDynamicStrings.h"
+# include "GStringConvert.h"
+
+# define MaxLineLength 100
+extern "C" void FpuIO_ReadReal (double *x);
+
+/*
+ WriteReal - converts a REAL number, x, which has a, TotalWidth, and
+ FractionWidth into, string, a.
+*/
+
+extern "C" void FpuIO_WriteReal (double x, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+ WriteReal - converts a REAL number, x, which has a, TotalWidth, and
+ FractionWidth into, string, a.
+*/
+
+extern "C" void FpuIO_StrToReal (const char *a_, unsigned int _a_high, double *x);
+
+/*
+ RealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_RealToStr (double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high);
+extern "C" void FpuIO_ReadLongReal (long double *x);
+
+/*
+ WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_WriteLongReal (long double x, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+ WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_StrToLongReal (const char *a_, unsigned int _a_high, long double *x);
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_LongRealToStr (long double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high);
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_ReadLongInt (long int *x);
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_WriteLongInt (long int x, unsigned int n);
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_StrToLongInt (const char *a_, unsigned int _a_high, long int *x);
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_LongIntToStr (long int x, unsigned int n, char *a, unsigned int _a_high);
+
+extern "C" void FpuIO_ReadReal (double *x)
+{
+ typedef struct ReadReal__T1_a ReadReal__T1;
+
+ struct ReadReal__T1_a { char array[MaxLineLength+1]; };
+ ReadReal__T1 a;
+
+ /*
+#undef GM2_DEBUG_FPUIO
+if defined(GM2_DEBUG_FPUIO)
+# define InitString(X) InitStringDB(X, __FILE__, __LINE__)
+# define InitStringCharStar(X) InitStringCharStarDB(X, __FILE__, __LINE__)
+# define InitStringChar(X) InitStringCharDB(X, __FILE__, __LINE__)
+# define Mult(X,Y) MultDB(X, Y, __FILE__, __LINE__)
+# define Dup(X) DupDB(X, __FILE__, __LINE__)
+# define Slice(X,Y,Z) SliceDB(X, Y, Z, __FILE__, __LINE__)
+#endif
+ */
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ FpuIO_StrToReal ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+
+/*
+ WriteReal - converts a REAL number, x, which has a, TotalWidth, and
+ FractionWidth into, string, a.
+*/
+
+extern "C" void FpuIO_WriteReal (double x, unsigned int TotalWidth, unsigned int FractionWidth)
+{
+ typedef struct WriteReal__T2_a WriteReal__T2;
+
+ struct WriteReal__T2_a { char array[MaxLineLength+1]; };
+ WriteReal__T2 a;
+
+ FpuIO_RealToStr (x, TotalWidth, FractionWidth, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+
+/*
+ WriteReal - converts a REAL number, x, which has a, TotalWidth, and
+ FractionWidth into, string, a.
+*/
+
+extern "C" void FpuIO_StrToReal (const char *a_, unsigned int _a_high, double *x)
+{
+ long double lr;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ FpuIO_StrToLongReal ((const char *) a, _a_high, &lr); /* let StrToLongReal do the work and we convert the result back to REAL */
+ (*x) = (double ) (lr); /* let StrToLongReal do the work and we convert the result back to REAL */
+}
+
+
+/*
+ RealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_RealToStr (double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high)
+{
+ long double lr;
+
+ lr = (long double ) (x);
+ FpuIO_LongRealToStr (lr, TotalWidth, FractionWidth, (char *) a, _a_high);
+}
+
+extern "C" void FpuIO_ReadLongReal (long double *x)
+{
+ typedef struct ReadLongReal__T3_a ReadLongReal__T3;
+
+ struct ReadLongReal__T3_a { char array[MaxLineLength+1]; };
+ ReadLongReal__T3 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ FpuIO_StrToLongReal ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+
+/*
+ WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_WriteLongReal (long double x, unsigned int TotalWidth, unsigned int FractionWidth)
+{
+ typedef struct WriteLongReal__T4_a WriteLongReal__T4;
+
+ struct WriteLongReal__T4_a { char array[MaxLineLength+1]; };
+ WriteLongReal__T4 a;
+
+ FpuIO_LongRealToStr (x, TotalWidth, FractionWidth, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+
+/*
+ WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_StrToLongReal (const char *a_, unsigned int _a_high, long double *x)
+{
+ unsigned int found;
+ DynamicStrings_String s;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ s = DynamicStrings_InitString ((const char *) a, _a_high);
+ (*x) = StringConvert_StringToLongreal (s, &found);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_LongRealToStr (long double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high)
+{
+ DynamicStrings_String s;
+
+ s = StringConvert_LongrealToString (x, TotalWidth, FractionWidth);
+ DynamicStrings_CopyOut ((char *) a, _a_high, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_ReadLongInt (long int *x)
+{
+ typedef struct ReadLongInt__T5_a ReadLongInt__T5;
+
+ struct ReadLongInt__T5_a { char array[MaxLineLength+1]; };
+ ReadLongInt__T5 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ FpuIO_StrToLongInt ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_WriteLongInt (long int x, unsigned int n)
+{
+ typedef struct WriteLongInt__T6_a WriteLongInt__T6;
+
+ struct WriteLongInt__T6_a { char array[MaxLineLength+1]; };
+ WriteLongInt__T6 a;
+
+ FpuIO_LongIntToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_StrToLongInt (const char *a_, unsigned int _a_high, long int *x)
+{
+ DynamicStrings_String s;
+ unsigned int found;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ s = DynamicStrings_InitString ((const char *) a, _a_high);
+ (*x) = StringConvert_StringToLongInteger (s, 10, &found);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_LongIntToStr (long int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ DynamicStrings_String s;
+
+ s = StringConvert_LongIntegerToString (x, n, ' ', FALSE, 10, TRUE);
+ DynamicStrings_CopyOut ((char *) a, _a_high, s);
+ s = DynamicStrings_KillString (s);
+}
+
+extern "C" void _M2_FpuIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_FpuIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from IO. */
+/* IO.mod provides Read, Write, Errors procedures mapping onto 0, 1 and 2.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#define _IO_H
+#define _IO_C
+
+# include "GStrLib.h"
+# include "GSYSTEM.h"
+# include "Glibc.h"
+# include "GFIO.h"
+# include "Gerrno.h"
+# include "GASCII.h"
+# include "Gtermios.h"
+
+# define MaxDefaultFd 2
+typedef struct IO_BasicFds_r IO_BasicFds;
+
+typedef struct IO__T1_a IO__T1;
+
+struct IO_BasicFds_r {
+ unsigned int IsEof;
+ unsigned int IsRaw;
+ };
+
+struct IO__T1_a { IO_BasicFds array[MaxDefaultFd+1]; };
+static IO__T1 fdState;
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+extern "C" void IO_Read (char *ch);
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Write (char ch);
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Error (char ch);
+extern "C" void IO_UnBufferedMode (int fd, unsigned int input);
+extern "C" void IO_BufferedMode (int fd, unsigned int input);
+
+/*
+ EchoOn - turns on echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOn (int fd, unsigned int input);
+
+/*
+ EchoOff - turns off echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOff (int fd, unsigned int input);
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+static unsigned int IsDefaultFd (int fd);
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+static void doWrite (int fd, FIO_File f, char ch);
+
+/*
+ setFlag - sets or unsets the appropriate flag in, t.
+*/
+
+static void setFlag (termios_TERMIOS t, termios_Flag f, unsigned int b);
+
+/*
+ doraw - sets all the flags associated with making this
+ file descriptor into raw input/output.
+*/
+
+static void doraw (termios_TERMIOS term);
+
+/*
+ dononraw - sets all the flags associated with making this
+ file descriptor into non raw input/output.
+*/
+
+static void dononraw (termios_TERMIOS term);
+
+/*
+ Init -
+*/
+
+static void Init (void);
+
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+static unsigned int IsDefaultFd (int fd)
+{
+ return (fd <= MaxDefaultFd) && (fd >= 0);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+static void doWrite (int fd, FIO_File f, char ch)
+{
+ int r;
+
+ if (fdState.array[fd].IsRaw)
+ {
+ /* avoid dangling else. */
+ if (! fdState.array[fd].IsEof)
+ {
+ for (;;)
+ {
+ r = static_cast<int> (libc_write (FIO_GetUnixFileDescriptor (f), &ch, static_cast<size_t> (1)));
+ if (r == 1)
+ {
+ return ;
+ }
+ else if (r == -1)
+ {
+ /* avoid dangling else. */
+ r = errno_geterrno ();
+ if ((r != errno_EAGAIN) && (r != errno_EINTR))
+ {
+ fdState.array[fd].IsEof = TRUE;
+ return ;
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ FIO_WriteChar (f, ch);
+ }
+}
+
+
+/*
+ setFlag - sets or unsets the appropriate flag in, t.
+*/
+
+static void setFlag (termios_TERMIOS t, termios_Flag f, unsigned int b)
+{
+ if (termios_SetFlag (t, f, b))
+ {} /* empty. */
+}
+
+
+/*
+ doraw - sets all the flags associated with making this
+ file descriptor into raw input/output.
+*/
+
+static void doraw (termios_TERMIOS term)
+{
+ /*
+ * from man 3 termios
+ * termios_p->c_iflag &= ~(IGNBRK | BRKINT | PARMRK | ISTRIP
+ * | INLCR | IGNCR | ICRNL | IXON);
+ * termios_p->c_oflag &= ~OPOST;
+ * termios_p->c_lflag &= ~(ECHO | ECHONL | ICANON | ISIG | IEXTEN);
+ * termios_p->c_cflag &= ~(CSIZE | PARENB);
+ * termios_p->c_cflag |= CS8;
+ */
+ setFlag (term, termios_ignbrk, FALSE);
+ setFlag (term, termios_ibrkint, FALSE);
+ setFlag (term, termios_iparmrk, FALSE);
+ setFlag (term, termios_istrip, FALSE);
+ setFlag (term, termios_inlcr, FALSE);
+ setFlag (term, termios_igncr, FALSE);
+ setFlag (term, termios_icrnl, FALSE);
+ setFlag (term, termios_ixon, FALSE);
+ setFlag (term, termios_opost, FALSE);
+ setFlag (term, termios_lecho, FALSE);
+ setFlag (term, termios_lechonl, FALSE);
+ setFlag (term, termios_licanon, FALSE);
+ setFlag (term, termios_lisig, FALSE);
+ setFlag (term, termios_liexten, FALSE);
+ setFlag (term, termios_parenb, FALSE);
+ setFlag (term, termios_cs8, TRUE);
+}
+
+
+/*
+ dononraw - sets all the flags associated with making this
+ file descriptor into non raw input/output.
+*/
+
+static void dononraw (termios_TERMIOS term)
+{
+ /*
+ * we undo these settings, (although we leave the character size alone)
+ *
+ * from man 3 termios
+ * termios_p->c_iflag &= ~(IGNBRK | BRKINT | PARMRK | ISTRIP
+ * | INLCR | IGNCR | ICRNL | IXON);
+ * termios_p->c_oflag &= ~OPOST;
+ * termios_p->c_lflag &= ~(ECHO | ECHONL | ICANON | ISIG | IEXTEN);
+ * termios_p->c_cflag &= ~(CSIZE | PARENB);
+ * termios_p->c_cflag |= CS8;
+ */
+ setFlag (term, termios_ignbrk, TRUE);
+ setFlag (term, termios_ibrkint, TRUE);
+ setFlag (term, termios_iparmrk, TRUE);
+ setFlag (term, termios_istrip, TRUE);
+ setFlag (term, termios_inlcr, TRUE);
+ setFlag (term, termios_igncr, TRUE);
+ setFlag (term, termios_icrnl, TRUE);
+ setFlag (term, termios_ixon, TRUE);
+ setFlag (term, termios_opost, TRUE);
+ setFlag (term, termios_lecho, TRUE);
+ setFlag (term, termios_lechonl, TRUE);
+ setFlag (term, termios_licanon, TRUE);
+ setFlag (term, termios_lisig, TRUE);
+ setFlag (term, termios_liexten, TRUE);
+}
+
+
+/*
+ Init -
+*/
+
+static void Init (void)
+{
+ fdState.array[0].IsEof = FALSE;
+ fdState.array[0].IsRaw = FALSE;
+ fdState.array[1].IsEof = FALSE;
+ fdState.array[1].IsRaw = FALSE;
+ fdState.array[2].IsEof = FALSE;
+ fdState.array[2].IsRaw = FALSE;
+}
+
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+extern "C" void IO_Read (char *ch)
+{
+ int r;
+
+ FIO_FlushBuffer (FIO_StdOut);
+ FIO_FlushBuffer (FIO_StdErr);
+ if (fdState.array[0].IsRaw)
+ {
+ if (fdState.array[0].IsEof)
+ {
+ (*ch) = ASCII_eof;
+ }
+ else
+ {
+ for (;;)
+ {
+ r = static_cast<int> (libc_read (FIO_GetUnixFileDescriptor (FIO_StdIn), ch, static_cast<size_t> (1)));
+ if (r == 1)
+ {
+ return ;
+ }
+ else if (r == -1)
+ {
+ /* avoid dangling else. */
+ r = errno_geterrno ();
+ if (r != errno_EAGAIN)
+ {
+ fdState.array[0].IsEof = TRUE;
+ (*ch) = ASCII_eof;
+ return ;
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ (*ch) = FIO_ReadChar (FIO_StdIn);
+ }
+}
+
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Write (char ch)
+{
+ doWrite (1, FIO_StdOut, ch);
+}
+
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Error (char ch)
+{
+ doWrite (2, FIO_StdErr, ch);
+}
+
+extern "C" void IO_UnBufferedMode (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int result;
+
+ if (IsDefaultFd (fd))
+ {
+ fdState.array[fd].IsRaw = TRUE;
+ }
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ doraw (term);
+ if (input)
+ {
+ result = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ result = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+extern "C" void IO_BufferedMode (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int r;
+
+ if (IsDefaultFd (fd))
+ {
+ fdState.array[fd].IsRaw = FALSE;
+ }
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ dononraw (term);
+ if (input)
+ {
+ r = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ r = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+
+/*
+ EchoOn - turns on echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOn (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int result;
+
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ setFlag (term, termios_lecho, TRUE);
+ if (input)
+ {
+ result = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ result = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+
+/*
+ EchoOff - turns off echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOff (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int result;
+
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ setFlag (term, termios_lecho, FALSE);
+ if (input)
+ {
+ result = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ result = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+extern "C" void _M2_IO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_IO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Indexing. */
+/* Indexing provides a dynamic array of pointers.
+ Copyright (C) 2015-2023 Free Software Foundation, Inc.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _Indexing_H
+#define _Indexing_C
+
+# include "Glibc.h"
+# include "GStorage.h"
+# include "GSYSTEM.h"
+# include "GmcDebug.h"
+# include "GM2RTS.h"
+
+typedef struct Indexing_IndexProcedure_p Indexing_IndexProcedure;
+
+# define MinSize 128
+typedef struct Indexing__T2_r Indexing__T2;
+
+typedef void * *Indexing_PtrToAddress;
+
+typedef Indexing__T2 *Indexing_Index;
+
+typedef unsigned char *Indexing_PtrToByte;
+
+typedef void (*Indexing_IndexProcedure_t) (void *);
+struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; };
+
+struct Indexing__T2_r {
+ void *ArrayStart;
+ unsigned int ArraySize;
+ unsigned int Used;
+ unsigned int Low;
+ unsigned int High;
+ unsigned int Debug;
+ unsigned int Map;
+ };
+
+
+/*
+ InitIndex - creates and returns an Index.
+*/
+
+extern "C" Indexing_Index Indexing_InitIndex (unsigned int low);
+
+/*
+ KillIndex - returns Index to free storage.
+*/
+
+extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i);
+
+/*
+ DebugIndex - turns on debugging within an index.
+*/
+
+extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i);
+
+/*
+ InBounds - returns TRUE if indice, n, is within the bounds
+ of the dynamic array.
+*/
+
+extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n);
+
+/*
+ HighIndice - returns the last legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_HighIndice (Indexing_Index i);
+
+/*
+ LowIndice - returns the first legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_LowIndice (Indexing_Index i);
+
+/*
+ PutIndice - places, a, into the dynamic array at position i[n]
+*/
+
+extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a);
+
+/*
+ GetIndice - retrieves, element i[n] from the dynamic array.
+*/
+
+extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n);
+
+/*
+ IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*/
+
+extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a);
+
+/*
+ RemoveIndiceFromIndex - removes, a, from Index, i.
+*/
+
+extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a);
+
+/*
+ DeleteIndice - delete i[j] from the array.
+*/
+
+extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j);
+
+/*
+ IncludeIndiceIntoIndex - if the indice is not in the index, then
+ add it at the end.
+*/
+
+extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a);
+
+/*
+ ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*/
+
+extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p);
+
+
+/*
+ InitIndex - creates and returns an Index.
+*/
+
+extern "C" Indexing_Index Indexing_InitIndex (unsigned int low)
+{
+ Indexing_Index i;
+
+ Storage_ALLOCATE ((void **) &i, sizeof (Indexing__T2));
+ i->Low = low;
+ i->High = 0;
+ i->ArraySize = MinSize;
+ Storage_ALLOCATE (&i->ArrayStart, MinSize);
+ i->ArrayStart = libc_memset (i->ArrayStart, 0, static_cast<size_t> (i->ArraySize));
+ i->Debug = FALSE;
+ i->Used = 0;
+ i->Map = (unsigned int) 0;
+ return i;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillIndex - returns Index to free storage.
+*/
+
+extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i)
+{
+ Storage_DEALLOCATE (&i->ArrayStart, i->ArraySize);
+ Storage_DEALLOCATE ((void **) &i, sizeof (Indexing__T2));
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DebugIndex - turns on debugging within an index.
+*/
+
+extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i)
+{
+ i->Debug = TRUE;
+ return i;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InBounds - returns TRUE if indice, n, is within the bounds
+ of the dynamic array.
+*/
+
+extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n)
+{
+ if (i == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return (n >= i->Low) && (n <= i->High);
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ HighIndice - returns the last legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_HighIndice (Indexing_Index i)
+{
+ if (i == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return i->High;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ LowIndice - returns the first legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_LowIndice (Indexing_Index i)
+{
+ if (i == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return i->Low;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutIndice - places, a, into the dynamic array at position i[n]
+*/
+
+extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a)
+{
+ typedef unsigned int * *PutIndice__T1;
+
+ unsigned int oldSize;
+ void * b;
+ PutIndice__T1 p;
+
+ if (! (Indexing_InBounds (i, n)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (n < i->Low)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ oldSize = i->ArraySize;
+ while (((n-i->Low)*sizeof (void *)) >= i->ArraySize)
+ {
+ i->ArraySize = i->ArraySize*2;
+ }
+ if (oldSize != i->ArraySize)
+ {
+ /*
+ IF Debug
+ THEN
+ printf2('increasing memory hunk from %d to %d
+ ',
+ oldSize, ArraySize)
+ END ;
+ */
+ Storage_REALLOCATE (&i->ArrayStart, i->ArraySize);
+ /* and initialize the remainder of the array to NIL */
+ b = i->ArrayStart;
+ b = reinterpret_cast<void *> (reinterpret_cast<char *> (b)+oldSize);
+ b = libc_memset (b, 0, static_cast<size_t> (i->ArraySize-oldSize));
+ }
+ i->High = n;
+ }
+ }
+ b = i->ArrayStart;
+ b = reinterpret_cast<void *> (reinterpret_cast<char *> (b)+(n-i->Low)*sizeof (void *));
+ p = static_cast<PutIndice__T1> (b);
+ (*p) = reinterpret_cast<unsigned int *> (a);
+ i->Used += 1;
+ if (i->Debug)
+ {
+ if (n < 32)
+ {
+ i->Map |= (1 << (n ));
+ }
+ }
+}
+
+
+/*
+ GetIndice - retrieves, element i[n] from the dynamic array.
+*/
+
+extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n)
+{
+ Indexing_PtrToByte b;
+ Indexing_PtrToAddress p;
+
+ if (! (Indexing_InBounds (i, n)))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ b += (n-i->Low)*sizeof (void *);
+ p = (Indexing_PtrToAddress) (b);
+ if (i->Debug)
+ {
+ if (((n < 32) && (! ((((1 << (n)) & (i->Map)) != 0)))) && ((*p) != NULL))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ }
+ return (*p);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*/
+
+extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a)
+{
+ unsigned int j;
+ Indexing_PtrToByte b;
+ Indexing_PtrToAddress p;
+
+ j = i->Low;
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ while (j <= i->High)
+ {
+ p = (Indexing_PtrToAddress) (b);
+ if ((*p) == a)
+ {
+ return TRUE;
+ }
+ /* we must not INC(p, ..) as p2c gets confused */
+ b += sizeof (void *);
+ j += 1;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveIndiceFromIndex - removes, a, from Index, i.
+*/
+
+extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a)
+{
+ unsigned int j;
+ unsigned int k;
+ Indexing_PtrToAddress p;
+ Indexing_PtrToByte b;
+
+ j = i->Low;
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ while (j <= i->High)
+ {
+ p = (Indexing_PtrToAddress) (b);
+ b += sizeof (void *);
+ if ((*p) == a)
+ {
+ Indexing_DeleteIndice (i, j);
+ }
+ j += 1;
+ }
+}
+
+
+/*
+ DeleteIndice - delete i[j] from the array.
+*/
+
+extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j)
+{
+ Indexing_PtrToAddress p;
+ Indexing_PtrToByte b;
+
+ if (Indexing_InBounds (i, j))
+ {
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ b += sizeof (void *)*(j-i->Low);
+ p = (Indexing_PtrToAddress) (b);
+ b += sizeof (void *);
+ p = static_cast<Indexing_PtrToAddress> (libc_memmove (reinterpret_cast<void *> (p), reinterpret_cast<void *> (b), static_cast<size_t> ((i->High-j)*sizeof (void *))));
+ i->High -= 1;
+ i->Used -= 1;
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ IncludeIndiceIntoIndex - if the indice is not in the index, then
+ add it at the end.
+*/
+
+extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a)
+{
+ if (! (Indexing_IsIndiceInIndex (i, a)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (i->Used == 0)
+ {
+ Indexing_PutIndice (i, Indexing_LowIndice (i), a);
+ }
+ else
+ {
+ Indexing_PutIndice (i, (Indexing_HighIndice (i))+1, a);
+ }
+ }
+}
+
+
+/*
+ ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*/
+
+extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p)
+{
+ unsigned int j;
+ Indexing_IndexProcedure q;
+
+ j = Indexing_LowIndice (i);
+ q = p;
+ while (j <= (Indexing_HighIndice (i)))
+ {
+ mcDebug_assert (q.proc == p.proc);
+ (*p.proc) (Indexing_GetIndice (i, j));
+ j += 1;
+ }
+}
+
+extern "C" void _M2_Indexing_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Indexing_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from M2Dependent. */
+/* M2Dependent.mod implements the run time module dependencies.
+
+Copyright (C) 2022-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _M2Dependent_H
+#define _M2Dependent_C
+
+# include "Glibc.h"
+# include "GM2LINK.h"
+# include "GASCII.h"
+# include "GSYSTEM.h"
+# include "GStorage.h"
+# include "GStrLib.h"
+# include "GM2RTS.h"
+
+typedef struct M2Dependent_ArgCVEnvP_p M2Dependent_ArgCVEnvP;
+
+typedef struct M2Dependent_DependencyList_r M2Dependent_DependencyList;
+
+typedef struct M2Dependent__T2_r M2Dependent__T2;
+
+typedef M2Dependent__T2 *M2Dependent_ModuleChain;
+
+typedef struct M2Dependent__T3_a M2Dependent__T3;
+
+typedef enum {M2Dependent_unregistered, M2Dependent_unordered, M2Dependent_started, M2Dependent_ordered, M2Dependent_user} M2Dependent_DependencyState;
+
+typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *);
+struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; };
+
+struct M2Dependent_DependencyList_r {
+ PROC proc;
+ unsigned int forced;
+ unsigned int forc;
+ unsigned int appl;
+ M2Dependent_DependencyState state;
+ };
+
+struct M2Dependent__T3_a { M2Dependent_ModuleChain array[M2Dependent_user-M2Dependent_unregistered+1]; };
+struct M2Dependent__T2_r {
+ void *name;
+ void *libname;
+ M2Dependent_ArgCVEnvP init;
+ M2Dependent_ArgCVEnvP fini;
+ M2Dependent_DependencyList dependency;
+ M2Dependent_ModuleChain prev;
+ M2Dependent_ModuleChain next;
+ };
+
+static M2Dependent__T3 Modules;
+static unsigned int Initialized;
+static unsigned int WarningTrace;
+static unsigned int ModuleTrace;
+static unsigned int HexTrace;
+static unsigned int DependencyTrace;
+static unsigned int PreTrace;
+static unsigned int PostTrace;
+static unsigned int ForceTrace;
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
+
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ AppendModule - append chain to end of the list.
+*/
+
+static void AppendModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain);
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain);
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr);
+
+/*
+ max -
+*/
+
+static unsigned int max (unsigned int a, unsigned int b);
+
+/*
+ min -
+*/
+
+static unsigned int min (unsigned int a, unsigned int b);
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen);
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname);
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high);
+
+/*
+ strcmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b);
+
+/*
+ strncmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n);
+
+/*
+ strlen - returns the length of string.
+*/
+
+static int strlen_ (M2LINK_PtrToChar string);
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high);
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg);
+
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2);
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChain mptr);
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname);
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
+
+/*
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
+*/
+
+static void ResolveDependencies (void * currentmodule, void * libname);
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high);
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag);
+
+/*
+ combine - dest := src + dest. Places src at the front of list dest.
+ Pre condition: src, dest are lists.
+ Post condition : dest := src + dest
+ src := NIL.
+*/
+
+static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest);
+
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
+/*
+ ForceDependencies - if the user has specified a forced order then we override
+ the dynamic ordering with the preference.
+*/
+
+static void ForceDependencies (void);
+
+/*
+ CheckApplication - check to see that the application is the last entry in the list.
+ This might happen if the application only imports FOR C modules.
+*/
+
+static void CheckApplication (void);
+
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2);
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high);
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,hex,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ hex dump the modules ctor functions address in hex.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved dynamically.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void);
+
+/*
+ Init - initialize the debug flags and set all lists to NIL.
+*/
+
+static void Init (void);
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void);
+
+
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+ M2Dependent_ModuleChain mptr;
+ void * p0;
+ void * p1;
+
+ Storage_ALLOCATE ((void **) &mptr, sizeof (M2Dependent__T2));
+ mptr->name = name;
+ mptr->libname = libname;
+ mptr->init = init;
+ mptr->fini = fini;
+ mptr->dependency.proc = dependencies;
+ mptr->dependency.state = M2Dependent_unregistered;
+ mptr->prev = NULL;
+ mptr->next = NULL;
+ if (HexTrace)
+ {
+ libc_printf ((const char *) " (init: %p fini: %p", 22, init, fini);
+ libc_printf ((const char *) " dep: %p)", 10, dependencies);
+ }
+ return mptr;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AppendModule - append chain to end of the list.
+*/
+
+static void AppendModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain)
+{
+ if ((*head) == NULL)
+ {
+ (*head) = chain;
+ chain->prev = chain;
+ chain->next = chain;
+ }
+ else
+ {
+ chain->next = (*head); /* Add Item to the end of list. */
+ chain->prev = (*head)->prev; /* Add Item to the end of list. */
+ (*head)->prev->next = chain;
+ (*head)->prev = chain;
+ }
+}
+
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain)
+{
+ if ((chain->next == (*head)) && (chain == (*head)))
+ {
+ (*head) = NULL;
+ }
+ else
+ {
+ if ((*head) == chain)
+ {
+ (*head) = (*head)->next;
+ }
+ chain->prev->next = chain->next;
+ chain->next->prev = chain->prev;
+ }
+}
+
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr)
+{
+ M2Dependent_ModuleChain ptr;
+
+ if (Modules.array[state-M2Dependent_unregistered] != NULL)
+ {
+ ptr = Modules.array[state-M2Dependent_unregistered];
+ do {
+ if (ptr == mptr)
+ {
+ return TRUE;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-M2Dependent_unregistered]));
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ max -
+*/
+
+static unsigned int max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ min -
+*/
+
+static unsigned int min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen)
+{
+ M2Dependent_ModuleChain ptr;
+
+ if (Modules.array[state-M2Dependent_unregistered] != NULL)
+ {
+ ptr = Modules.array[state-M2Dependent_unregistered];
+ do {
+ if (((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), max (namelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->name)))))) == 0) && ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname), reinterpret_cast<M2LINK_PtrToChar> (libname), max (libnamelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname)))))) == 0))
+ {
+ return ptr;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-M2Dependent_unregistered]));
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname)
+{
+ return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))), libname, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (libname))));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high)
+{
+ unsigned int high;
+ unsigned int i;
+ unsigned int j;
+
+ i = 0;
+ high = _str_high;
+ while (i < high)
+ {
+ if ((i < high) && (str[i] == '\\'))
+ {
+ if (str[i+1] == 'n')
+ {
+ str[i] = ASCII_nl;
+ j = i+1;
+ while (j < high)
+ {
+ str[j] = str[j+1];
+ j += 1;
+ }
+ }
+ }
+ i += 1;
+ }
+}
+
+
+/*
+ strcmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b)
+{
+ if ((a != NULL) && (b != NULL))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a == b)
+ {
+ return 0;
+ }
+ else
+ {
+ while ((*a) == (*b))
+ {
+ if ((*a) == ASCII_nul)
+ {
+ return 0;
+ }
+ a += 1;
+ b += 1;
+ }
+ }
+ }
+ return 1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ strncmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n)
+{
+ if (n == 0)
+ {
+ return 0;
+ }
+ else if ((a != NULL) && (b != NULL))
+ {
+ /* avoid dangling else. */
+ if (a == b)
+ {
+ return 0;
+ }
+ else
+ {
+ while (((*a) == (*b)) && (n > 0))
+ {
+ if (((*a) == ASCII_nul) || (n == 1))
+ {
+ return 0;
+ }
+ a += 1;
+ b += 1;
+ n -= 1;
+ }
+ }
+ }
+ return 1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ strlen - returns the length of string.
+*/
+
+static int strlen_ (M2LINK_PtrToChar string)
+{
+ int count;
+
+ if (string == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ count = 0;
+ while ((*string) != ASCII_nul)
+ {
+ string += 1;
+ count += 1;
+ }
+ return count;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ libc_printf ((const char *) str, _str_high);
+ }
+}
+
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg)
+{
+ char ch;
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ if (arg == NULL)
+ {
+ ch = (char) 0;
+ arg = &ch;
+ }
+ libc_printf ((const char *) str, _str_high, arg);
+ }
+}
+
+
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2)
+{
+ char ch;
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ if (arg1 == NULL)
+ {
+ ch = (char) 0;
+ arg1 = &ch;
+ }
+ if (arg2 == NULL)
+ {
+ ch = (char) 0;
+ arg2 = &ch;
+ }
+ libc_printf ((const char *) str, _str_high, arg1, arg2);
+ }
+}
+
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChain mptr)
+{
+ if (onChain (mptr->dependency.state, mptr))
+ {
+ RemoveModule (&Modules.array[mptr->dependency.state-M2Dependent_unregistered], mptr);
+ }
+ mptr->dependency.state = newstate;
+ AppendModule (&Modules.array[mptr->dependency.state-M2Dependent_unregistered], mptr);
+}
+
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname)
+{
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not been registered via a global constructor\\n", 68, currentmodule, libname);
+ }
+ else
+ {
+ if (onChain (M2Dependent_started, mptr))
+ {
+ traceprintf (DependencyTrace, (const char *) " processing...\\n", 18);
+ }
+ else
+ {
+ moveTo (M2Dependent_started, mptr);
+ traceprintf3 (DependencyTrace, (const char *) " starting: %s [%s]\\n", 22, currentmodule, libname);
+ (*mptr->dependency.proc.proc) (); /* Invoke and process the dependency graph. */
+ traceprintf3 (DependencyTrace, (const char *) " finished: %s [%s]\\n", 22, currentmodule, libname); /* Invoke and process the dependency graph. */
+ moveTo (M2Dependent_ordered, mptr);
+ }
+ }
+}
+
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
+ if (dependantmodule == NULL)
+ {
+ /* avoid dangling else. */
+ traceprintf (DependencyTrace, (const char *) " has finished its import graph\\n", 32);
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
+ if (mptr != NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is now ordered\\n", 33, modulename, libname);
+ moveTo (M2Dependent_ordered, mptr);
+ }
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " imports from %s [%s]\\n", 23, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_ordered, dependantmodule, dependantlibname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not ordered\\n", 33, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_unordered, dependantmodule, dependantlibname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not unordered\\n", 35, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_started, dependantmodule, dependantlibname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not started\\n", 34, dependantmodule, dependantlibname);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] attempting to import from", 42, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " %s [%s] which has not registered itself via a constructor\\n", 60, dependantmodule, dependantlibname);
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has registered itself and has started\\n", 56, dependantmodule, dependantlibname);
+ }
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] resolving\\n", 28, dependantmodule, dependantlibname);
+ ResolveDependant (mptr, dependantmodule, dependantlibname);
+ }
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " dependant %s [%s] is ordered\\n", 31, dependantmodule, dependantlibname);
+ }
+ }
+}
+
+
+/*
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
+*/
+
+static void ResolveDependencies (void * currentmodule, void * libname)
+{
+ M2Dependent_ModuleChain mptr;
+
+ mptr = LookupModule (M2Dependent_unordered, currentmodule, libname);
+ while (mptr != NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s [%s]\\n", 53, currentmodule, libname);
+ ResolveDependant (mptr, currentmodule, libname);
+ mptr = Modules.array[M2Dependent_unordered-M2Dependent_unregistered];
+ }
+}
+
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high)
+{
+ M2Dependent_ModuleChain mptr;
+ unsigned int count;
+ char desc[_desc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (desc, desc_, _desc_high+1);
+
+ if (Modules.array[state-M2Dependent_unregistered] != NULL)
+ {
+ libc_printf ((const char *) "%s modules\\n", 12, &desc);
+ mptr = Modules.array[state-M2Dependent_unregistered];
+ count = 0;
+ do {
+ if (mptr->name == NULL)
+ {
+ libc_printf ((const char *) " %d %s []", 11, count, mptr->name);
+ }
+ else
+ {
+ libc_printf ((const char *) " %d %s [%s]", 13, count, mptr->name, mptr->libname);
+ }
+ count += 1;
+ if (mptr->dependency.appl)
+ {
+ libc_printf ((const char *) " application", 12);
+ }
+ if (mptr->dependency.forc)
+ {
+ libc_printf ((const char *) " for C", 6);
+ }
+ if (mptr->dependency.forced)
+ {
+ libc_printf ((const char *) " forced ordering", 16);
+ }
+ libc_printf ((const char *) "\\n", 2);
+ mptr = mptr->next;
+ } while (! (mptr == Modules.array[state-M2Dependent_unregistered]));
+ }
+}
+
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag)
+{
+ M2Dependent_ModuleChain mptr;
+
+ if (flag)
+ {
+ DisplayModuleInfo (M2Dependent_unregistered, (const char *) "unregistered", 12);
+ DisplayModuleInfo (M2Dependent_unordered, (const char *) "unordered", 9);
+ DisplayModuleInfo (M2Dependent_started, (const char *) "started", 7);
+ DisplayModuleInfo (M2Dependent_ordered, (const char *) "ordered", 7);
+ }
+}
+
+
+/*
+ combine - dest := src + dest. Places src at the front of list dest.
+ Pre condition: src, dest are lists.
+ Post condition : dest := src + dest
+ src := NIL.
+*/
+
+static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest)
+{
+ M2Dependent_ModuleChain last;
+
+ while (Modules.array[src-M2Dependent_unregistered] != NULL)
+ {
+ last = Modules.array[src-M2Dependent_unregistered]->prev;
+ moveTo (M2Dependent_ordered, last);
+ Modules.array[dest-M2Dependent_unregistered] = last; /* New item is at the head. */
+ }
+}
+
+
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ typedef struct tracemodule__T4_a tracemodule__T4;
+
+ struct tracemodule__T4_a { char array[100+1]; };
+ tracemodule__T4 buffer;
+ unsigned int len;
+
+ if (flag)
+ {
+ len = min (modlen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, modname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) "%s ", 3, &buffer);
+ len = min (liblen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, libname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) " [%s]", 5, &buffer);
+ }
+}
+
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf (ForceTrace, (const char *) "forcing module: ", 16);
+ tracemodule (ForceTrace, modname, modlen, libname, liblen);
+ traceprintf (ForceTrace, (const char *) "\\n", 2);
+ mptr = LookupModuleN (M2Dependent_ordered, modname, modlen, libname, liblen);
+ if (mptr != NULL)
+ {
+ mptr->dependency.forced = TRUE;
+ moveTo (M2Dependent_user, mptr);
+ }
+}
+
+
+/*
+ ForceDependencies - if the user has specified a forced order then we override
+ the dynamic ordering with the preference.
+*/
+
+static void ForceDependencies (void)
+{
+ unsigned int len;
+ unsigned int modlen;
+ unsigned int liblen;
+ M2LINK_PtrToChar modname;
+ M2LINK_PtrToChar libname;
+ M2LINK_PtrToChar pc;
+ M2LINK_PtrToChar start;
+
+ if (M2LINK_ForcedModuleInitOrder != NULL)
+ {
+ traceprintf2 (ForceTrace, (const char *) "user forcing order: %s\\n", 24, reinterpret_cast<void *> (M2LINK_ForcedModuleInitOrder));
+ pc = M2LINK_ForcedModuleInitOrder;
+ start = pc;
+ len = 0;
+ modname = NULL;
+ modlen = 0;
+ libname = NULL;
+ liblen = 0;
+ while ((*pc) != ASCII_nul)
+ {
+ switch ((*pc))
+ {
+ case ':':
+ libname = start;
+ liblen = len;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+ case ',':
+ modname = start;
+ modlen = len;
+ ForceModule (reinterpret_cast<void *> (modname), modlen, reinterpret_cast<void *> (libname), liblen);
+ libname = NULL;
+ liblen = 0;
+ modlen = 0;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+
+ default:
+ pc += 1;
+ len += 1;
+ break;
+ }
+ }
+ if (start != pc)
+ {
+ ForceModule (reinterpret_cast<void *> (start), len, reinterpret_cast<void *> (libname), liblen);
+ }
+ combine (M2Dependent_user, M2Dependent_ordered);
+ }
+}
+
+
+/*
+ CheckApplication - check to see that the application is the last entry in the list.
+ This might happen if the application only imports FOR C modules.
+*/
+
+static void CheckApplication (void)
+{
+ M2Dependent_ModuleChain mptr;
+ M2Dependent_ModuleChain appl;
+
+ mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered];
+ if (mptr != NULL)
+ {
+ appl = NULL;
+ do {
+ if (mptr->dependency.appl)
+ {
+ appl = mptr;
+ }
+ else
+ {
+ mptr = mptr->next;
+ }
+ } while (! ((appl != NULL) || (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered])));
+ if (appl != NULL)
+ {
+ RemoveModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
+ AppendModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
+ }
+ }
+}
+
+
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2)
+{
+ typedef struct warning3__T5_a warning3__T5;
+
+ struct warning3__T5_a { char array[4096+1]; };
+ warning3__T5 buffer;
+ int len;
+ char format[_format_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (format, format_, _format_high+1);
+
+ if (WarningTrace)
+ {
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) "warning: ", 9);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) format, _format_high, arg1, arg2);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ }
+}
+
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ return (strncmp (reinterpret_cast<M2LINK_PtrToChar> (cstr), reinterpret_cast<M2LINK_PtrToChar> (&str), StrLib_StrLen ((const char *) str, _str_high))) == 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,hex,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ hex dump the modules ctor functions address in hex.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved dynamically.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void)
+{
+ typedef char *SetupDebugFlags__T1;
+
+ SetupDebugFlags__T1 pc;
+
+ ModuleTrace = FALSE;
+ DependencyTrace = FALSE;
+ PostTrace = FALSE;
+ PreTrace = FALSE;
+ ForceTrace = FALSE;
+ HexTrace = FALSE;
+ WarningTrace = FALSE;
+ pc = static_cast<SetupDebugFlags__T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
+ while ((pc != NULL) && ((*pc) != ASCII_nul))
+ {
+ if (equal (reinterpret_cast<void *> (pc), (const char *) "all", 3))
+ {
+ ModuleTrace = TRUE;
+ DependencyTrace = TRUE;
+ PreTrace = TRUE;
+ PostTrace = TRUE;
+ ForceTrace = TRUE;
+ HexTrace = TRUE;
+ WarningTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "module", 6))
+ {
+ /* avoid dangling else. */
+ ModuleTrace = TRUE;
+ pc += 6;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "warning", 7))
+ {
+ /* avoid dangling else. */
+ WarningTrace = TRUE;
+ pc += 7;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "hex", 3))
+ {
+ /* avoid dangling else. */
+ HexTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
+ {
+ /* avoid dangling else. */
+ DependencyTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "pre", 3))
+ {
+ /* avoid dangling else. */
+ PreTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "post", 4))
+ {
+ /* avoid dangling else. */
+ PostTrace = TRUE;
+ pc += 4;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "force", 5))
+ {
+ /* avoid dangling else. */
+ ForceTrace = TRUE;
+ pc += 5;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ pc += 1;
+ }
+ }
+}
+
+
+/*
+ Init - initialize the debug flags and set all lists to NIL.
+*/
+
+static void Init (void)
+{
+ M2Dependent_DependencyState state;
+
+ SetupDebugFlags ();
+ for (state=M2Dependent_unregistered; state<=M2Dependent_user; state= static_cast<M2Dependent_DependencyState>(static_cast<int>(state+1)))
+ {
+ Modules.array[state-M2Dependent_unregistered] = NULL;
+ }
+}
+
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void)
+{
+ if (! Initialized)
+ {
+ Initialized = TRUE;
+ Init ();
+ }
+}
+
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_ModuleChain mptr;
+ M2Dependent_ArgCVEnvP nulp;
+
+ CheckInitialized ();
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, applicationmodule, libname);
+ mptr = LookupModule (M2Dependent_unordered, applicationmodule, libname);
+ if (mptr != NULL)
+ {
+ mptr->dependency.appl = TRUE;
+ }
+ traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26);
+ DumpModuleData (PreTrace);
+ ResolveDependencies (applicationmodule, libname);
+ traceprintf (PreTrace, (const char *) "Post resolving dependents\\n", 27);
+ DumpModuleData (PostTrace);
+ ForceDependencies ();
+ traceprintf (ForceTrace, (const char *) "After user forcing ordering\\n", 29);
+ DumpModuleData (ForceTrace);
+ CheckApplication ();
+ traceprintf (ForceTrace, (const char *) "After runtime forces application to the end\\n", 45);
+ DumpModuleData (ForceTrace);
+ if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
+ {
+ traceprintf3 (ModuleTrace, (const char *) " module: %s [%s] has not registered itself using a global constructor\\n", 72, applicationmodule, libname);
+ traceprintf2 (ModuleTrace, (const char *) " hint try compile and linking using: gm2 %s.mod\\n", 50, applicationmodule);
+ traceprintf2 (ModuleTrace, (const char *) " or try using: gm2 -fscaffold-static %s.mod\\n", 46, applicationmodule);
+ }
+ else
+ {
+ mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered];
+ do {
+ if (mptr->dependency.forc)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s] for C\\n", 36, mptr->name, mptr->libname);
+ }
+ else
+ {
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s]\\n", 30, mptr->name, mptr->libname);
+ }
+ if (mptr->dependency.appl)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, mptr->name, mptr->libname);
+ traceprintf (ModuleTrace, (const char *) " calling M2RTS_ExecuteInitialProcedures\\n", 42);
+ M2RTS_ExecuteInitialProcedures ();
+ traceprintf (ModuleTrace, (const char *) " calling application module\\n", 30);
+ }
+ (*mptr->init.proc) (argc, argv, envp);
+ mptr = mptr->next;
+ } while (! (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered]));
+ }
+}
+
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf3 (ModuleTrace, (const char *) "application module finishing: %s [%s]\\n", 39, applicationmodule, libname);
+ if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
+ {
+ traceprintf (ModuleTrace, (const char *) " no ordered modules found during finishing\\n", 45);
+ }
+ else
+ {
+ traceprintf (ModuleTrace, (const char *) "ExecuteTerminationProcedures\\n", 30);
+ M2RTS_ExecuteTerminationProcedures ();
+ traceprintf (ModuleTrace, (const char *) "terminating modules in sequence\\n", 33);
+ mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered]->prev;
+ do {
+ if (mptr->dependency.forc)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s] for C\\n", 34, mptr->name, mptr->libname);
+ }
+ else
+ {
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s]\\n", 28, mptr->name, mptr->libname);
+ }
+ (*mptr->fini.proc) (argc, argv, envp);
+ mptr = mptr->prev;
+ } while (! (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered]->prev));
+ }
+}
+
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+ M2Dependent_ModuleChain mptr;
+
+ CheckInitialized ();
+ if (! M2LINK_StaticInitialization)
+ {
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "module: %s [%s] registering", 27, modulename, libname);
+ moveTo (M2Dependent_unordered, CreateModule (modulename, libname, init, fini, dependencies));
+ traceprintf (ModuleTrace, (const char *) "\\n", 2);
+ }
+ else
+ {
+ warning3 ((const char *) "module: %s [%s] (ignoring duplicate registration)\\n", 51, modulename, libname);
+ }
+ }
+}
+
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
+{
+ CheckInitialized ();
+ if (! M2LINK_StaticInitialization)
+ {
+ PerformRequestDependant (modulename, libname, dependantmodule, dependantlibname);
+ }
+}
+
+extern "C" void _M2_M2Dependent_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ CheckInitialized ();
+}
+
+extern "C" void _M2_M2Dependent_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from M2EXCEPTION. */
+/* M2EXCEPTION.mod implement M2Exception and IsM2Exception.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# include "Gmcrts.h"
+#define _M2EXCEPTION_H
+#define _M2EXCEPTION_C
+
+# include "GSYSTEM.h"
+# include "GRTExceptions.h"
+
+typedef enum {M2EXCEPTION_indexException, M2EXCEPTION_rangeException, M2EXCEPTION_caseSelectException, M2EXCEPTION_invalidLocation, M2EXCEPTION_functionException, M2EXCEPTION_wholeValueException, M2EXCEPTION_wholeDivException, M2EXCEPTION_realValueException, M2EXCEPTION_realDivException, M2EXCEPTION_complexValueException, M2EXCEPTION_complexDivException, M2EXCEPTION_protException, M2EXCEPTION_sysException, M2EXCEPTION_coException, M2EXCEPTION_exException} M2EXCEPTION_M2Exceptions;
+
+extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void);
+extern "C" unsigned int M2EXCEPTION_IsM2Exception (void);
+
+extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void)
+{
+ RTExceptions_EHBlock e;
+ unsigned int n;
+
+ /* If the program or coroutine is in the exception state then return the enumeration
+ value representing the exception cause. If it is not in the exception state then
+ raises and exception (exException). */
+ e = RTExceptions_GetExceptionBlock ();
+ n = RTExceptions_GetNumber (e);
+ if (n == (UINT_MAX))
+ {
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*> (reinterpret_cast<const void*>("M2Exception")), const_cast<void*> (reinterpret_cast<const void*>("current coroutine is not in the exceptional execution state")));
+ }
+ else
+ {
+ return (M2EXCEPTION_M2Exceptions) (n);
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int M2EXCEPTION_IsM2Exception (void)
+{
+ RTExceptions_EHBlock e;
+
+ /* Returns TRUE if the program or coroutine is in the exception state.
+ Returns FALSE if the program or coroutine is not in the exception state. */
+ e = RTExceptions_GetExceptionBlock ();
+ return (RTExceptions_GetNumber (e)) != (UINT_MAX);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_M2EXCEPTION_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ RTExceptions_SetExceptionBlock (RTExceptions_InitExceptionBlock ());
+}
+
+extern "C" void _M2_M2EXCEPTION_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from M2RTS. */
+/* M2RTS.mod Implements the run time system facilities of Modula-2.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _M2RTS_H
+#define _M2RTS_C
+
+# include "Glibc.h"
+# include "GNumberIO.h"
+# include "GStrLib.h"
+# include "GSYSTEM.h"
+# include "GASCII.h"
+# include "GStorage.h"
+# include "GRTExceptions.h"
+# include "GM2EXCEPTION.h"
+# include "GM2Dependent.h"
+
+typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
+
+# define stderrFd 2
+typedef struct M2RTS_ProcedureList_r M2RTS_ProcedureList;
+
+typedef char *M2RTS_PtrToChar;
+
+typedef struct M2RTS__T1_r M2RTS__T1;
+
+typedef M2RTS__T1 *M2RTS_ProcedureChain;
+
+typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
+struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
+
+struct M2RTS_ProcedureList_r {
+ M2RTS_ProcedureChain head;
+ M2RTS_ProcedureChain tail;
+ };
+
+struct M2RTS__T1_r {
+ PROC p;
+ M2RTS_ProcedureChain prev;
+ M2RTS_ProcedureChain next;
+ };
+
+static M2RTS_ProcedureList InitialProc;
+static M2RTS_ProcedureList TerminateProc;
+static int ExitValue;
+static unsigned int isHalting;
+static unsigned int CallExit;
+static unsigned int Initialized;
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*/
+
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
+
+/*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*/
+
+extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p);
+
+/*
+ ExecuteInitialProcedures - executes the initial procedures installed by
+ InstallInitialProcedure.
+*/
+
+extern "C" void M2RTS_ExecuteInitialProcedures (void);
+
+/*
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
+*/
+
+extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p);
+
+/*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*/
+
+extern "C" void M2RTS_ExecuteTerminationProcedures (void);
+
+/*
+ Terminate - provides compatibility for pim. It calls exit with
+ the exitcode provided in a prior call to ExitOnHalt
+ (or zero if ExitOnHalt was never called). It does
+ not call ExecuteTerminationProcedures.
+*/
+
+extern "C" void M2RTS_Terminate (void) __attribute__ ((noreturn));
+
+/*
+ HALT - terminate the current program. The procedure
+ ExecuteTerminationProcedures
+ is called before the program is stopped. The parameter
+ exitcode is optional. If the parameter is not supplied
+ HALT will call libc 'abort', otherwise it will exit with
+ the code supplied. Supplying a parameter to HALT has the
+ same effect as calling ExitOnHalt with the same code and
+ then calling HALT with no parameter.
+*/
+
+extern "C" void M2RTS_HALT (int exitcode) __attribute__ ((noreturn));
+
+/*
+ Halt - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn));
+
+/*
+ HaltC - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) __attribute__ ((noreturn));
+
+/*
+ ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*/
+
+extern "C" void M2RTS_ExitOnHalt (int e);
+
+/*
+ ErrorMessage - emits an error message to stderr and then calls exit (1).
+*/
+
+extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high) __attribute__ ((noreturn));
+
+/*
+ Length - returns the length of a string, a. This is called whenever
+ the user calls LENGTH and the parameter cannot be calculated
+ at compile time.
+*/
+
+extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high);
+extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+
+/*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*/
+
+static void ExecuteReverse (M2RTS_ProcedureChain procptr);
+
+/*
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
+*/
+
+static unsigned int AppendProc (M2RTS_ProcedureList *proclist, PROC proc);
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high);
+
+/*
+ ErrorStringC - writes a string to stderr.
+*/
+
+static void ErrorStringC (void * str);
+
+/*
+ ErrorMessageC - emits an error message to stderr and then calls exit (1).
+*/
+
+static void ErrorMessageC (void * message, void * filename, unsigned int line, void * function) __attribute__ ((noreturn));
+
+/*
+ InitProcList - initialize the head and tail pointers to NIL.
+*/
+
+static void InitProcList (M2RTS_ProcedureList *p);
+
+/*
+ Init - initialize the initial, terminate procedure lists and booleans.
+*/
+
+static void Init (void);
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void);
+
+
+/*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*/
+
+static void ExecuteReverse (M2RTS_ProcedureChain procptr)
+{
+ while (procptr != NULL)
+ {
+ (*procptr->p.proc) (); /* Invoke the procedure. */
+ procptr = procptr->prev; /* Invoke the procedure. */
+ }
+}
+
+
+/*
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
+*/
+
+static unsigned int AppendProc (M2RTS_ProcedureList *proclist, PROC proc)
+{
+ M2RTS_ProcedureChain pdes;
+
+ Storage_ALLOCATE ((void **) &pdes, sizeof (M2RTS__T1));
+ pdes->p = proc;
+ pdes->prev = (*proclist).tail;
+ pdes->next = NULL;
+ if ((*proclist).head == NULL)
+ {
+ (*proclist).head = pdes;
+ }
+ (*proclist).tail = pdes;
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high)
+{
+ int n;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ n = static_cast<int> (libc_write (stderrFd, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
+}
+
+
+/*
+ ErrorStringC - writes a string to stderr.
+*/
+
+static void ErrorStringC (void * str)
+{
+ int len;
+
+ len = static_cast<int> (libc_write (stderrFd, str, libc_strlen (str)));
+}
+
+
+/*
+ ErrorMessageC - emits an error message to stderr and then calls exit (1).
+*/
+
+static void ErrorMessageC (void * message, void * filename, unsigned int line, void * function)
+{
+ typedef struct ErrorMessageC__T2_a ErrorMessageC__T2;
+
+ struct ErrorMessageC__T2_a { char array[10+1]; };
+ ErrorMessageC__T2 buffer;
+
+ ErrorStringC (filename);
+ ErrorString ((const char *) ":", 1);
+ NumberIO_CardToStr (line, 0, (char *) &buffer.array[0], 10);
+ ErrorString ((const char *) &buffer.array[0], 10);
+ ErrorString ((const char *) ":", 1);
+ if ((libc_strlen (function)) > 0)
+ {
+ ErrorString ((const char *) "in ", 3);
+ ErrorStringC (function);
+ ErrorString ((const char *) " has caused ", 12);
+ }
+ ErrorStringC (message);
+ buffer.array[0] = ASCII_nl;
+ buffer.array[1] = ASCII_nul;
+ ErrorString ((const char *) &buffer.array[0], 10);
+ libc_exit (1);
+}
+
+
+/*
+ InitProcList - initialize the head and tail pointers to NIL.
+*/
+
+static void InitProcList (M2RTS_ProcedureList *p)
+{
+ (*p).head = NULL;
+ (*p).tail = NULL;
+}
+
+
+/*
+ Init - initialize the initial, terminate procedure lists and booleans.
+*/
+
+static void Init (void)
+{
+ InitProcList (&InitialProc);
+ InitProcList (&TerminateProc);
+ ExitValue = 0;
+ isHalting = FALSE;
+ CallExit = FALSE; /* default by calling abort */
+}
+
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void)
+{
+ if (! Initialized)
+ {
+ Initialized = TRUE;
+ Init ();
+ }
+}
+
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_ConstructModules (applicationmodule, libname, argc, argv, envp);
+}
+
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_DeconstructModules (applicationmodule, libname, argc, argv, envp);
+}
+
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+{
+ M2Dependent_RegisterModule (name, libname, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies);
+}
+
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*/
+
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
+{
+ M2Dependent_RequestDependant (modulename, libname, dependantmodule, dependantlibname);
+}
+
+
+/*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*/
+
+extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p)
+{
+ return AppendProc (&TerminateProc, p);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ExecuteInitialProcedures - executes the initial procedures installed by
+ InstallInitialProcedure.
+*/
+
+extern "C" void M2RTS_ExecuteInitialProcedures (void)
+{
+ ExecuteReverse (InitialProc.tail);
+}
+
+
+/*
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
+*/
+
+extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p)
+{
+ return AppendProc (&InitialProc, p);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*/
+
+extern "C" void M2RTS_ExecuteTerminationProcedures (void)
+{
+ ExecuteReverse (TerminateProc.tail);
+}
+
+
+/*
+ Terminate - provides compatibility for pim. It calls exit with
+ the exitcode provided in a prior call to ExitOnHalt
+ (or zero if ExitOnHalt was never called). It does
+ not call ExecuteTerminationProcedures.
+*/
+
+extern "C" void M2RTS_Terminate (void)
+{
+ libc_exit (ExitValue);
+}
+
+
+/*
+ HALT - terminate the current program. The procedure
+ ExecuteTerminationProcedures
+ is called before the program is stopped. The parameter
+ exitcode is optional. If the parameter is not supplied
+ HALT will call libc 'abort', otherwise it will exit with
+ the code supplied. Supplying a parameter to HALT has the
+ same effect as calling ExitOnHalt with the same code and
+ then calling HALT with no parameter.
+*/
+
+extern "C" void M2RTS_HALT (int exitcode)
+{
+ if (exitcode != -1)
+ {
+ CallExit = TRUE;
+ ExitValue = exitcode;
+ }
+ if (isHalting)
+ {
+ /* double HALT found */
+ libc_exit (-1);
+ }
+ else
+ {
+ isHalting = TRUE;
+ M2RTS_ExecuteTerminationProcedures ();
+ }
+ if (CallExit)
+ {
+ libc_exit (ExitValue);
+ }
+ else
+ {
+ libc_abort ();
+ }
+}
+
+
+/*
+ Halt - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high)
+{
+ char filename[_filename_high+1];
+ char function[_function_high+1];
+ char description[_description_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (filename, filename_, _filename_high+1);
+ memcpy (function, function_, _function_high+1);
+ memcpy (description, description_, _description_high+1);
+
+ M2RTS_ErrorMessage ((const char *) description, _description_high, (const char *) filename, _filename_high, line, (const char *) function, _function_high);
+}
+
+
+/*
+ HaltC - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description)
+{
+ ErrorMessageC (description, filename, line, function);
+}
+
+
+/*
+ ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*/
+
+extern "C" void M2RTS_ExitOnHalt (int e)
+{
+ ExitValue = e;
+ CallExit = TRUE;
+}
+
+
+/*
+ ErrorMessage - emits an error message to stderr and then calls exit (1).
+*/
+
+extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high)
+{
+ typedef struct ErrorMessage__T3_a ErrorMessage__T3;
+
+ struct ErrorMessage__T3_a { char array[10+1]; };
+ ErrorMessage__T3 buffer;
+ char message[_message_high+1];
+ char filename[_filename_high+1];
+ char function[_function_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (message, message_, _message_high+1);
+ memcpy (filename, filename_, _filename_high+1);
+ memcpy (function, function_, _function_high+1);
+
+ ErrorString ((const char *) filename, _filename_high);
+ ErrorString ((const char *) ":", 1);
+ NumberIO_CardToStr (line, 0, (char *) &buffer.array[0], 10);
+ ErrorString ((const char *) &buffer.array[0], 10);
+ ErrorString ((const char *) ":", 1);
+ if (! (StrLib_StrEqual ((const char *) function, _function_high, (const char *) "", 0)))
+ {
+ ErrorString ((const char *) "in ", 3);
+ ErrorString ((const char *) function, _function_high);
+ ErrorString ((const char *) " has caused ", 12);
+ }
+ ErrorString ((const char *) message, _message_high);
+ buffer.array[0] = ASCII_nl;
+ buffer.array[1] = ASCII_nul;
+ ErrorString ((const char *) &buffer.array[0], 10);
+ libc_exit (1);
+}
+
+
+/*
+ Length - returns the length of a string, a. This is called whenever
+ the user calls LENGTH and the parameter cannot be calculated
+ at compile time.
+*/
+
+extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high)
+{
+ unsigned int l;
+ unsigned int h;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ l = 0;
+ h = _a_high;
+ while ((l <= h) && (a[l] != ASCII_nul))
+ {
+ l += 1;
+ }
+ return l;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ /*
+ The following are the runtime exception handler routines.
+ */
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), filename, line, column, scope, message);
+}
+
+extern "C" void _M2_M2RTS_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ CheckInitialized ();
+}
+
+extern "C" void _M2_M2RTS_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from MemUtils. */
+/* MemUtils.mod provides some basic memory utilities.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _MemUtils_H
+#define _MemUtils_C
+
+# include "GSYSTEM.h"
+
+
+/*
+ MemCopy - copys a region of memory to the required destination.
+*/
+
+extern "C" void MemUtils_MemCopy (void * from, unsigned int length, void * to);
+
+/*
+ MemZero - sets a region of memory: a..a+length to zero.
+*/
+
+extern "C" void MemUtils_MemZero (void * a, unsigned int length);
+
+
+/*
+ MemCopy - copys a region of memory to the required destination.
+*/
+
+extern "C" void MemUtils_MemCopy (void * from, unsigned int length, void * to)
+{
+ typedef unsigned int *MemCopy__T1;
+
+ typedef unsigned char *MemCopy__T2;
+
+ MemCopy__T1 pwb;
+ MemCopy__T1 pwa;
+ MemCopy__T2 pbb;
+ MemCopy__T2 pba;
+
+ while (length >= sizeof (unsigned int ))
+ {
+ pwa = static_cast<MemCopy__T1> (from);
+ pwb = static_cast<MemCopy__T1> (to);
+ (*pwb) = (*pwa);
+ from = reinterpret_cast<void *> (reinterpret_cast<char *> (from)+sizeof (unsigned int ));
+ to = reinterpret_cast<void *> (reinterpret_cast<char *> (to)+sizeof (unsigned int ));
+ length -= sizeof (unsigned int );
+ }
+ while (length > 0)
+ {
+ pba = static_cast<MemCopy__T2> (from);
+ pbb = static_cast<MemCopy__T2> (to);
+ (*pbb) = (*pba);
+ from = reinterpret_cast<void *> (reinterpret_cast<char *> (from)+sizeof (unsigned char ));
+ to = reinterpret_cast<void *> (reinterpret_cast<char *> (to)+sizeof (unsigned char ));
+ length -= sizeof (unsigned char );
+ }
+}
+
+
+/*
+ MemZero - sets a region of memory: a..a+length to zero.
+*/
+
+extern "C" void MemUtils_MemZero (void * a, unsigned int length)
+{
+ typedef unsigned int *MemZero__T3;
+
+ typedef unsigned char *MemZero__T4;
+
+ MemZero__T3 pwa;
+ MemZero__T4 pba;
+
+ pwa = static_cast<MemZero__T3> (a);
+ while (length >= sizeof (unsigned int ))
+ {
+ (*pwa) = (unsigned int ) (0);
+ pwa += sizeof (unsigned int );
+ length -= sizeof (unsigned int );
+ }
+ pba = static_cast<MemZero__T4> ((void *) (pwa));
+ while (length >= sizeof (unsigned char ))
+ {
+ (*pba) = (unsigned char ) (0);
+ pba += sizeof (unsigned char );
+ length -= sizeof (unsigned char );
+ }
+}
+
+extern "C" void _M2_MemUtils_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_MemUtils_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from NumberIO. */
+/* NumberIO.mod provides conversion of ordinal numbers.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#define _NumberIO_H
+#define _NumberIO_C
+
+# include "GASCII.h"
+# include "GStrIO.h"
+# include "GStrLib.h"
+# include "GM2RTS.h"
+
+# define MaxLineLength 79
+# define MaxDigits 20
+# define MaxHexDigits 20
+# define MaxOctDigits 40
+# define MaxBits 64
+extern "C" void NumberIO_ReadCard (unsigned int *x);
+extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n);
+extern "C" void NumberIO_ReadHex (unsigned int *x);
+extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n);
+extern "C" void NumberIO_ReadInt (int *x);
+extern "C" void NumberIO_WriteInt (int x, unsigned int n);
+extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_ReadOct (unsigned int *x);
+extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n);
+extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_ReadBin (unsigned int *x);
+extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n);
+extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x);
+
+extern "C" void NumberIO_ReadCard (unsigned int *x)
+{
+ typedef struct ReadCard__T1_a ReadCard__T1;
+
+ struct ReadCard__T1_a { char array[MaxLineLength+1]; };
+ ReadCard__T1 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToCard ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n)
+{
+ typedef struct WriteCard__T2_a WriteCard__T2;
+
+ struct WriteCard__T2_a { char array[MaxLineLength+1]; };
+ WriteCard__T2 a;
+
+ NumberIO_CardToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_ReadHex (unsigned int *x)
+{
+ typedef struct ReadHex__T3_a ReadHex__T3;
+
+ struct ReadHex__T3_a { char array[MaxLineLength+1]; };
+ ReadHex__T3 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToHex ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n)
+{
+ typedef struct WriteHex__T4_a WriteHex__T4;
+
+ struct WriteHex__T4_a { char array[MaxLineLength+1]; };
+ WriteHex__T4 a;
+
+ NumberIO_HexToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_ReadInt (int *x)
+{
+ typedef struct ReadInt__T5_a ReadInt__T5;
+
+ struct ReadInt__T5_a { char array[MaxLineLength+1]; };
+ ReadInt__T5 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToInt ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteInt (int x, unsigned int n)
+{
+ typedef struct WriteInt__T6_a WriteInt__T6;
+
+ struct WriteInt__T6_a { char array[MaxLineLength+1]; };
+ WriteInt__T6 a;
+
+ NumberIO_IntToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct CardToStr__T7_a CardToStr__T7;
+
+ struct CardToStr__T7_a { unsigned int array[MaxDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ CardToStr__T7 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 10;
+ x = x / 10;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ while ((i > 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if ((a[i] < '0') || (a[i] > '9'))
+ {
+ i += 1;
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ (*x) = (10*(*x))+( ((unsigned int) (a[i]))- ((unsigned int) ('0')));
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '9'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct HexToStr__T8_a HexToStr__T8;
+
+ struct HexToStr__T8_a { unsigned int array[MaxHexDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ HexToStr__T8 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxHexDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 0x010;
+ x = x / 0x010;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = '0';
+ j += 1;
+ n -= 1;
+ }
+ while ((i != 0) && (j <= Higha))
+ {
+ if (buf.array[i-1] < 10)
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ }
+ else
+ {
+ a[j] = ((char) ((buf.array[i-1]+ ((unsigned int) ('A')))-10));
+ }
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ NumberIO_StrToHexInt ((const char *) a, _a_high, &i);
+ (*x) = (unsigned int ) (i);
+}
+
+extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct IntToStr__T9_a IntToStr__T9;
+
+ struct IntToStr__T9_a { unsigned int array[MaxDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int c;
+ unsigned int Higha;
+ IntToStr__T9 buf;
+ unsigned int Negative;
+
+ if (x < 0)
+ {
+ /* avoid dangling else. */
+ Negative = TRUE;
+ c = ((unsigned int ) (abs (x+1)))+1;
+ if (n > 0)
+ {
+ n -= 1;
+ }
+ }
+ else
+ {
+ c = x;
+ Negative = FALSE;
+ }
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = c % 10;
+ c = c / 10;
+ } while (! (c == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ if (Negative)
+ {
+ a[j] = '-';
+ j += 1;
+ }
+ while ((i != 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int Negative;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ Negative = FALSE;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if (a[i] == '-')
+ {
+ i += 1;
+ Negative = ! Negative;
+ }
+ else if ((a[i] < '0') || (a[i] > '9'))
+ {
+ /* avoid dangling else. */
+ i += 1;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ if (Negative)
+ {
+ (*x) = (10*(*x))-((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ }
+ else
+ {
+ (*x) = (10*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ }
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '9'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_ReadOct (unsigned int *x)
+{
+ typedef struct ReadOct__T10_a ReadOct__T10;
+
+ struct ReadOct__T10_a { char array[MaxLineLength+1]; };
+ ReadOct__T10 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToOct ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n)
+{
+ typedef struct WriteOct__T11_a WriteOct__T11;
+
+ struct WriteOct__T11_a { char array[MaxLineLength+1]; };
+ WriteOct__T11 a;
+
+ NumberIO_OctToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct OctToStr__T12_a OctToStr__T12;
+
+ struct OctToStr__T12_a { unsigned int array[MaxOctDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ OctToStr__T12 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxOctDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 8;
+ x = x / 8;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ while ((i > 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ NumberIO_StrToOctInt ((const char *) a, _a_high, &i);
+ (*x) = (unsigned int ) (i);
+}
+
+extern "C" void NumberIO_ReadBin (unsigned int *x)
+{
+ typedef struct ReadBin__T13_a ReadBin__T13;
+
+ struct ReadBin__T13_a { char array[MaxLineLength+1]; };
+ ReadBin__T13 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToBin ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n)
+{
+ typedef struct WriteBin__T14_a WriteBin__T14;
+
+ struct WriteBin__T14_a { char array[MaxLineLength+1]; };
+ WriteBin__T14 a;
+
+ NumberIO_BinToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct BinToStr__T15_a BinToStr__T15;
+
+ struct BinToStr__T15_a { unsigned int array[MaxBits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ BinToStr__T15 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxBits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxBits", 27);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 2;
+ x = x / 2;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ while ((i > 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ NumberIO_StrToBinInt ((const char *) a, _a_high, &i);
+ (*x) = (unsigned int ) (i);
+}
+
+extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if ((a[i] < '0') || (a[i] > '1'))
+ {
+ i += 1;
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ (*x) = (2*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '1'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if (((a[i] >= '0') && (a[i] <= '9')) || ((a[i] >= 'A') && (a[i] <= 'F')))
+ {
+ ok = FALSE;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ if ((a[i] >= '0') && (a[i] <= '9'))
+ {
+ (*x) = (0x010*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ }
+ else if ((a[i] >= 'A') && (a[i] <= 'F'))
+ {
+ /* avoid dangling else. */
+ (*x) = (0x010*(*x))+((int ) (( ((unsigned int) (a[i]))- ((unsigned int) ('A')))+10));
+ }
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if (((a[i] < '0') || (a[i] > '9')) && ((a[i] < 'A') || (a[i] > 'F')))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if ((a[i] < '0') || (a[i] > '7'))
+ {
+ i += 1;
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ (*x) = (8*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '7'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void _M2_NumberIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_NumberIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from PushBackInput. */
+/* PushBackInput.mod provides a method for pushing back and consuming input.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _PushBackInput_H
+#define _PushBackInput_C
+
+# include "GFIO.h"
+# include "GDynamicStrings.h"
+# include "GASCII.h"
+# include "GDebug.h"
+# include "GStrLib.h"
+# include "GNumberIO.h"
+# include "GStrIO.h"
+# include "GStdIO.h"
+# include "Glibc.h"
+
+# define MaxPushBackStack 8192
+# define MaxFileName 4096
+typedef struct PushBackInput__T2_a PushBackInput__T2;
+
+typedef struct PushBackInput__T3_a PushBackInput__T3;
+
+struct PushBackInput__T2_a { char array[MaxFileName+1]; };
+struct PushBackInput__T3_a { char array[MaxPushBackStack+1]; };
+static PushBackInput__T2 FileName;
+static PushBackInput__T3 CharStack;
+static unsigned int ExitStatus;
+static unsigned int Column;
+static unsigned int StackPtr;
+static unsigned int LineNo;
+static unsigned int Debugging;
+
+/*
+ Open - opens a file for reading.
+*/
+
+extern "C" FIO_File PushBackInput_Open (const char *a_, unsigned int _a_high);
+
+/*
+ GetCh - gets a character from either the push back stack or
+ from file, f.
+*/
+
+extern "C" char PushBackInput_GetCh (FIO_File f);
+
+/*
+ PutCh - pushes a character onto the push back stack, it also
+ returns the character which has been pushed.
+*/
+
+extern "C" char PushBackInput_PutCh (char ch);
+
+/*
+ PutString - pushes a string onto the push back stack.
+*/
+
+extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high);
+
+/*
+ PutStr - pushes a dynamic string onto the push back stack.
+ The string, s, is not deallocated.
+*/
+
+extern "C" void PushBackInput_PutStr (DynamicStrings_String s);
+
+/*
+ Error - emits an error message with the appropriate file, line combination.
+*/
+
+extern "C" void PushBackInput_Error (const char *a_, unsigned int _a_high);
+
+/*
+ WarnError - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnError (const char *a_, unsigned int _a_high);
+
+/*
+ WarnString - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnString (DynamicStrings_String s);
+
+/*
+ Close - closes the opened file.
+*/
+
+extern "C" void PushBackInput_Close (FIO_File f);
+
+/*
+ GetExitStatus - returns the exit status which will be 1 if any warnings were issued.
+*/
+
+extern "C" unsigned int PushBackInput_GetExitStatus (void);
+
+/*
+ SetDebug - sets the debug flag on or off.
+*/
+
+extern "C" void PushBackInput_SetDebug (unsigned int d);
+
+/*
+ GetColumnPosition - returns the column position of the current character.
+*/
+
+extern "C" unsigned int PushBackInput_GetColumnPosition (void);
+
+/*
+ GetCurrentLine - returns the current line number.
+*/
+
+extern "C" unsigned int PushBackInput_GetCurrentLine (void);
+
+/*
+ ErrChar - writes a char, ch, to stderr.
+*/
+
+static void ErrChar (char ch);
+
+/*
+ Init - initialize global variables.
+*/
+
+static void Init (void);
+
+
+/*
+ ErrChar - writes a char, ch, to stderr.
+*/
+
+static void ErrChar (char ch)
+{
+ FIO_WriteChar (FIO_StdErr, ch);
+}
+
+
+/*
+ Init - initialize global variables.
+*/
+
+static void Init (void)
+{
+ ExitStatus = 0;
+ StackPtr = 0;
+ LineNo = 1;
+ Column = 0;
+}
+
+
+/*
+ Open - opens a file for reading.
+*/
+
+extern "C" FIO_File PushBackInput_Open (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ Init ();
+ StrLib_StrCopy ((const char *) a, _a_high, (char *) &FileName.array[0], MaxFileName);
+ return FIO_OpenToRead ((const char *) a, _a_high);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetCh - gets a character from either the push back stack or
+ from file, f.
+*/
+
+extern "C" char PushBackInput_GetCh (FIO_File f)
+{
+ char ch;
+
+ if (StackPtr > 0)
+ {
+ StackPtr -= 1;
+ if (Debugging)
+ {
+ StdIO_Write (CharStack.array[StackPtr]);
+ }
+ return CharStack.array[StackPtr];
+ }
+ else
+ {
+ if ((FIO_EOF (f)) || (! (FIO_IsNoError (f))))
+ {
+ ch = ASCII_nul;
+ }
+ else
+ {
+ do {
+ ch = FIO_ReadChar (f);
+ } while (! (((ch != ASCII_cr) || (FIO_EOF (f))) || (! (FIO_IsNoError (f)))));
+ if (ch == ASCII_lf)
+ {
+ Column = 0;
+ LineNo += 1;
+ }
+ else
+ {
+ Column += 1;
+ }
+ }
+ if (Debugging)
+ {
+ StdIO_Write (ch);
+ }
+ return ch;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutCh - pushes a character onto the push back stack, it also
+ returns the character which has been pushed.
+*/
+
+extern "C" char PushBackInput_PutCh (char ch)
+{
+ if (StackPtr < MaxPushBackStack)
+ {
+ CharStack.array[StackPtr] = ch;
+ StackPtr += 1;
+ }
+ else
+ {
+ Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ }
+ return ch;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutString - pushes a string onto the push back stack.
+*/
+
+extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high)
+{
+ unsigned int l;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ l = StrLib_StrLen ((const char *) a, _a_high);
+ while (l > 0)
+ {
+ l -= 1;
+ if ((PushBackInput_PutCh (a[l])) != a[l])
+ {
+ Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ }
+ }
+}
+
+
+/*
+ PutStr - pushes a dynamic string onto the push back stack.
+ The string, s, is not deallocated.
+*/
+
+extern "C" void PushBackInput_PutStr (DynamicStrings_String s)
+{
+ unsigned int i;
+
+ i = DynamicStrings_Length (s);
+ while (i > 0)
+ {
+ i -= 1;
+ if ((PushBackInput_PutCh (DynamicStrings_char (s, static_cast<int> (i)))) != (DynamicStrings_char (s, static_cast<int> (i))))
+ {
+ Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ }
+ }
+}
+
+
+/*
+ Error - emits an error message with the appropriate file, line combination.
+*/
+
+extern "C" void PushBackInput_Error (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) ErrChar});
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ StrIO_WriteString ((const char *) a, _a_high);
+ StrIO_WriteLn ();
+ StdIO_PopOutput ();
+ FIO_Close (FIO_StdErr);
+ libc_exit (1);
+}
+
+
+/*
+ WarnError - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnError (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) ErrChar});
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ StrIO_WriteString ((const char *) a, _a_high);
+ StrIO_WriteLn ();
+ StdIO_PopOutput ();
+ ExitStatus = 1;
+}
+
+
+/*
+ WarnString - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnString (DynamicStrings_String s)
+{
+ typedef char *WarnString__T1;
+
+ WarnString__T1 p;
+
+ p = static_cast<WarnString__T1> (DynamicStrings_string (s));
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ do {
+ if (p != NULL)
+ {
+ if ((*p) == ASCII_lf)
+ {
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ }
+ else
+ {
+ StdIO_Write ((*p));
+ }
+ p += 1;
+ }
+ } while (! ((p == NULL) || ((*p) == ASCII_nul)));
+ ExitStatus = 1;
+}
+
+
+/*
+ Close - closes the opened file.
+*/
+
+extern "C" void PushBackInput_Close (FIO_File f)
+{
+ FIO_Close (f);
+}
+
+
+/*
+ GetExitStatus - returns the exit status which will be 1 if any warnings were issued.
+*/
+
+extern "C" unsigned int PushBackInput_GetExitStatus (void)
+{
+ return ExitStatus;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetDebug - sets the debug flag on or off.
+*/
+
+extern "C" void PushBackInput_SetDebug (unsigned int d)
+{
+ Debugging = d;
+}
+
+
+/*
+ GetColumnPosition - returns the column position of the current character.
+*/
+
+extern "C" unsigned int PushBackInput_GetColumnPosition (void)
+{
+ if (StackPtr > Column)
+ {
+ return 0;
+ }
+ else
+ {
+ return Column-StackPtr;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetCurrentLine - returns the current line number.
+*/
+
+extern "C" unsigned int PushBackInput_GetCurrentLine (void)
+{
+ return LineNo;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_PushBackInput_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ PushBackInput_SetDebug (FALSE);
+ Init ();
+}
+
+extern "C" void _M2_PushBackInput_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from RTExceptions. */
+/* RTExceptions.mod runtime exception handler routines.
+
+Copyright (C) 2008-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#ifndef __cplusplus
+extern void throw (unsigned int);
+#endif
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _RTExceptions_H
+#define _RTExceptions_C
+
+# include "GASCII.h"
+# include "GStrLib.h"
+# include "GStorage.h"
+# include "GSYSTEM.h"
+# include "Glibc.h"
+# include "GM2RTS.h"
+# include "GSysExceptions.h"
+# include "GM2EXCEPTION.h"
+
+typedef struct RTExceptions_ProcedureHandler_p RTExceptions_ProcedureHandler;
+
+# define MaxBuffer 4096
+typedef struct RTExceptions__T1_r RTExceptions__T1;
+
+typedef char *RTExceptions_PtrToChar;
+
+typedef struct RTExceptions__T2_a RTExceptions__T2;
+
+typedef struct RTExceptions__T3_r RTExceptions__T3;
+
+typedef RTExceptions__T3 *RTExceptions_Handler;
+
+typedef RTExceptions__T1 *RTExceptions_EHBlock;
+
+typedef void (*RTExceptions_ProcedureHandler_t) (void);
+struct RTExceptions_ProcedureHandler_p { RTExceptions_ProcedureHandler_t proc; };
+
+struct RTExceptions__T2_a { char array[MaxBuffer+1]; };
+struct RTExceptions__T1_r {
+ RTExceptions__T2 buffer;
+ unsigned int number;
+ RTExceptions_Handler handlers;
+ RTExceptions_EHBlock right;
+ };
+
+struct RTExceptions__T3_r {
+ RTExceptions_ProcedureHandler p;
+ unsigned int n;
+ RTExceptions_Handler right;
+ RTExceptions_Handler left;
+ RTExceptions_Handler stack;
+ };
+
+static unsigned int inException;
+static RTExceptions_Handler freeHandler;
+static RTExceptions_EHBlock freeEHB;
+static RTExceptions_EHBlock currentEHB;
+static void * currentSource;
+
+/*
+ Raise - invoke the exception handler associated with, number,
+ in the active EHBlock. It keeps a record of the number
+ and message in the EHBlock for later use.
+*/
+
+extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message) __attribute__ ((noreturn));
+
+/*
+ SetExceptionBlock - sets, source, as the active EHB.
+*/
+
+extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source);
+
+/*
+ GetExceptionBlock - returns the active EHB.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void);
+
+/*
+ GetTextBuffer - returns the address of the EHB buffer.
+*/
+
+extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e);
+
+/*
+ GetTextBufferSize - return the size of the EHB text buffer.
+*/
+
+extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e);
+
+/*
+ GetNumber - return the exception number associated with,
+ source.
+*/
+
+extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source);
+
+/*
+ InitExceptionBlock - creates and returns a new exception block.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void);
+
+/*
+ KillExceptionBlock - destroys the EHB, e, and all its handlers.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e);
+
+/*
+ PushHandler - install a handler in EHB, e.
+*/
+
+extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p);
+
+/*
+ PopHandler - removes the handler associated with, number, from
+ EHB, e.
+*/
+
+extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number);
+
+/*
+ DefaultErrorCatch - displays the current error message in
+ the current exception block and then
+ calls HALT.
+*/
+
+extern "C" void RTExceptions_DefaultErrorCatch (void);
+
+/*
+ BaseExceptionsThrow - configures the Modula-2 exceptions to call
+ THROW which in turn can be caught by an
+ exception block. If this is not called then
+ a Modula-2 exception will simply call an
+ error message routine and then HALT.
+*/
+
+extern "C" void RTExceptions_BaseExceptionsThrow (void);
+
+/*
+ IsInExceptionState - returns TRUE if the program is currently
+ in the exception state.
+*/
+
+extern "C" unsigned int RTExceptions_IsInExceptionState (void);
+
+/*
+ SetExceptionState - returns the current exception state and
+ then sets the current exception state to,
+ to.
+*/
+
+extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to);
+
+/*
+ SwitchExceptionState - assigns, from, with the current exception
+ state and then assigns the current exception
+ to, to.
+*/
+
+extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to);
+
+/*
+ GetBaseExceptionBlock - returns the initial language exception block
+ created.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void);
+
+/*
+ SetExceptionSource - sets the current exception source to, source.
+*/
+
+extern "C" void RTExceptions_SetExceptionSource (void * source);
+
+/*
+ GetExceptionSource - returns the current exception source.
+*/
+
+extern "C" void * RTExceptions_GetExceptionSource (void);
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high);
+
+/*
+ findHandler -
+*/
+
+static RTExceptions_Handler findHandler (RTExceptions_EHBlock e, unsigned int number);
+
+/*
+ InvokeHandler - invokes the associated handler for the current
+ exception in the active EHB.
+*/
+
+static void InvokeHandler (void) __attribute__ ((noreturn));
+
+/*
+ DoThrow - throw the exception number in the exception block.
+*/
+
+static void DoThrow (void);
+
+/*
+ addChar - adds, ch, to the current exception handler text buffer
+ at index, i. The index in then incremented.
+*/
+
+static void addChar (char ch, unsigned int *i);
+
+/*
+ stripPath - returns the filename from the path.
+*/
+
+static void * stripPath (void * s);
+
+/*
+ addFile - adds the filename determined by, s, however it strips
+ any preceeding path.
+*/
+
+static void addFile (void * s, unsigned int *i);
+
+/*
+ addStr - adds a C string from address, s, into the current
+ handler text buffer.
+*/
+
+static void addStr (void * s, unsigned int *i);
+
+/*
+ addNum - adds a number, n, to the current handler
+ text buffer.
+*/
+
+static void addNum (unsigned int n, unsigned int *i);
+
+/*
+ New - returns a new EHBlock.
+*/
+
+static RTExceptions_EHBlock New (void);
+
+/*
+ NewHandler - returns a new handler.
+*/
+
+static RTExceptions_Handler NewHandler (void);
+
+/*
+ KillHandler - returns, NIL, and places, h, onto the free list.
+*/
+
+static RTExceptions_Handler KillHandler (RTExceptions_Handler h);
+
+/*
+ KillHandlers - kills all handlers in the list.
+*/
+
+static RTExceptions_Handler KillHandlers (RTExceptions_Handler h);
+
+/*
+ InitHandler -
+*/
+
+static RTExceptions_Handler InitHandler (RTExceptions_Handler h, RTExceptions_Handler l, RTExceptions_Handler r, RTExceptions_Handler s, unsigned int number, RTExceptions_ProcedureHandler proc);
+
+/*
+ SubHandler -
+*/
+
+static void SubHandler (RTExceptions_Handler h);
+
+/*
+ AddHandler - add, e, to the end of the list of handlers.
+*/
+
+static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h);
+
+/*
+ indexf - raise an index out of bounds exception.
+*/
+
+static void indexf (void * a);
+
+/*
+ range - raise an assignment out of range exception.
+*/
+
+static void range (void * a);
+
+/*
+ casef - raise a case selector out of range exception.
+*/
+
+static void casef (void * a);
+
+/*
+ invalidloc - raise an invalid location exception.
+*/
+
+static void invalidloc (void * a);
+
+/*
+ function - raise a ... function ... exception. --fixme-- what does this exception catch?
+*/
+
+static void function (void * a);
+
+/*
+ wholevalue - raise an illegal whole value exception.
+*/
+
+static void wholevalue (void * a);
+
+/*
+ wholediv - raise a division by zero exception.
+*/
+
+static void wholediv (void * a);
+
+/*
+ realvalue - raise an illegal real value exception.
+*/
+
+static void realvalue (void * a);
+
+/*
+ realdiv - raise a division by zero in a real number exception.
+*/
+
+static void realdiv (void * a);
+
+/*
+ complexvalue - raise an illegal complex value exception.
+*/
+
+static void complexvalue (void * a);
+
+/*
+ complexdiv - raise a division by zero in a complex number exception.
+*/
+
+static void complexdiv (void * a);
+
+/*
+ protection - raise a protection exception.
+*/
+
+static void protection (void * a);
+
+/*
+ systemf - raise a system exception.
+*/
+
+static void systemf (void * a);
+
+/*
+ coroutine - raise a coroutine exception.
+*/
+
+static void coroutine (void * a);
+
+/*
+ exception - raise a exception exception.
+*/
+
+static void exception (void * a);
+
+/*
+ Init - initialises this module.
+*/
+
+static void Init (void);
+
+/*
+ TidyUp - deallocate memory used by this module.
+*/
+
+static void TidyUp (void);
+
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high)
+{
+ int n;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ n = static_cast<int> (libc_write (2, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
+}
+
+
+/*
+ findHandler -
+*/
+
+static RTExceptions_Handler findHandler (RTExceptions_EHBlock e, unsigned int number)
+{
+ RTExceptions_Handler h;
+
+ h = e->handlers->right;
+ while ((h != e->handlers) && (number != h->n))
+ {
+ h = h->right;
+ }
+ if (h == e->handlers)
+ {
+ return NULL;
+ }
+ else
+ {
+ return h;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InvokeHandler - invokes the associated handler for the current
+ exception in the active EHB.
+*/
+
+static void InvokeHandler (void)
+{
+ RTExceptions_Handler h;
+
+ h = findHandler (currentEHB, currentEHB->number);
+ if (h == NULL)
+ {
+ throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ()));
+ }
+ else
+ {
+ (*h->p.proc) ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ DoThrow - throw the exception number in the exception block.
+*/
+
+static void DoThrow (void)
+{
+ throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ()));
+}
+
+
+/*
+ addChar - adds, ch, to the current exception handler text buffer
+ at index, i. The index in then incremented.
+*/
+
+static void addChar (char ch, unsigned int *i)
+{
+ if (((*i) <= MaxBuffer) && (currentEHB != NULL))
+ {
+ currentEHB->buffer.array[(*i)] = ch;
+ (*i) += 1;
+ }
+}
+
+
+/*
+ stripPath - returns the filename from the path.
+*/
+
+static void * stripPath (void * s)
+{
+ RTExceptions_PtrToChar f;
+ RTExceptions_PtrToChar p;
+
+ p = static_cast<RTExceptions_PtrToChar> (s);
+ f = static_cast<RTExceptions_PtrToChar> (s);
+ while ((*p) != ASCII_nul)
+ {
+ if ((*p) == '/')
+ {
+ p += 1;
+ f = p;
+ }
+ else
+ {
+ p += 1;
+ }
+ }
+ return reinterpret_cast<void *> (f);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addFile - adds the filename determined by, s, however it strips
+ any preceeding path.
+*/
+
+static void addFile (void * s, unsigned int *i)
+{
+ RTExceptions_PtrToChar p;
+
+ p = static_cast<RTExceptions_PtrToChar> (stripPath (s));
+ while ((p != NULL) && ((*p) != ASCII_nul))
+ {
+ addChar ((*p), i);
+ p += 1;
+ }
+}
+
+
+/*
+ addStr - adds a C string from address, s, into the current
+ handler text buffer.
+*/
+
+static void addStr (void * s, unsigned int *i)
+{
+ RTExceptions_PtrToChar p;
+
+ p = static_cast<RTExceptions_PtrToChar> (s);
+ while ((p != NULL) && ((*p) != ASCII_nul))
+ {
+ addChar ((*p), i);
+ p += 1;
+ }
+}
+
+
+/*
+ addNum - adds a number, n, to the current handler
+ text buffer.
+*/
+
+static void addNum (unsigned int n, unsigned int *i)
+{
+ if (n < 10)
+ {
+ addChar ( ((char) ((n % 10)+ ((unsigned int) ('0')))), i);
+ }
+ else
+ {
+ addNum (n / 10, i);
+ addNum (n % 10, i);
+ }
+}
+
+
+/*
+ New - returns a new EHBlock.
+*/
+
+static RTExceptions_EHBlock New (void)
+{
+ RTExceptions_EHBlock e;
+
+ if (freeEHB == NULL)
+ {
+ Storage_ALLOCATE ((void **) &e, sizeof (RTExceptions__T1));
+ }
+ else
+ {
+ e = freeEHB;
+ freeEHB = freeEHB->right;
+ }
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ NewHandler - returns a new handler.
+*/
+
+static RTExceptions_Handler NewHandler (void)
+{
+ RTExceptions_Handler h;
+
+ if (freeHandler == NULL)
+ {
+ Storage_ALLOCATE ((void **) &h, sizeof (RTExceptions__T3));
+ }
+ else
+ {
+ h = freeHandler;
+ freeHandler = freeHandler->right;
+ }
+ return h;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillHandler - returns, NIL, and places, h, onto the free list.
+*/
+
+static RTExceptions_Handler KillHandler (RTExceptions_Handler h)
+{
+ h->right = freeHandler;
+ freeHandler = h;
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillHandlers - kills all handlers in the list.
+*/
+
+static RTExceptions_Handler KillHandlers (RTExceptions_Handler h)
+{
+ h->left->right = freeHandler;
+ freeHandler = h;
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitHandler -
+*/
+
+static RTExceptions_Handler InitHandler (RTExceptions_Handler h, RTExceptions_Handler l, RTExceptions_Handler r, RTExceptions_Handler s, unsigned int number, RTExceptions_ProcedureHandler proc)
+{
+ h->p = proc;
+ h->n = number;
+ h->right = r;
+ h->left = l;
+ h->stack = s;
+ return h;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SubHandler -
+*/
+
+static void SubHandler (RTExceptions_Handler h)
+{
+ h->right->left = h->left;
+ h->left->right = h->right;
+}
+
+
+/*
+ AddHandler - add, e, to the end of the list of handlers.
+*/
+
+static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h)
+{
+ h->right = e->handlers;
+ h->left = e->handlers->left;
+ e->handlers->left->right = h;
+ e->handlers->left = h;
+}
+
+
+/*
+ indexf - raise an index out of bounds exception.
+*/
+
+static void indexf (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 613, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("array index out of bounds")));
+}
+
+
+/*
+ range - raise an assignment out of range exception.
+*/
+
+static void range (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 625, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("assignment out of range")));
+}
+
+
+/*
+ casef - raise a case selector out of range exception.
+*/
+
+static void casef (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 637, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
+}
+
+
+/*
+ invalidloc - raise an invalid location exception.
+*/
+
+static void invalidloc (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 649, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("invalid address referenced")));
+}
+
+
+/*
+ function - raise a ... function ... exception. --fixme-- what does this exception catch?
+*/
+
+static void function (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 661, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... function ... "))); /* --fixme-- what has happened ? */
+}
+
+
+/*
+ wholevalue - raise an illegal whole value exception.
+*/
+
+static void wholevalue (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 673, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+}
+
+
+/*
+ wholediv - raise a division by zero exception.
+*/
+
+static void wholediv (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 685, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+}
+
+
+/*
+ realvalue - raise an illegal real value exception.
+*/
+
+static void realvalue (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 697, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal real value exception")));
+}
+
+
+/*
+ realdiv - raise a division by zero in a real number exception.
+*/
+
+static void realdiv (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 709, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("real number division by zero exception")));
+}
+
+
+/*
+ complexvalue - raise an illegal complex value exception.
+*/
+
+static void complexvalue (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 721, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal complex value exception")));
+}
+
+
+/*
+ complexdiv - raise a division by zero in a complex number exception.
+*/
+
+static void complexdiv (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 733, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
+}
+
+
+/*
+ protection - raise a protection exception.
+*/
+
+static void protection (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 745, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
+}
+
+
+/*
+ systemf - raise a system exception.
+*/
+
+static void systemf (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 757, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
+}
+
+
+/*
+ coroutine - raise a coroutine exception.
+*/
+
+static void coroutine (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 769, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
+}
+
+
+/*
+ exception - raise a exception exception.
+*/
+
+static void exception (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 781, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("exception exception")));
+}
+
+
+/*
+ Init - initialises this module.
+*/
+
+static void Init (void)
+{
+ inException = FALSE;
+ freeHandler = NULL;
+ freeEHB = NULL;
+ currentEHB = RTExceptions_InitExceptionBlock ();
+ currentSource = NULL;
+ RTExceptions_BaseExceptionsThrow ();
+ SysExceptions_InitExceptionHandlers ((SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) indexf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) range}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) casef}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) invalidloc}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) function}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholevalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholediv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) protection}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) systemf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) coroutine}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) exception});
+}
+
+
+/*
+ TidyUp - deallocate memory used by this module.
+*/
+
+static void TidyUp (void)
+{
+ RTExceptions_Handler f;
+ RTExceptions_EHBlock e;
+
+ if (currentEHB != NULL)
+ {
+ currentEHB = RTExceptions_KillExceptionBlock (currentEHB);
+ }
+ while (freeHandler != NULL)
+ {
+ f = freeHandler;
+ freeHandler = freeHandler->right;
+ Storage_DEALLOCATE ((void **) &f, sizeof (RTExceptions__T3));
+ }
+ while (freeEHB != NULL)
+ {
+ e = freeEHB;
+ freeEHB = freeEHB->right;
+ Storage_DEALLOCATE ((void **) &e, sizeof (RTExceptions__T1));
+ }
+}
+
+
+/*
+ Raise - invoke the exception handler associated with, number,
+ in the active EHBlock. It keeps a record of the number
+ and message in the EHBlock for later use.
+*/
+
+extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message)
+{
+ unsigned int i;
+
+ currentEHB->number = number;
+ i = 0;
+ addFile (file, &i);
+ addChar (':', &i);
+ addNum (line, &i);
+ addChar (':', &i);
+ addNum (column, &i);
+ addChar (':', &i);
+ addChar (' ', &i);
+ addChar ('I', &i);
+ addChar ('n', &i);
+ addChar (' ', &i);
+ addStr (function, &i);
+ addChar (ASCII_nl, &i);
+ addFile (file, &i);
+ addChar (':', &i);
+ addNum (line, &i);
+ addChar (':', &i);
+ addNum (column, &i);
+ addChar (':', &i);
+ addStr (message, &i);
+ addChar (ASCII_nl, &i);
+ addChar (ASCII_nul, &i);
+ InvokeHandler ();
+}
+
+
+/*
+ SetExceptionBlock - sets, source, as the active EHB.
+*/
+
+extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source)
+{
+ currentEHB = source;
+}
+
+
+/*
+ GetExceptionBlock - returns the active EHB.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void)
+{
+ return currentEHB;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetTextBuffer - returns the address of the EHB buffer.
+*/
+
+extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e)
+{
+ return &e->buffer;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetTextBufferSize - return the size of the EHB text buffer.
+*/
+
+extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e)
+{
+ return sizeof (e->buffer);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetNumber - return the exception number associated with,
+ source.
+*/
+
+extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source)
+{
+ return source->number;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitExceptionBlock - creates and returns a new exception block.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void)
+{
+ RTExceptions_EHBlock e;
+
+ e = New ();
+ e->number = UINT_MAX;
+ e->handlers = NewHandler (); /* add the dummy onto the head */
+ e->handlers->right = e->handlers; /* add the dummy onto the head */
+ e->handlers->left = e->handlers;
+ e->right = e;
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillExceptionBlock - destroys the EHB, e, and all its handlers.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e)
+{
+ e->handlers = KillHandlers (e->handlers);
+ e->right = freeEHB;
+ freeEHB = e;
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PushHandler - install a handler in EHB, e.
+*/
+
+extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p)
+{
+ RTExceptions_Handler h;
+ RTExceptions_Handler i;
+
+ h = findHandler (e, number);
+ if (h == NULL)
+ {
+ i = InitHandler (NewHandler (), NULL, NULL, NULL, number, p);
+ }
+ else
+ {
+ /* remove, h, */
+ SubHandler (h);
+ /* stack it onto a new handler */
+ i = InitHandler (NewHandler (), NULL, NULL, h, number, p);
+ }
+ /* add new handler */
+ AddHandler (e, i);
+}
+
+
+/*
+ PopHandler - removes the handler associated with, number, from
+ EHB, e.
+*/
+
+extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number)
+{
+ RTExceptions_Handler h;
+ RTExceptions_Handler i;
+
+ h = findHandler (e, number);
+ if (h != NULL)
+ {
+ /* remove, h, */
+ SubHandler (h);
+ if (h->stack != NULL)
+ {
+ AddHandler (e, h->stack);
+ }
+ h = KillHandler (h);
+ }
+}
+
+
+/*
+ DefaultErrorCatch - displays the current error message in
+ the current exception block and then
+ calls HALT.
+*/
+
+extern "C" void RTExceptions_DefaultErrorCatch (void)
+{
+ RTExceptions_EHBlock e;
+ int n;
+
+ e = RTExceptions_GetExceptionBlock ();
+ n = static_cast<int> (libc_write (2, RTExceptions_GetTextBuffer (e), libc_strlen (RTExceptions_GetTextBuffer (e))));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ BaseExceptionsThrow - configures the Modula-2 exceptions to call
+ THROW which in turn can be caught by an
+ exception block. If this is not called then
+ a Modula-2 exception will simply call an
+ error message routine and then HALT.
+*/
+
+extern "C" void RTExceptions_BaseExceptionsThrow (void)
+{
+ M2EXCEPTION_M2Exceptions i;
+
+ for (i=M2EXCEPTION_indexException; i<=M2EXCEPTION_exException; i= static_cast<M2EXCEPTION_M2Exceptions>(static_cast<int>(i+1)))
+ {
+ RTExceptions_PushHandler (RTExceptions_GetExceptionBlock (), (unsigned int ) (i), (RTExceptions_ProcedureHandler) {(RTExceptions_ProcedureHandler_t) DoThrow});
+ }
+}
+
+
+/*
+ IsInExceptionState - returns TRUE if the program is currently
+ in the exception state.
+*/
+
+extern "C" unsigned int RTExceptions_IsInExceptionState (void)
+{
+ return inException;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetExceptionState - returns the current exception state and
+ then sets the current exception state to,
+ to.
+*/
+
+extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to)
+{
+ unsigned int old;
+
+ old = inException;
+ inException = to;
+ return old;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SwitchExceptionState - assigns, from, with the current exception
+ state and then assigns the current exception
+ to, to.
+*/
+
+extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to)
+{
+ (*from) = inException;
+ inException = to;
+}
+
+
+/*
+ GetBaseExceptionBlock - returns the initial language exception block
+ created.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void)
+{
+ if (currentEHB == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod", 53, 599, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
+ }
+ else
+ {
+ return currentEHB;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetExceptionSource - sets the current exception source to, source.
+*/
+
+extern "C" void RTExceptions_SetExceptionSource (void * source)
+{
+ currentSource = source;
+}
+
+
+/*
+ GetExceptionSource - returns the current exception source.
+*/
+
+extern "C" void * RTExceptions_GetExceptionSource (void)
+{
+ return currentSource;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_RTExceptions_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_RTExceptions_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ TidyUp ();
+}
--- /dev/null
+/* do not edit automatically generated by mc from RTint. */
+/* RTint.mod provides users of the COROUTINES library with the.
+
+Copyright (C) 2009-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _RTint_H
+#define _RTint_C
+
+# include "GM2RTS.h"
+# include "GStorage.h"
+# include "GRTco.h"
+# include "GCOROUTINES.h"
+# include "Glibc.h"
+# include "GAssertion.h"
+# include "GSelective.h"
+
+typedef struct RTint_DispatchVector_p RTint_DispatchVector;
+
+# define Microseconds 1000000
+# define DebugTime 0
+# define Debugging FALSE
+typedef struct RTint__T1_r RTint__T1;
+
+typedef RTint__T1 *RTint_Vector;
+
+typedef struct RTint__T2_a RTint__T2;
+
+typedef enum {RTint_input, RTint_output, RTint_time} RTint_VectorType;
+
+typedef void (*RTint_DispatchVector_t) (unsigned int, unsigned int, void *);
+struct RTint_DispatchVector_p { RTint_DispatchVector_t proc; };
+
+struct RTint__T1_r {
+ RTint_VectorType type;
+ unsigned int priority;
+ void *arg;
+ RTint_Vector pending;
+ RTint_Vector exists;
+ unsigned int no;
+ int File;
+ Selective_Timeval rel;
+ Selective_Timeval abs_;
+ unsigned int queued;
+ };
+
+struct RTint__T2_a { RTint_Vector array[(7)-(COROUTINES_UnassignedPriority)+1]; };
+static unsigned int VecNo;
+static RTint_Vector Exists;
+static RTint__T2 Pending;
+static int lock;
+static unsigned int initialized;
+
+/*
+ InitInputVector - returns an interrupt vector which is associated
+ with the file descriptor, fd.
+*/
+
+extern "C" unsigned int RTint_InitInputVector (int fd, unsigned int pri);
+
+/*
+ InitOutputVector - returns an interrupt vector which is associated
+ with the file descriptor, fd.
+*/
+
+extern "C" unsigned int RTint_InitOutputVector (int fd, unsigned int pri);
+
+/*
+ InitTimeVector - returns an interrupt vector associated with
+ the relative time.
+*/
+
+extern "C" unsigned int RTint_InitTimeVector (unsigned int micro, unsigned int secs, unsigned int pri);
+
+/*
+ ReArmTimeVector - reprimes the vector, vec, to deliver an interrupt
+ at the new relative time.
+*/
+
+extern "C" void RTint_ReArmTimeVector (unsigned int vec, unsigned int micro, unsigned int secs);
+
+/*
+ GetTimeVector - assigns, micro, and, secs, with the remaining
+ time before this interrupt will expire.
+ This value is only updated when a Listen
+ occurs.
+*/
+
+extern "C" void RTint_GetTimeVector (unsigned int vec, unsigned int *micro, unsigned int *secs);
+
+/*
+ AttachVector - adds the pointer ptr to be associated with the interrupt
+ vector. It returns the previous value attached to this
+ vector.
+*/
+
+extern "C" void * RTint_AttachVector (unsigned int vec, void * ptr);
+
+/*
+ IncludeVector - includes, vec, into the dispatcher list of
+ possible interrupt causes.
+*/
+
+extern "C" void RTint_IncludeVector (unsigned int vec);
+
+/*
+ ExcludeVector - excludes, vec, from the dispatcher list of
+ possible interrupt causes.
+*/
+
+extern "C" void RTint_ExcludeVector (unsigned int vec);
+
+/*
+ Listen - will either block indefinitely (until an interrupt)
+ or alteratively will test to see whether any interrupts
+ are pending.
+ If a pending interrupt was found then, call, is called
+ and then this procedure returns.
+ It only listens for interrupts > pri.
+*/
+
+extern "C" void RTint_Listen (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri);
+
+/*
+ Init -
+*/
+
+extern "C" void RTint_Init (void);
+
+/*
+ Max - returns the maximum: i or j.
+*/
+
+static int Max (int i, int j);
+static int Min (int i, int j);
+
+/*
+ FindVector - searches the exists list for a vector of type
+ which is associated with file descriptor, fd.
+*/
+
+static RTint_Vector FindVector (int fd, RTint_VectorType type);
+
+/*
+ FindVectorNo - searches the Exists list for vector vec.
+*/
+
+static RTint_Vector FindVectorNo (unsigned int vec);
+
+/*
+ FindPendingVector - searches the pending list for vector, vec.
+*/
+
+static RTint_Vector FindPendingVector (unsigned int vec);
+
+/*
+ AddFd - adds the file descriptor fd to set updating max.
+*/
+
+static void AddFd (Selective_SetOfFd *set, int *max, int fd);
+
+/*
+ DumpPendingQueue - displays the pending queue.
+*/
+
+static void DumpPendingQueue (void);
+
+/*
+ AddTime - t1 := t1 + t2
+*/
+
+static void AddTime (Selective_Timeval t1, Selective_Timeval t2);
+
+/*
+ IsGreaterEqual - returns TRUE if, a>=b
+*/
+
+static unsigned int IsGreaterEqual (Selective_Timeval a, Selective_Timeval b);
+
+/*
+ SubTime - assigns, s and m, to a - b.
+*/
+
+static void SubTime (unsigned int *s, unsigned int *m, Selective_Timeval a, Selective_Timeval b);
+
+/*
+ activatePending - activates the first interrupt pending and clears it.
+*/
+
+static unsigned int activatePending (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri, int maxFd, Selective_SetOfFd *inSet, Selective_SetOfFd *outSet, Selective_Timeval *timeval, Selective_Timeval b4, Selective_Timeval after);
+
+/*
+ init -
+*/
+
+static void init (void);
+
+
+/*
+ Max - returns the maximum: i or j.
+*/
+
+static int Max (int i, int j)
+{
+ if (i > j)
+ {
+ return i;
+ }
+ else
+ {
+ return j;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+static int Min (int i, int j)
+{
+ /*
+ Max - returns the minimum: i or j.
+ */
+ if (i < j)
+ {
+ return i;
+ }
+ else
+ {
+ return j;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FindVector - searches the exists list for a vector of type
+ which is associated with file descriptor, fd.
+*/
+
+static RTint_Vector FindVector (int fd, RTint_VectorType type)
+{
+ RTint_Vector vec;
+
+ vec = Exists;
+ while (vec != NULL)
+ {
+ if ((vec->type == type) && (vec->File == fd))
+ {
+ return vec;
+ }
+ vec = vec->exists;
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FindVectorNo - searches the Exists list for vector vec.
+*/
+
+static RTint_Vector FindVectorNo (unsigned int vec)
+{
+ RTint_Vector vptr;
+
+ vptr = Exists;
+ while ((vptr != NULL) && (vptr->no != vec))
+ {
+ vptr = vptr->exists;
+ }
+ return vptr;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FindPendingVector - searches the pending list for vector, vec.
+*/
+
+static RTint_Vector FindPendingVector (unsigned int vec)
+{
+ unsigned int pri;
+ RTint_Vector vptr;
+
+ for (pri=COROUTINES_UnassignedPriority; pri<=7; pri++)
+ {
+ vptr = Pending.array[pri-(COROUTINES_UnassignedPriority)];
+ while ((vptr != NULL) && (vptr->no != vec))
+ {
+ vptr = vptr->pending;
+ }
+ if ((vptr != NULL) && (vptr->no == vec))
+ {
+ return vptr;
+ }
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AddFd - adds the file descriptor fd to set updating max.
+*/
+
+static void AddFd (Selective_SetOfFd *set, int *max, int fd)
+{
+ (*max) = Max (fd, (*max));
+ if ((*set) == NULL)
+ {
+ (*set) = Selective_InitSet ();
+ Selective_FdZero ((*set));
+ }
+ /* printf('%d, ', fd) */
+ Selective_FdSet (fd, (*set));
+}
+
+
+/*
+ DumpPendingQueue - displays the pending queue.
+*/
+
+static void DumpPendingQueue (void)
+{
+ COROUTINES_PROTECTION pri;
+ RTint_Vector vptr;
+ unsigned int sec;
+ unsigned int micro;
+
+ libc_printf ((const char *) "Pending queue\\n", 15);
+ for (pri=COROUTINES_UnassignedPriority; pri<=7; pri++)
+ {
+ libc_printf ((const char *) "[%d] ", 6, pri);
+ vptr = Pending.array[pri-(COROUTINES_UnassignedPriority)];
+ while (vptr != NULL)
+ {
+ if ((vptr->type == RTint_input) || (vptr->type == RTint_output))
+ {
+ libc_printf ((const char *) "(fd=%d) (vec=%d)", 16, vptr->File, vptr->no);
+ }
+ else if (vptr->type == RTint_time)
+ {
+ /* avoid dangling else. */
+ Selective_GetTime (vptr->rel, &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ libc_printf ((const char *) "time (%u.%06u secs) (arg = %p)\\n", 32, sec, micro, vptr->arg);
+ }
+ vptr = vptr->pending;
+ }
+ libc_printf ((const char *) " \\n", 3);
+ }
+}
+
+
+/*
+ AddTime - t1 := t1 + t2
+*/
+
+static void AddTime (Selective_Timeval t1, Selective_Timeval t2)
+{
+ unsigned int a;
+ unsigned int b;
+ unsigned int s;
+ unsigned int m;
+
+ Selective_GetTime (t1, &s, &m);
+ Assertion_Assert (m < Microseconds);
+ Selective_GetTime (t2, &a, &b);
+ Assertion_Assert (b < Microseconds);
+ a += s;
+ b += m;
+ if (b >= Microseconds)
+ {
+ b -= Microseconds;
+ a += 1;
+ }
+ Selective_SetTime (t1, a, b);
+}
+
+
+/*
+ IsGreaterEqual - returns TRUE if, a>=b
+*/
+
+static unsigned int IsGreaterEqual (Selective_Timeval a, Selective_Timeval b)
+{
+ unsigned int as;
+ unsigned int am;
+ unsigned int bs;
+ unsigned int bm;
+
+ Selective_GetTime (a, &as, &am);
+ Assertion_Assert (am < Microseconds);
+ Selective_GetTime (b, &bs, &bm);
+ Assertion_Assert (bm < Microseconds);
+ return (as > bs) || ((as == bs) && (am >= bm));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SubTime - assigns, s and m, to a - b.
+*/
+
+static void SubTime (unsigned int *s, unsigned int *m, Selective_Timeval a, Selective_Timeval b)
+{
+ unsigned int as;
+ unsigned int am;
+ unsigned int bs;
+ unsigned int bm;
+
+ Selective_GetTime (a, &as, &am);
+ Assertion_Assert (am < Microseconds);
+ Selective_GetTime (b, &bs, &bm);
+ Assertion_Assert (bm < Microseconds);
+ if (IsGreaterEqual (a, b))
+ {
+ (*s) = as-bs;
+ if (am >= bm)
+ {
+ (*m) = am-bm;
+ Assertion_Assert ((*m) < Microseconds);
+ }
+ else
+ {
+ Assertion_Assert ((*s) > 0);
+ (*s) -= 1;
+ (*m) = (Microseconds+am)-bm;
+ Assertion_Assert ((*m) < Microseconds);
+ }
+ }
+ else
+ {
+ (*s) = 0;
+ (*m) = 0;
+ }
+}
+
+
+/*
+ activatePending - activates the first interrupt pending and clears it.
+*/
+
+static unsigned int activatePending (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri, int maxFd, Selective_SetOfFd *inSet, Selective_SetOfFd *outSet, Selective_Timeval *timeval, Selective_Timeval b4, Selective_Timeval after)
+{
+ int result;
+ unsigned int p;
+ RTint_Vector vec;
+ unsigned int b4s;
+ unsigned int b4m;
+ unsigned int afs;
+ unsigned int afm;
+ unsigned int sec;
+ unsigned int micro;
+
+ RTco_wait (lock);
+ p = static_cast<unsigned int> (7);
+ while (p > pri)
+ {
+ vec = Pending.array[p-(COROUTINES_UnassignedPriority)];
+ while (vec != NULL)
+ {
+ switch (vec->type)
+ {
+ case RTint_input:
+ if (((vec->File < maxFd) && ((*inSet) != NULL)) && (Selective_FdIsSet (vec->File, (*inSet))))
+ {
+ if (Debugging)
+ {
+ libc_printf ((const char *) "read (fd=%d) is ready (vec=%d)\\n", 32, vec->File, vec->no);
+ DumpPendingQueue ();
+ }
+ Selective_FdClr (vec->File, (*inSet)); /* so we dont activate this again from our select. */
+ RTco_signal (lock); /* so we dont activate this again from our select. */
+ (*call.proc) (vec->no, vec->priority, vec->arg);
+ return TRUE;
+ }
+ break;
+
+ case RTint_output:
+ if (((vec->File < maxFd) && ((*outSet) != NULL)) && (Selective_FdIsSet (vec->File, (*outSet))))
+ {
+ if (Debugging)
+ {
+ libc_printf ((const char *) "write (fd=%d) is ready (vec=%d)\\n", 33, vec->File, vec->no);
+ DumpPendingQueue ();
+ }
+ Selective_FdClr (vec->File, (*outSet)); /* so we dont activate this again from our select. */
+ RTco_signal (lock); /* so we dont activate this again from our select. */
+ (*call.proc) (vec->no, vec->priority, vec->arg);
+ return TRUE;
+ }
+ break;
+
+ case RTint_time:
+ if (untilInterrupt && ((*timeval) != NULL))
+ {
+ result = Selective_GetTimeOfDay (after);
+ Assertion_Assert (result == 0);
+ if (Debugging)
+ {
+ Selective_GetTime ((*timeval), &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ Selective_GetTime (after, &afs, &afm);
+ Assertion_Assert (afm < Microseconds);
+ Selective_GetTime (b4, &b4s, &b4m);
+ Assertion_Assert (b4m < Microseconds);
+ libc_printf ((const char *) "waited %u.%06u + %u.%06u now is %u.%06u\\n", 41, sec, micro, b4s, b4m, afs, afm);
+ }
+ if (IsGreaterEqual (after, vec->abs_))
+ {
+ if (Debugging)
+ {
+ DumpPendingQueue ();
+ libc_printf ((const char *) "time has expired calling dispatcher\\n", 37);
+ }
+ (*timeval) = Selective_KillTime ((*timeval)); /* so we dont activate this again from our select. */
+ RTco_signal (lock); /* so we dont activate this again from our select. */
+ if (Debugging)
+ {
+ libc_printf ((const char *) "call (%d, %d, 0x%x)\\n", 21, vec->no, vec->priority, vec->arg);
+ }
+ (*call.proc) (vec->no, vec->priority, vec->arg);
+ return TRUE;
+ }
+ else if (Debugging)
+ {
+ /* avoid dangling else. */
+ libc_printf ((const char *) "must wait longer as time has not expired\\n", 42);
+ }
+ }
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ __builtin_unreachable ();
+ }
+ vec = vec->pending;
+ }
+ p -= 1;
+ }
+ RTco_signal (lock);
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ init -
+*/
+
+static void init (void)
+{
+ COROUTINES_PROTECTION p;
+
+ lock = RTco_initSemaphore (1);
+ RTco_wait (lock);
+ Exists = NULL;
+ for (p=COROUTINES_UnassignedPriority; p<=7; p++)
+ {
+ Pending.array[p-(COROUTINES_UnassignedPriority)] = NULL;
+ }
+ initialized = TRUE;
+ RTco_signal (lock);
+}
+
+
+/*
+ InitInputVector - returns an interrupt vector which is associated
+ with the file descriptor, fd.
+*/
+
+extern "C" unsigned int RTint_InitInputVector (int fd, unsigned int pri)
+{
+ RTint_Vector vptr;
+
+ if (Debugging)
+ {
+ libc_printf ((const char *) "InitInputVector fd = %d priority = %d\\n", 39, fd, pri);
+ }
+ RTco_wait (lock);
+ vptr = FindVector (fd, RTint_input);
+ if (vptr == NULL)
+ {
+ Storage_ALLOCATE ((void **) &vptr, sizeof (RTint__T1));
+ VecNo += 1;
+ vptr->type = RTint_input;
+ vptr->priority = pri;
+ vptr->arg = NULL;
+ vptr->pending = NULL;
+ vptr->exists = Exists;
+ vptr->no = VecNo;
+ vptr->File = fd;
+ Exists = vptr;
+ RTco_signal (lock);
+ return VecNo;
+ }
+ else
+ {
+ RTco_signal (lock);
+ return vptr->no;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitOutputVector - returns an interrupt vector which is associated
+ with the file descriptor, fd.
+*/
+
+extern "C" unsigned int RTint_InitOutputVector (int fd, unsigned int pri)
+{
+ RTint_Vector vptr;
+
+ RTco_wait (lock);
+ vptr = FindVector (fd, RTint_output);
+ if (vptr == NULL)
+ {
+ Storage_ALLOCATE ((void **) &vptr, sizeof (RTint__T1));
+ if (vptr == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ VecNo += 1;
+ vptr->type = RTint_output;
+ vptr->priority = pri;
+ vptr->arg = NULL;
+ vptr->pending = NULL;
+ vptr->exists = Exists;
+ vptr->no = VecNo;
+ vptr->File = fd;
+ Exists = vptr;
+ RTco_signal (lock);
+ return VecNo;
+ }
+ }
+ else
+ {
+ RTco_signal (lock);
+ return vptr->no;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitTimeVector - returns an interrupt vector associated with
+ the relative time.
+*/
+
+extern "C" unsigned int RTint_InitTimeVector (unsigned int micro, unsigned int secs, unsigned int pri)
+{
+ RTint_Vector vptr;
+
+ RTco_wait (lock);
+ Storage_ALLOCATE ((void **) &vptr, sizeof (RTint__T1));
+ if (vptr == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ VecNo += 1;
+ Assertion_Assert (micro < Microseconds);
+ vptr->type = RTint_time;
+ vptr->priority = pri;
+ vptr->arg = NULL;
+ vptr->pending = NULL;
+ vptr->exists = Exists;
+ vptr->no = VecNo;
+ vptr->rel = Selective_InitTime (secs+DebugTime, micro);
+ vptr->abs_ = Selective_InitTime (0, 0);
+ vptr->queued = FALSE;
+ Exists = vptr;
+ }
+ RTco_signal (lock);
+ return VecNo;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ReArmTimeVector - reprimes the vector, vec, to deliver an interrupt
+ at the new relative time.
+*/
+
+extern "C" void RTint_ReArmTimeVector (unsigned int vec, unsigned int micro, unsigned int secs)
+{
+ RTint_Vector vptr;
+
+ Assertion_Assert (micro < Microseconds);
+ RTco_wait (lock);
+ vptr = FindVectorNo (vec);
+ if (vptr == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 286, (const char *) "ReArmTimeVector", 15, (const char *) "cannot find vector supplied", 27);
+ }
+ else
+ {
+ Selective_SetTime (vptr->rel, secs+DebugTime, micro);
+ }
+ RTco_signal (lock);
+}
+
+
+/*
+ GetTimeVector - assigns, micro, and, secs, with the remaining
+ time before this interrupt will expire.
+ This value is only updated when a Listen
+ occurs.
+*/
+
+extern "C" void RTint_GetTimeVector (unsigned int vec, unsigned int *micro, unsigned int *secs)
+{
+ RTint_Vector vptr;
+
+ RTco_wait (lock);
+ vptr = FindVectorNo (vec);
+ if (vptr == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 312, (const char *) "GetTimeVector", 13, (const char *) "cannot find vector supplied", 27);
+ }
+ else
+ {
+ Selective_GetTime (vptr->rel, secs, micro);
+ Assertion_Assert ((*micro) < Microseconds);
+ }
+ RTco_signal (lock);
+}
+
+
+/*
+ AttachVector - adds the pointer ptr to be associated with the interrupt
+ vector. It returns the previous value attached to this
+ vector.
+*/
+
+extern "C" void * RTint_AttachVector (unsigned int vec, void * ptr)
+{
+ RTint_Vector vptr;
+ void * prevArg;
+
+ RTco_wait (lock);
+ vptr = FindVectorNo (vec);
+ if (vptr == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 339, (const char *) "AttachVector", 12, (const char *) "cannot find vector supplied", 27);
+ }
+ else
+ {
+ prevArg = vptr->arg;
+ vptr->arg = ptr;
+ if (Debugging)
+ {
+ libc_printf ((const char *) "AttachVector %d with %p\\n", 25, vec, ptr);
+ DumpPendingQueue ();
+ }
+ RTco_signal (lock);
+ return prevArg;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ IncludeVector - includes, vec, into the dispatcher list of
+ possible interrupt causes.
+*/
+
+extern "C" void RTint_IncludeVector (unsigned int vec)
+{
+ RTint_Vector vptr;
+ unsigned int micro;
+ unsigned int sec;
+ int result;
+
+ RTco_wait (lock);
+ vptr = FindPendingVector (vec);
+ if (vptr == NULL)
+ {
+ /* avoid dangling else. */
+ vptr = FindVectorNo (vec);
+ if (vptr == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 372, (const char *) "IncludeVector", 13, (const char *) "cannot find vector supplied", 27);
+ }
+ else
+ {
+ /* printf('including vector %d (fd = %d)
+ ', vec, v^.File) ; */
+ vptr->pending = Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)];
+ Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)] = vptr;
+ if ((vptr->type == RTint_time) && ! vptr->queued)
+ {
+ vptr->queued = TRUE;
+ result = Selective_GetTimeOfDay (vptr->abs_);
+ Assertion_Assert (result == 0);
+ Selective_GetTime (vptr->abs_, &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ AddTime (vptr->abs_, vptr->rel);
+ Selective_GetTime (vptr->abs_, &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ }
+ }
+ }
+ else
+ {
+ if (Debugging)
+ {
+ libc_printf ((const char *) "odd vector (%d) type (%d) arg (%p) is already attached to the pending queue\\n", 77, vec, vptr->type, vptr->arg);
+ }
+ }
+ RTco_signal (lock);
+}
+
+
+/*
+ ExcludeVector - excludes, vec, from the dispatcher list of
+ possible interrupt causes.
+*/
+
+extern "C" void RTint_ExcludeVector (unsigned int vec)
+{
+ RTint_Vector vptr;
+ RTint_Vector uptr;
+
+ RTco_wait (lock);
+ vptr = FindPendingVector (vec);
+ if (vptr == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 414, (const char *) "ExcludeVector", 13, (const char *) "cannot find pending vector supplied", 35);
+ }
+ else
+ {
+ /* printf('excluding vector %d
+ ', vec) ; */
+ if (Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)] == vptr)
+ {
+ Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)] = Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)]->pending;
+ }
+ else
+ {
+ uptr = Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)];
+ while (uptr->pending != vptr)
+ {
+ uptr = uptr->pending;
+ }
+ uptr->pending = vptr->pending;
+ }
+ if (vptr->type == RTint_time)
+ {
+ vptr->queued = FALSE;
+ }
+ }
+ RTco_signal (lock);
+}
+
+
+/*
+ Listen - will either block indefinitely (until an interrupt)
+ or alteratively will test to see whether any interrupts
+ are pending.
+ If a pending interrupt was found then, call, is called
+ and then this procedure returns.
+ It only listens for interrupts > pri.
+*/
+
+extern "C" void RTint_Listen (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri)
+{
+ unsigned int found;
+ int result;
+ Selective_Timeval after;
+ Selective_Timeval b4;
+ Selective_Timeval timeval;
+ RTint_Vector vec;
+ Selective_SetOfFd inSet;
+ Selective_SetOfFd outSet;
+ unsigned int b4s;
+ unsigned int b4m;
+ unsigned int afs;
+ unsigned int afm;
+ unsigned int sec;
+ unsigned int micro;
+ int maxFd;
+ unsigned int p;
+
+ RTco_wait (lock);
+ if (pri < (7))
+ {
+ if (Debugging)
+ {
+ DumpPendingQueue ();
+ }
+ maxFd = -1;
+ timeval = NULL;
+ inSet = NULL;
+ outSet = NULL;
+ timeval = Selective_InitTime (static_cast<unsigned int> (INT_MAX), 0);
+ p = static_cast<unsigned int> (7);
+ found = FALSE;
+ while (p > pri)
+ {
+ vec = Pending.array[p-(COROUTINES_UnassignedPriority)];
+ while (vec != NULL)
+ {
+ switch (vec->type)
+ {
+ case RTint_input:
+ AddFd (&inSet, &maxFd, vec->File);
+ break;
+
+ case RTint_output:
+ AddFd (&outSet, &maxFd, vec->File);
+ break;
+
+ case RTint_time:
+ if (IsGreaterEqual (timeval, vec->abs_))
+ {
+ Selective_GetTime (vec->abs_, &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ if (Debugging)
+ {
+ libc_printf ((const char *) "shortest delay is %u.%06u\\n", 27, sec, micro);
+ }
+ Selective_SetTime (timeval, sec, micro);
+ found = TRUE;
+ }
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ __builtin_unreachable ();
+ }
+ vec = vec->pending;
+ }
+ p -= 1;
+ }
+ if (! untilInterrupt)
+ {
+ Selective_SetTime (timeval, 0, 0);
+ }
+ if (((untilInterrupt && (inSet == NULL)) && (outSet == NULL)) && ! found)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 730, (const char *) "Listen", 6, (const char *) "deadlock found, no more processes to run and no interrupts active", 65);
+ }
+ /* printf('}
+ ') ; */
+ if (((! found && (maxFd == -1)) && (inSet == NULL)) && (outSet == NULL))
+ {
+ /* no file descriptors to be selected upon. */
+ timeval = Selective_KillTime (timeval);
+ RTco_signal (lock);
+ return ;
+ }
+ else
+ {
+ Selective_GetTime (timeval, &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ b4 = Selective_InitTime (0, 0);
+ after = Selective_InitTime (0, 0);
+ result = Selective_GetTimeOfDay (b4);
+ Assertion_Assert (result == 0);
+ SubTime (&sec, µ, timeval, b4);
+ Selective_SetTime (timeval, sec, micro);
+ if (Debugging)
+ {
+ libc_printf ((const char *) "select waiting for %u.%06u seconds\\n", 36, sec, micro);
+ }
+ RTco_signal (lock);
+ do {
+ if (Debugging)
+ {
+ libc_printf ((const char *) "select (.., .., .., %u.%06u)\\n", 30, sec, micro);
+ }
+ result = RTco_select (maxFd+1, inSet, outSet, NULL, timeval);
+ if (result == -1)
+ {
+ libc_perror ((const char *) "select", 6);
+ result = RTco_select (maxFd+1, inSet, outSet, NULL, NULL);
+ if (result == -1)
+ {
+ libc_perror ((const char *) "select timeout argument is faulty", 33);
+ }
+ result = RTco_select (maxFd+1, inSet, NULL, NULL, timeval);
+ if (result == -1)
+ {
+ libc_perror ((const char *) "select output fd argument is faulty", 35);
+ }
+ result = RTco_select (maxFd+1, NULL, outSet, NULL, timeval);
+ if (result == -1)
+ {
+ libc_perror ((const char *) "select input fd argument is faulty", 34);
+ }
+ else
+ {
+ libc_perror ((const char *) "select maxFD+1 argument is faulty", 33);
+ }
+ }
+ } while (! (result != -1));
+ }
+ while (activatePending (untilInterrupt, call, pri, maxFd+1, &inSet, &outSet, &timeval, b4, after))
+ {} /* empty. */
+ if (timeval != NULL)
+ {
+ timeval = Selective_KillTime (timeval);
+ }
+ if (after != NULL)
+ {
+ after = Selective_KillTime (after);
+ }
+ if (b4 != NULL)
+ {
+ b4 = Selective_KillTime (b4);
+ }
+ if (inSet != NULL)
+ {
+ inSet = Selective_KillSet (inSet);
+ }
+ if (outSet != NULL)
+ {
+ outSet = Selective_KillSet (outSet);
+ }
+ }
+ RTco_signal (lock);
+}
+
+
+/*
+ Init -
+*/
+
+extern "C" void RTint_Init (void)
+{
+ if (! initialized)
+ {
+ init ();
+ }
+}
+
+extern "C" void _M2_RTint_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ RTint_Init ();
+}
+
+extern "C" void _M2_RTint_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from SArgs. */
+/* SArgs.mod provides a String interface to the command line arguments.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _SArgs_H
+#define _SArgs_C
+
+# include "GSYSTEM.h"
+# include "GUnixArgs.h"
+# include "GDynamicStrings.h"
+
+typedef char *SArgs_PtrToChar;
+
+typedef SArgs_PtrToChar *SArgs_PtrToPtrToChar;
+
+
+/*
+ GetArg - returns the nth argument from the command line.
+ The success of the operation is returned.
+ If TRUE is returned then the string, s, contains a
+ new string, otherwise s is set to NIL.
+*/
+
+extern "C" unsigned int SArgs_GetArg (DynamicStrings_String *s, unsigned int n);
+
+/*
+ Narg - returns the number of arguments available from
+ command line.
+*/
+
+extern "C" unsigned int SArgs_Narg (void);
+
+
+/*
+ GetArg - returns the nth argument from the command line.
+ The success of the operation is returned.
+ If TRUE is returned then the string, s, contains a
+ new string, otherwise s is set to NIL.
+*/
+
+extern "C" unsigned int SArgs_GetArg (DynamicStrings_String *s, unsigned int n)
+{
+ int i;
+ SArgs_PtrToPtrToChar ppc;
+
+ i = (int ) (n);
+ if (i < (UnixArgs_GetArgC ()))
+ {
+ /* ppc := ADDRESS (VAL (PtrToPtrToChar, ArgV) + (i * CARDINAL (TSIZE(PtrToChar)))) ; */
+ ppc = static_cast<SArgs_PtrToPtrToChar> ((void *) (((SArgs_PtrToChar) (UnixArgs_GetArgV ()))+(n*sizeof (SArgs_PtrToChar))));
+ (*s) = DynamicStrings_InitStringCharStar (reinterpret_cast<void *> ((*ppc)));
+ return TRUE;
+ }
+ else
+ {
+ (*s) = static_cast<DynamicStrings_String> (NULL);
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Narg - returns the number of arguments available from
+ command line.
+*/
+
+extern "C" unsigned int SArgs_Narg (void)
+{
+ return UnixArgs_GetArgC ();
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_SArgs_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_SArgs_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from SFIO. */
+/* SFIO.mod provides a String interface to the opening routines of FIO.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _SFIO_H
+#define _SFIO_C
+
+# include "GASCII.h"
+# include "GDynamicStrings.h"
+# include "GFIO.h"
+
+
+/*
+ Exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname);
+
+/*
+ OpenToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname);
+
+/*
+ OpenToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname);
+
+/*
+ OpenForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+ if towrite is TRUE or whether the previous file should
+ be left alone, allowing this descriptor to seek
+ and modify an existing file.
+*/
+
+extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile);
+
+/*
+ WriteS - writes a string, s, to, file. It returns the String, s.
+*/
+
+extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s);
+
+/*
+ ReadS - reads and returns a string from, file.
+ It stops reading the string at the end of line or end of file.
+ It consumes the newline at the end of line but does not place
+ this into the returned string.
+*/
+
+extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file);
+
+
+/*
+ Exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname)
+{
+ return FIO_exists (DynamicStrings_string (fname), DynamicStrings_Length (fname));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OpenToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname)
+{
+ return FIO_openToRead (DynamicStrings_string (fname), DynamicStrings_Length (fname));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OpenToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname)
+{
+ return FIO_openToWrite (DynamicStrings_string (fname), DynamicStrings_Length (fname));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OpenForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+ if towrite is TRUE or whether the previous file should
+ be left alone, allowing this descriptor to seek
+ and modify an existing file.
+*/
+
+extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile)
+{
+ return FIO_openForRandom (DynamicStrings_string (fname), DynamicStrings_Length (fname), towrite, newfile);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteS - writes a string, s, to, file. It returns the String, s.
+*/
+
+extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s)
+{
+ unsigned int nBytes;
+
+ if (s != NULL)
+ {
+ nBytes = FIO_WriteNBytes (file, DynamicStrings_Length (s), DynamicStrings_string (s));
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ReadS - reads and returns a string from, file.
+ It stops reading the string at the end of line or end of file.
+ It consumes the newline at the end of line but does not place
+ this into the returned string.
+*/
+
+extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file)
+{
+ DynamicStrings_String s;
+ unsigned int c;
+
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ while (((! (FIO_EOLN (file))) && (! (FIO_EOF (file)))) && (FIO_IsNoError (file)))
+ {
+ s = DynamicStrings_ConCatChar (s, FIO_ReadChar (file));
+ }
+ if (FIO_EOLN (file))
+ {
+ /* consume nl */
+ if ((FIO_ReadChar (file)) == ASCII_nul)
+ {} /* empty. */
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_SFIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_SFIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from StdIO. */
+/* StdIO.mod provides general Read and Write procedures.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# include "Gmcrts.h"
+#define _StdIO_H
+#define _StdIO_C
+
+# include "GIO.h"
+# include "GM2RTS.h"
+
+typedef struct StdIO_ProcWrite_p StdIO_ProcWrite;
+
+typedef struct StdIO_ProcRead_p StdIO_ProcRead;
+
+# define MaxStack 40
+typedef struct StdIO__T1_a StdIO__T1;
+
+typedef struct StdIO__T2_a StdIO__T2;
+
+typedef void (*StdIO_ProcWrite_t) (char);
+struct StdIO_ProcWrite_p { StdIO_ProcWrite_t proc; };
+
+typedef void (*StdIO_ProcRead_t) (char *);
+struct StdIO_ProcRead_p { StdIO_ProcRead_t proc; };
+
+struct StdIO__T1_a { StdIO_ProcWrite array[MaxStack+1]; };
+struct StdIO__T2_a { StdIO_ProcRead array[MaxStack+1]; };
+static StdIO__T1 StackW;
+static unsigned int StackWPtr;
+static StdIO__T2 StackR;
+static unsigned int StackRPtr;
+
+/*
+ Read - is the generic procedure that all higher application layers
+ should use to receive a character.
+*/
+
+extern "C" void StdIO_Read (char *ch);
+
+/*
+ Write - is the generic procedure that all higher application layers
+ should use to emit a character.
+*/
+
+extern "C" void StdIO_Write (char ch);
+
+/*
+ PushOutput - pushes the current Write procedure onto a stack,
+ any future references to Write will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushOutput (StdIO_ProcWrite p);
+
+/*
+ PopOutput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopOutput (void);
+
+/*
+ GetCurrentOutput - returns the current output procedure.
+*/
+
+extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void);
+
+/*
+ PushInput - pushes the current Read procedure onto a stack,
+ any future references to Read will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushInput (StdIO_ProcRead p);
+
+/*
+ PopInput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopInput (void);
+
+/*
+ GetCurrentInput - returns the current input procedure.
+*/
+
+extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void);
+
+
+/*
+ Read - is the generic procedure that all higher application layers
+ should use to receive a character.
+*/
+
+extern "C" void StdIO_Read (char *ch)
+{
+ (*StackR.array[StackRPtr].proc) (ch);
+}
+
+
+/*
+ Write - is the generic procedure that all higher application layers
+ should use to emit a character.
+*/
+
+extern "C" void StdIO_Write (char ch)
+{
+ (*StackW.array[StackWPtr].proc) (ch);
+}
+
+
+/*
+ PushOutput - pushes the current Write procedure onto a stack,
+ any future references to Write will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushOutput (StdIO_ProcWrite p)
+{
+ if (StackWPtr == MaxStack)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackWPtr += 1;
+ StackW.array[StackWPtr] = p;
+ }
+}
+
+
+/*
+ PopOutput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopOutput (void)
+{
+ if (StackWPtr == 1)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackWPtr -= 1;
+ }
+}
+
+
+/*
+ GetCurrentOutput - returns the current output procedure.
+*/
+
+extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void)
+{
+ if (StackWPtr > 0)
+ {
+ return StackW.array[StackWPtr];
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ PushInput - pushes the current Read procedure onto a stack,
+ any future references to Read will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushInput (StdIO_ProcRead p)
+{
+ if (StackRPtr == MaxStack)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackRPtr += 1;
+ StackR.array[StackRPtr] = p;
+ }
+}
+
+
+/*
+ PopInput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopInput (void)
+{
+ if (StackRPtr == 1)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackRPtr -= 1;
+ }
+}
+
+
+/*
+ GetCurrentInput - returns the current input procedure.
+*/
+
+extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void)
+{
+ if (StackRPtr > 0)
+ {
+ return StackR.array[StackRPtr];
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_StdIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ StackWPtr = 0;
+ StackRPtr = 0;
+ StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) IO_Write});
+ StdIO_PushInput ((StdIO_ProcRead) {(StdIO_ProcRead_t) IO_Read});
+}
+
+extern "C" void _M2_StdIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Storage. */
+/* Storage.mod provides access to the dynamic Storage handler.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Storage_H
+#define _Storage_C
+
+# include "GSysStorage.h"
+
+extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size);
+extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size);
+extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size);
+extern "C" unsigned int Storage_Available (unsigned int Size);
+
+extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size)
+{
+ SysStorage_ALLOCATE (a, Size);
+}
+
+extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size)
+{
+ SysStorage_DEALLOCATE (a, Size);
+}
+
+extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size)
+{
+ SysStorage_REALLOCATE (a, Size);
+}
+
+extern "C" unsigned int Storage_Available (unsigned int Size)
+{
+ return SysStorage_Available (Size);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_Storage_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Storage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from StrCase. */
+/* StrCase.mod provides procedure to convert between text case.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _StrCase_H
+#define _StrCase_C
+
+# include "GASCII.h"
+# include "GStrLib.h"
+
+
+/*
+ StrToUpperCase - converts string, a, to uppercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToUpperCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+
+/*
+ StrToLowerCase - converts string, a, to lowercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToLowerCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+
+/*
+ Cap - converts a lower case character into a capital character.
+ If the character is not a lower case character 'a'..'z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Cap (char ch);
+
+/*
+ Lower - converts an upper case character into a lower case character.
+ If the character is not an upper case character 'A'..'Z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Lower (char ch);
+
+
+/*
+ StrToUpperCase - converts string, a, to uppercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToUpperCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high)
+{
+ unsigned int higha;
+ unsigned int highb;
+ unsigned int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ highb = _b_high;
+ i = 0;
+ while (((i < higha) && (a[i] != ASCII_nul)) && (i < highb))
+ {
+ b[i] = StrCase_Cap (a[i]);
+ i += 1;
+ }
+ if (i < highb)
+ {
+ b[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ StrToLowerCase - converts string, a, to lowercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToLowerCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high)
+{
+ unsigned int higha;
+ unsigned int highb;
+ unsigned int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ highb = _b_high;
+ i = 0;
+ while (((i < higha) && (a[i] != ASCII_nul)) && (i < highb))
+ {
+ b[i] = StrCase_Lower (a[i]);
+ i += 1;
+ }
+ if (i < highb)
+ {
+ b[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ Cap - converts a lower case character into a capital character.
+ If the character is not a lower case character 'a'..'z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Cap (char ch)
+{
+ if ((ch >= 'a') && (ch <= 'z'))
+ {
+ ch = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('a')))+ ((unsigned int) ('A'))));
+ }
+ return ch;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Lower - converts an upper case character into a lower case character.
+ If the character is not an upper case character 'A'..'Z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Lower (char ch)
+{
+ if ((ch >= 'A') && (ch <= 'Z'))
+ {
+ ch = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))));
+ }
+ return ch;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_StrCase_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_StrCase_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from StrIO. */
+/* StrIO.mod provides simple string input output routines.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#define _StrIO_H
+#define _StrIO_C
+
+# include "GASCII.h"
+# include "GStdIO.h"
+# include "Glibc.h"
+
+static unsigned int IsATTY;
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+extern "C" void StrIO_WriteLn (void);
+
+/*
+ ReadString - reads a sequence of characters into a string.
+ Line editing accepts Del, Ctrl H, Ctrl W and
+ Ctrl U.
+*/
+
+extern "C" void StrIO_ReadString (char *a, unsigned int _a_high);
+
+/*
+ WriteString - writes a string to the default output.
+*/
+
+extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high);
+
+/*
+ Erase - writes a backspace, space and backspace to remove the
+ last character displayed.
+*/
+
+static void Erase (void);
+
+/*
+ Echo - echos the character, ch, onto the output channel if IsATTY
+ is true.
+*/
+
+static void Echo (char ch);
+
+/*
+ AlphaNum- returns true if character, ch, is an alphanumeric character.
+*/
+
+static unsigned int AlphaNum (char ch);
+
+
+/*
+ Erase - writes a backspace, space and backspace to remove the
+ last character displayed.
+*/
+
+static void Erase (void)
+{
+ Echo (ASCII_bs);
+ Echo (' ');
+ Echo (ASCII_bs);
+}
+
+
+/*
+ Echo - echos the character, ch, onto the output channel if IsATTY
+ is true.
+*/
+
+static void Echo (char ch)
+{
+ if (IsATTY)
+ {
+ StdIO_Write (ch);
+ }
+}
+
+
+/*
+ AlphaNum- returns true if character, ch, is an alphanumeric character.
+*/
+
+static unsigned int AlphaNum (char ch)
+{
+ return (((ch >= 'a') && (ch <= 'z')) || ((ch >= 'A') && (ch <= 'Z'))) || ((ch >= '0') && (ch <= '9'));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+extern "C" void StrIO_WriteLn (void)
+{
+ Echo (ASCII_cr);
+ StdIO_Write (ASCII_lf);
+}
+
+
+/*
+ ReadString - reads a sequence of characters into a string.
+ Line editing accepts Del, Ctrl H, Ctrl W and
+ Ctrl U.
+*/
+
+extern "C" void StrIO_ReadString (char *a, unsigned int _a_high)
+{
+ unsigned int n;
+ unsigned int high;
+ char ch;
+
+ high = _a_high;
+ n = 0;
+ do {
+ StdIO_Read (&ch);
+ if ((ch == ASCII_del) || (ch == ASCII_bs))
+ {
+ if (n == 0)
+ {
+ StdIO_Write (ASCII_bel);
+ }
+ else
+ {
+ Erase ();
+ n -= 1;
+ }
+ }
+ else if (ch == ASCII_nak)
+ {
+ /* avoid dangling else. */
+ while (n > 0)
+ {
+ Erase ();
+ n -= 1;
+ }
+ }
+ else if (ch == ASCII_etb)
+ {
+ /* avoid dangling else. */
+ if (n == 0)
+ {
+ Echo (ASCII_bel);
+ }
+ else if (AlphaNum (a[n-1]))
+ {
+ /* avoid dangling else. */
+ do {
+ Erase ();
+ n -= 1;
+ } while (! ((n == 0) || (! (AlphaNum (a[n-1])))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ Erase ();
+ n -= 1;
+ }
+ }
+ else if (n <= high)
+ {
+ /* avoid dangling else. */
+ if ((ch == ASCII_cr) || (ch == ASCII_lf))
+ {
+ a[n] = ASCII_nul;
+ n += 1;
+ }
+ else if (ch == ASCII_ff)
+ {
+ /* avoid dangling else. */
+ a[0] = ch;
+ if (high > 0)
+ {
+ a[1] = ASCII_nul;
+ }
+ ch = ASCII_cr;
+ }
+ else if (ch >= ' ')
+ {
+ /* avoid dangling else. */
+ Echo (ch);
+ a[n] = ch;
+ n += 1;
+ }
+ else if (ch == ASCII_eof)
+ {
+ /* avoid dangling else. */
+ a[n] = ch;
+ n += 1;
+ ch = ASCII_cr;
+ if (n <= high)
+ {
+ a[n] = ASCII_nul;
+ }
+ }
+ }
+ else if (ch != ASCII_cr)
+ {
+ /* avoid dangling else. */
+ Echo (ASCII_bel);
+ }
+ } while (! ((ch == ASCII_cr) || (ch == ASCII_lf)));
+}
+
+
+/*
+ WriteString - writes a string to the default output.
+*/
+
+extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high)
+{
+ unsigned int n;
+ unsigned int high;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ high = _a_high;
+ n = 0;
+ while ((n <= high) && (a[n] != ASCII_nul))
+ {
+ StdIO_Write (a[n]);
+ n += 1;
+ }
+}
+
+extern "C" void _M2_StrIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ /* IsATTY := isatty() */
+ IsATTY = FALSE;
+}
+
+extern "C" void _M2_StrIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from StrLib. */
+/* StrLib.mod provides string manipulation procedures.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#define _StrLib_H
+#define _StrLib_C
+
+# include "GASCII.h"
+
+
+/*
+ StrConCat - combines a and b into c.
+*/
+
+extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high);
+
+/*
+ StrLess - returns TRUE if string, a, alphabetically occurs before
+ string, b.
+*/
+
+extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high);
+
+/*
+ StrCopy - copy string src into string dest providing dest is large enough.
+ If dest is smaller than a then src then the string is truncated when
+ dest is full. Add a nul character if there is room in dest.
+*/
+
+extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high);
+
+/*
+ IsSubString - returns true if b is a subcomponent of a.
+*/
+
+extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+
+/*
+ StrRemoveWhitePrefix - copies string, into string, b, excluding any white
+ space infront of a.
+*/
+
+extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch);
+
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch)
+{
+ return (ch == ' ') || (ch == ASCII_tab);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StrConCat - combines a and b into c.
+*/
+
+extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high)
+{
+ unsigned int Highb;
+ unsigned int Highc;
+ unsigned int i;
+ unsigned int j;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ Highb = StrLib_StrLen ((const char *) b, _b_high);
+ Highc = _c_high;
+ StrLib_StrCopy ((const char *) a, _a_high, (char *) c, _c_high);
+ i = StrLib_StrLen ((const char *) c, _c_high);
+ j = 0;
+ while ((j < Highb) && (i <= Highc))
+ {
+ c[i] = b[j];
+ i += 1;
+ j += 1;
+ }
+ if (i <= Highc)
+ {
+ c[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ StrLess - returns TRUE if string, a, alphabetically occurs before
+ string, b.
+*/
+
+extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high)
+{
+ unsigned int Higha;
+ unsigned int Highb;
+ unsigned int i;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ Higha = StrLib_StrLen ((const char *) a, _a_high);
+ Highb = StrLib_StrLen ((const char *) b, _b_high);
+ i = 0;
+ while ((i < Higha) && (i < Highb))
+ {
+ if (a[i] < b[i])
+ {
+ return TRUE;
+ }
+ else if (a[i] > b[i])
+ {
+ /* avoid dangling else. */
+ return FALSE;
+ }
+ /* must be equal, move on to next character */
+ i += 1;
+ }
+ return Higha < Highb; /* substrings are equal so we go on length */
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned int higha;
+ unsigned int highb;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ higha = _a_high;
+ highb = _b_high;
+ i = 0;
+ while ((((i <= higha) && (i <= highb)) && (a[i] != ASCII_nul)) && (b[i] != ASCII_nul))
+ {
+ if (a[i] != b[i])
+ {
+ return FALSE;
+ }
+ i += 1;
+ }
+ return ! (((i <= higha) && (a[i] != ASCII_nul)) || ((i <= highb) && (b[i] != ASCII_nul)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high)
+{
+ unsigned int High;
+ unsigned int Len;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ Len = 0;
+ High = _a_high;
+ while ((Len <= High) && (a[Len] != ASCII_nul))
+ {
+ Len += 1;
+ }
+ return Len;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StrCopy - copy string src into string dest providing dest is large enough.
+ If dest is smaller than a then src then the string is truncated when
+ dest is full. Add a nul character if there is room in dest.
+*/
+
+extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high)
+{
+ unsigned int HighSrc;
+ unsigned int HighDest;
+ unsigned int n;
+ char src[_src_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (src, src_, _src_high+1);
+
+ n = 0;
+ HighSrc = StrLib_StrLen ((const char *) src, _src_high);
+ HighDest = _dest_high;
+ while ((n < HighSrc) && (n <= HighDest))
+ {
+ dest[n] = src[n];
+ n += 1;
+ }
+ if (n <= HighDest)
+ {
+ dest[n] = ASCII_nul;
+ }
+}
+
+
+/*
+ IsSubString - returns true if b is a subcomponent of a.
+*/
+
+extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned int j;
+ unsigned int LengthA;
+ unsigned int LengthB;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ LengthA = StrLib_StrLen ((const char *) a, _a_high);
+ LengthB = StrLib_StrLen ((const char *) b, _b_high);
+ i = 0;
+ if (LengthA > LengthB)
+ {
+ while (i <= (LengthA-LengthB))
+ {
+ j = 0;
+ while ((j < LengthB) && (a[i+j] == b[j]))
+ {
+ j += 1;
+ }
+ if (j == LengthB)
+ {
+ return TRUE;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StrRemoveWhitePrefix - copies string, into string, b, excluding any white
+ space infront of a.
+*/
+
+extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned int j;
+ unsigned int higha;
+ unsigned int highb;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = 0;
+ j = 0;
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ highb = _b_high;
+ while ((i < higha) && (IsWhite (a[i])))
+ {
+ i += 1;
+ }
+ while ((i < higha) && (j <= highb))
+ {
+ b[j] = a[i];
+ i += 1;
+ j += 1;
+ }
+ if (j <= highb)
+ {
+ b[j] = ASCII_nul;
+ }
+}
+
+extern "C" void _M2_StrLib_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_StrLib_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from StringConvert. */
+/* StringConvert.mod provides functions to convert numbers to and from strings.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _StringConvert_H
+#define _StringConvert_C
+
+# include "GSYSTEM.h"
+# include "Glibc.h"
+# include "Glibm.h"
+# include "GM2RTS.h"
+# include "GDynamicStrings.h"
+# include "Gldtoa.h"
+# include "Gdtoa.h"
+
+
+/*
+ IntegerToString - converts INTEGER, i, into a String. The field with can be specified
+ if non zero. Leading characters are defined by padding and this
+ function will prepend a + if sign is set to TRUE.
+ The base allows the caller to generate binary, octal, decimal, hexidecimal
+ numbers. The value of lower is only used when hexidecimal numbers are
+ generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF
+ are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_IntegerToString (int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower);
+
+/*
+ CardinalToString - converts CARDINAL, c, into a String. The field with can be specified
+ if non zero. Leading characters are defined by padding.
+ The base allows the caller to generate binary, octal, decimal, hexidecimal
+ numbers. The value of lower is only used when hexidecimal numbers are
+ generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF
+ are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_CardinalToString (unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower);
+
+/*
+ StringToInteger - converts a string, s, of, base, into an INTEGER.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" int StringConvert_StringToInteger (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+ StringToCardinal - converts a string, s, of, base, into a CARDINAL.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" unsigned int StringConvert_StringToCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+ LongIntegerToString - converts LONGINT, i, into a String. The field with
+ can be specified if non zero. Leading characters
+ are defined by padding and this function will
+ prepend a + if sign is set to TRUE.
+ The base allows the caller to generate binary,
+ octal, decimal, hexidecimal numbers.
+ The value of lower is only used when hexidecimal
+ numbers are generated and if TRUE then digits
+ abcdef are used, and if FALSE then ABCDEF are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_LongIntegerToString (long int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower);
+
+/*
+ StringToLongInteger - converts a string, s, of, base, into an LONGINT.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" long int StringConvert_StringToLongInteger (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+ LongCardinalToString - converts LONGCARD, c, into a String. The field
+ width can be specified if non zero. Leading
+ characters are defined by padding.
+ The base allows the caller to generate binary,
+ octal, decimal, hexidecimal numbers.
+ The value of lower is only used when hexidecimal
+ numbers are generated and if TRUE then digits
+ abcdef are used, and if FALSE then ABCDEF are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_LongCardinalToString (long unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower);
+
+/*
+ StringToLongCardinal - converts a string, s, of, base, into a LONGCARD.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" long unsigned int StringConvert_StringToLongCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+ ShortCardinalToString - converts SHORTCARD, c, into a String. The field
+ width can be specified if non zero. Leading
+ characters are defined by padding.
+ The base allows the caller to generate binary,
+ octal, decimal, hexidecimal numbers.
+ The value of lower is only used when hexidecimal
+ numbers are generated and if TRUE then digits
+ abcdef are used, and if FALSE then ABCDEF are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_ShortCardinalToString (short unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower);
+
+/*
+ StringToShortCardinal - converts a string, s, of, base, into a SHORTCARD.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" short unsigned int StringConvert_StringToShortCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+ stoi - decimal string to INTEGER
+*/
+
+extern "C" int StringConvert_stoi (DynamicStrings_String s);
+
+/*
+ itos - integer to decimal string.
+*/
+
+extern "C" DynamicStrings_String StringConvert_itos (int i, unsigned int width, char padding, unsigned int sign);
+
+/*
+ ctos - cardinal to decimal string.
+*/
+
+extern "C" DynamicStrings_String StringConvert_ctos (unsigned int c, unsigned int width, char padding);
+
+/*
+ stoc - decimal string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_stoc (DynamicStrings_String s);
+
+/*
+ hstoi - hexidecimal string to INTEGER
+*/
+
+extern "C" int StringConvert_hstoi (DynamicStrings_String s);
+
+/*
+ ostoi - octal string to INTEGER
+*/
+
+extern "C" int StringConvert_ostoi (DynamicStrings_String s);
+
+/*
+ bstoi - binary string to INTEGER
+*/
+
+extern "C" int StringConvert_bstoi (DynamicStrings_String s);
+
+/*
+ hstoc - hexidecimal string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_hstoc (DynamicStrings_String s);
+
+/*
+ ostoc - octal string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_ostoc (DynamicStrings_String s);
+
+/*
+ bstoc - binary string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_bstoc (DynamicStrings_String s);
+
+/*
+ StringToLongreal - returns a LONGREAL and sets found to TRUE if a legal number is seen.
+*/
+
+extern "C" long double StringConvert_StringToLongreal (DynamicStrings_String s, unsigned int *found);
+
+/*
+ LongrealToString - converts a LONGREAL number, Real, which has,
+ TotalWidth, and FractionWidth into a string.
+ It uses decimal notation.
+
+ So for example:
+
+ LongrealToString(1.0, 4, 2) -> '1.00'
+ LongrealToString(12.3, 5, 2) -> '12.30'
+ LongrealToString(12.3, 6, 2) -> ' 12.30'
+ LongrealToString(12.3, 6, 3) -> '12.300'
+
+ if total width is too small then the fraction
+ becomes truncated.
+
+ LongrealToString(12.3, 5, 3) -> '12.30'
+
+ Positive numbers do not have a '+' prepended.
+ Negative numbers will have a '-' prepended and
+ the TotalWidth will need to be large enough
+ to contain the sign, whole number, '.' and
+ fractional components.
+*/
+
+extern "C" DynamicStrings_String StringConvert_LongrealToString (long double x, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+ stor - returns a REAL given a string.
+*/
+
+extern "C" double StringConvert_stor (DynamicStrings_String s);
+
+/*
+ stolr - returns a LONGREAL given a string.
+*/
+
+extern "C" long double StringConvert_stolr (DynamicStrings_String s);
+
+/*
+ ToSigFig - returns a floating point or base 10 integer
+ string which is accurate to, n, significant
+ figures. It will return a new String
+ and, s, will be destroyed.
+
+
+ So: 12.345
+
+ rounded to the following significant figures yields
+
+ 5 12.345
+ 4 12.34
+ 3 12.3
+ 2 12
+ 1 10
+*/
+
+extern "C" DynamicStrings_String StringConvert_ToSigFig (DynamicStrings_String s, unsigned int n);
+
+/*
+ ToDecimalPlaces - returns a floating point or base 10 integer
+ string which is accurate to, n, decimal
+ places. It will return a new String
+ and, s, will be destroyed.
+ Decimal places yields, n, digits after
+ the .
+
+ So: 12.345
+
+ rounded to the following decimal places yields
+
+ 5 12.34500
+ 4 12.3450
+ 3 12.345
+ 2 12.34
+ 1 12.3
+*/
+
+extern "C" DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_String s, unsigned int n);
+
+/*
+ Assert - implement a simple assert.
+*/
+
+static void Assert (unsigned int b, const char *file_, unsigned int _file_high, unsigned int line, const char *func_, unsigned int _func_high);
+
+/*
+ Max -
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b);
+
+/*
+ Min -
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b);
+
+/*
+ LongMin - returns the smallest LONGCARD
+*/
+
+static long unsigned int LongMin (long unsigned int a, long unsigned int b);
+
+/*
+ IsDigit - returns TRUE if, ch, lies between '0'..'9'.
+*/
+
+static unsigned int IsDigit (char ch);
+
+/*
+ IsDecimalDigitValid - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValid (char ch, unsigned int base, unsigned int *c);
+
+/*
+ IsHexidecimalDigitValid - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValid (char ch, unsigned int base, unsigned int *c);
+
+/*
+ IsDecimalDigitValidLong - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c);
+
+/*
+ IsHexidecimalDigitValidLong - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c);
+
+/*
+ IsDecimalDigitValidShort - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c);
+
+/*
+ IsHexidecimalDigitValidShort - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c);
+
+/*
+ ToThePower10 - returns a LONGREAL containing the value of v * 10^power.
+*/
+
+static long double ToThePower10 (long double v, int power);
+
+/*
+ DetermineSafeTruncation - we wish to use TRUNC when converting REAL/LONGREAL
+ into a string for the non fractional component.
+ However we need a simple method to
+ determine the maximum safe truncation value.
+*/
+
+static unsigned int DetermineSafeTruncation (void);
+
+/*
+ rtos -
+*/
+
+static DynamicStrings_String rtos (double r, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+ lrtos -
+*/
+
+static DynamicStrings_String lrtos (long double r, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+ doDecimalPlaces - returns a string which is accurate to
+ n decimal places. It returns a new String
+ and, s, will be destroyed.
+*/
+
+static DynamicStrings_String doDecimalPlaces (DynamicStrings_String s, unsigned int n);
+
+/*
+ doSigFig - returns a string which is accurate to
+ n decimal places. It returns a new String
+ and, s, will be destroyed.
+*/
+
+static DynamicStrings_String doSigFig (DynamicStrings_String s, unsigned int n);
+
+/*
+ carryOne - add a carry at position, i.
+*/
+
+static DynamicStrings_String carryOne (DynamicStrings_String s, unsigned int i);
+
+
+/*
+ Assert - implement a simple assert.
+*/
+
+static void Assert (unsigned int b, const char *file_, unsigned int _file_high, unsigned int line, const char *func_, unsigned int _func_high)
+{
+ char file[_file_high+1];
+ char func[_func_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+ memcpy (func, func_, _func_high+1);
+
+ if (! b)
+ {
+ M2RTS_ErrorMessage ((const char *) "assert failed", 13, (const char *) file, _file_high, line, (const char *) func, _func_high);
+ }
+}
+
+
+/*
+ Max -
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Min -
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LongMin - returns the smallest LONGCARD
+*/
+
+static long unsigned int LongMin (long unsigned int a, long unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsDigit - returns TRUE if, ch, lies between '0'..'9'.
+*/
+
+static unsigned int IsDigit (char ch)
+{
+ return (ch >= '0') && (ch <= '9');
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsDecimalDigitValid - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValid (char ch, unsigned int base, unsigned int *c)
+{
+ if ((IsDigit (ch)) && (( ((unsigned int) (ch))- ((unsigned int) ('0'))) < base))
+ {
+ (*c) = ((*c)*base)+( ((unsigned int) (ch))- ((unsigned int) ('0')));
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsHexidecimalDigitValid - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValid (char ch, unsigned int base, unsigned int *c)
+{
+ if (((ch >= 'a') && (ch <= 'f')) && ((( ((unsigned int) (ch))- ((unsigned int) ('a')))+10) < base))
+ {
+ (*c) = ((*c)*base)+(( ((unsigned int) (ch))- ((unsigned int) ('a')))+10);
+ return TRUE;
+ }
+ else if (((ch >= 'A') && (ch <= 'F')) && ((( ((unsigned int) (ch))- ((unsigned int) ('F')))+10) < base))
+ {
+ /* avoid dangling else. */
+ (*c) = ((*c)*base)+(( ((unsigned int) (ch))- ((unsigned int) ('A')))+10);
+ return TRUE;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsDecimalDigitValidLong - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c)
+{
+ if ((IsDigit (ch)) && (( ((unsigned int) (ch))- ((unsigned int) ('0'))) < base))
+ {
+ (*c) = (*c)*((long unsigned int ) (base+( ((unsigned int) (ch))- ((unsigned int) ('0')))));
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsHexidecimalDigitValidLong - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c)
+{
+ if (((ch >= 'a') && (ch <= 'f')) && ((( ((unsigned int) (ch))- ((unsigned int) ('a')))+10) < base))
+ {
+ (*c) = (*c)*((long unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('a')))+10)));
+ return TRUE;
+ }
+ else if (((ch >= 'A') && (ch <= 'F')) && ((( ((unsigned int) (ch))- ((unsigned int) ('F')))+10) < base))
+ {
+ /* avoid dangling else. */
+ (*c) = (*c)*((long unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('A')))+10)));
+ return TRUE;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsDecimalDigitValidShort - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c)
+{
+ if ((IsDigit (ch)) && (( ((unsigned int) (ch))- ((unsigned int) ('0'))) < base))
+ {
+ (*c) = (*c)*((short unsigned int ) (base+( ((unsigned int) (ch))- ((unsigned int) ('0')))));
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsHexidecimalDigitValidShort - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c)
+{
+ if (((ch >= 'a') && (ch <= 'f')) && ((( ((unsigned int) (ch))- ((unsigned int) ('a')))+10) < base))
+ {
+ (*c) = (*c)*((short unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('a')))+10)));
+ return TRUE;
+ }
+ else if (((ch >= 'A') && (ch <= 'F')) && ((( ((unsigned int) (ch))- ((unsigned int) ('F')))+10) < base))
+ {
+ /* avoid dangling else. */
+ (*c) = (*c)*((short unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('A')))+10)));
+ return TRUE;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ToThePower10 - returns a LONGREAL containing the value of v * 10^power.
+*/
+
+static long double ToThePower10 (long double v, int power)
+{
+ int i;
+
+ i = 0;
+ if (power > 0)
+ {
+ while (i < power)
+ {
+ v = v*10.0;
+ i += 1;
+ }
+ }
+ else
+ {
+ while (i > power)
+ {
+ v = v/10.0;
+ i -= 1;
+ }
+ }
+ return v;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DetermineSafeTruncation - we wish to use TRUNC when converting REAL/LONGREAL
+ into a string for the non fractional component.
+ However we need a simple method to
+ determine the maximum safe truncation value.
+*/
+
+static unsigned int DetermineSafeTruncation (void)
+{
+ double MaxPowerOfTen;
+ unsigned int LogPower;
+
+ MaxPowerOfTen = static_cast<double> (1.0);
+ LogPower = 0;
+ while ((MaxPowerOfTen*10.0) < ((double) ((INT_MAX) / 10)))
+ {
+ MaxPowerOfTen = MaxPowerOfTen*10.0;
+ LogPower += 1;
+ }
+ return LogPower;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ rtos -
+*/
+
+static DynamicStrings_String rtos (double r, unsigned int TotalWidth, unsigned int FractionWidth)
+{
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ return static_cast<DynamicStrings_String> (NULL);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ lrtos -
+*/
+
+static DynamicStrings_String lrtos (long double r, unsigned int TotalWidth, unsigned int FractionWidth)
+{
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ return static_cast<DynamicStrings_String> (NULL);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doDecimalPlaces - returns a string which is accurate to
+ n decimal places. It returns a new String
+ and, s, will be destroyed.
+*/
+
+static DynamicStrings_String doDecimalPlaces (DynamicStrings_String s, unsigned int n)
+{
+ int i;
+ int l;
+ int point;
+ DynamicStrings_String t;
+ DynamicStrings_String whole;
+ DynamicStrings_String fraction;
+ DynamicStrings_String tenths;
+ DynamicStrings_String hundreths;
+
+ l = DynamicStrings_Length (s);
+ i = 0;
+ /* remove '.' */
+ point = DynamicStrings_Index (s, '.', 0);
+ if (point == 0)
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 1, 0);
+ }
+ else if (point < l)
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_ConCat (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point+1, 0)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point);
+ }
+ l = DynamicStrings_Length (s);
+ i = 0;
+ if (l > 0)
+ {
+ /* skip over leading zeros */
+ while ((i < l) && ((DynamicStrings_char (s, i)) == '0'))
+ {
+ i += 1;
+ }
+ /* was the string full of zeros? */
+ if ((i == l) && ((DynamicStrings_char (s, i-1)) == '0'))
+ {
+ s = DynamicStrings_KillString (s);
+ s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0.", 2), DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), n)));
+ return s;
+ }
+ }
+ /* insert leading zero */
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('0'), DynamicStrings_Mark (s));
+ point += 1; /* and move point position to correct place */
+ l = DynamicStrings_Length (s); /* update new length */
+ i = point; /* update new length */
+ while ((n > 1) && (i < l))
+ {
+ n -= 1;
+ i += 1;
+ }
+ if ((i+3) <= l)
+ {
+ t = DynamicStrings_Dup (s);
+ hundreths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+3);
+ s = t;
+ if ((StringConvert_stoc (hundreths)) >= 50)
+ {
+ s = carryOne (DynamicStrings_Mark (s), static_cast<unsigned int> (i));
+ }
+ hundreths = DynamicStrings_KillString (hundreths);
+ }
+ else if ((i+2) <= l)
+ {
+ /* avoid dangling else. */
+ t = DynamicStrings_Dup (s);
+ tenths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+2);
+ s = t;
+ if ((StringConvert_stoc (tenths)) >= 5)
+ {
+ s = carryOne (DynamicStrings_Mark (s), static_cast<unsigned int> (i));
+ }
+ tenths = DynamicStrings_KillString (tenths);
+ }
+ /* check whether we need to remove the leading zero */
+ if ((DynamicStrings_char (s, 0)) == '0')
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 1, 0);
+ l -= 1;
+ point -= 1;
+ }
+ if (i < l)
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i);
+ l = DynamicStrings_Length (s);
+ if (l < point)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), static_cast<unsigned int> (point-l)));
+ }
+ }
+ /* re-insert the point */
+ if (point >= 0)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (point == 0)
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('.'), DynamicStrings_Mark (s));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), '.'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point, 0)));
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doSigFig - returns a string which is accurate to
+ n decimal places. It returns a new String
+ and, s, will be destroyed.
+*/
+
+static DynamicStrings_String doSigFig (DynamicStrings_String s, unsigned int n)
+{
+ int i;
+ int l;
+ int z;
+ int point;
+ DynamicStrings_String t;
+ DynamicStrings_String tenths;
+ DynamicStrings_String hundreths;
+
+ l = DynamicStrings_Length (s);
+ i = 0;
+ /* remove '.' */
+ point = DynamicStrings_Index (s, '.', 0);
+ if (point >= 0)
+ {
+ if (point == 0)
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 1, 0);
+ }
+ else if (point < l)
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_ConCat (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point+1, 0)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point);
+ }
+ }
+ else
+ {
+ s = DynamicStrings_Dup (DynamicStrings_Mark (s));
+ }
+ l = DynamicStrings_Length (s);
+ i = 0;
+ if (l > 0)
+ {
+ /* skip over leading zeros */
+ while ((i < l) && ((DynamicStrings_char (s, i)) == '0'))
+ {
+ i += 1;
+ }
+ /* was the string full of zeros? */
+ if ((i == l) && ((DynamicStrings_char (s, i-1)) == '0'))
+ {
+ /* truncate string */
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast<int> (n));
+ i = n;
+ }
+ }
+ /* add a leading zero in case we need to overflow the carry */
+ z = i; /* remember where we inserted zero */
+ if (z == 0) /* remember where we inserted zero */
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('0'), DynamicStrings_Mark (s));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i), '0'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), i, 0)));
+ }
+ n += 1; /* and increase the number of sig figs needed */
+ l = DynamicStrings_Length (s); /* and increase the number of sig figs needed */
+ while ((n > 1) && (i < l))
+ {
+ n -= 1;
+ i += 1;
+ }
+ if ((i+3) <= l)
+ {
+ t = DynamicStrings_Dup (s);
+ hundreths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+3);
+ s = t;
+ if ((StringConvert_stoc (hundreths)) >= 50)
+ {
+ s = carryOne (DynamicStrings_Mark (s), static_cast<unsigned int> (i));
+ }
+ hundreths = DynamicStrings_KillString (hundreths);
+ }
+ else if ((i+2) <= l)
+ {
+ /* avoid dangling else. */
+ t = DynamicStrings_Dup (s);
+ tenths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+2);
+ s = t;
+ if ((StringConvert_stoc (tenths)) >= 5)
+ {
+ s = carryOne (DynamicStrings_Mark (s), static_cast<unsigned int> (i));
+ }
+ tenths = DynamicStrings_KillString (tenths);
+ }
+ /* check whether we need to remove the leading zero */
+ if ((DynamicStrings_char (s, z)) == '0')
+ {
+ if (z == 0)
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), z+1, 0);
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, z), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), z+1, 0)));
+ }
+ l = DynamicStrings_Length (s);
+ }
+ else
+ {
+ point += 1;
+ }
+ if (i < l)
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i);
+ l = DynamicStrings_Length (s);
+ if (l < point)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), static_cast<unsigned int> (point-l)));
+ }
+ }
+ /* re-insert the point */
+ if (point >= 0)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (point == 0)
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('.'), DynamicStrings_Mark (s));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), '.'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point, 0)));
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ carryOne - add a carry at position, i.
+*/
+
+static DynamicStrings_String carryOne (DynamicStrings_String s, unsigned int i)
+{
+ if (i >= 0)
+ {
+ if (IsDigit (DynamicStrings_char (s, static_cast<int> (i))))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((DynamicStrings_char (s, static_cast<int> (i))) == '9')
+ {
+ if (i == 0)
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('1'), DynamicStrings_Mark (s));
+ return s;
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast<int> (i)), '0'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast<int> (i+1), 0)));
+ return carryOne (s, i-1);
+ }
+ }
+ else
+ {
+ if (i == 0)
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ( ((char) ( ((unsigned int) (DynamicStrings_char (s, static_cast<int> (i))))+1))), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast<int> (i+1), 0)));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast<int> (i)), ((char) ( ((unsigned int) (DynamicStrings_char (s, static_cast<int> (i))))+1))), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast<int> (i+1), 0)));
+ }
+ }
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IntegerToString - converts INTEGER, i, into a String. The field with can be specified
+ if non zero. Leading characters are defined by padding and this
+ function will prepend a + if sign is set to TRUE.
+ The base allows the caller to generate binary, octal, decimal, hexidecimal
+ numbers. The value of lower is only used when hexidecimal numbers are
+ generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF
+ are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_IntegerToString (int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower)
+{
+ DynamicStrings_String s;
+ unsigned int c;
+
+ if (i < 0)
+ {
+ if (i == (INT_MIN))
+ {
+ /* remember that -15 MOD 4 = 1 in Modula-2 */
+ c = ((unsigned int ) (abs (i+1)))+1;
+ if (width > 0)
+ {
+ return DynamicStrings_ConCat (StringConvert_IntegerToString (-((int ) (c / base)), width-1, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_IntegerToString (static_cast<int> (c % base), 0, ' ', FALSE, base, lower)));
+ }
+ else
+ {
+ return DynamicStrings_ConCat (StringConvert_IntegerToString (-((int ) (c / base)), 0, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_IntegerToString (static_cast<int> (c % base), 0, ' ', FALSE, base, lower)));
+ }
+ }
+ else
+ {
+ s = DynamicStrings_InitString ((const char *) "-", 1);
+ }
+ i = -i;
+ }
+ else
+ {
+ if (sign)
+ {
+ s = DynamicStrings_InitString ((const char *) "+", 1);
+ }
+ else
+ {
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ }
+ }
+ if (i > (((int ) (base))-1))
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (StringConvert_IntegerToString (static_cast<int> (((unsigned int ) (i)) / base), 0, ' ', FALSE, base, lower))), DynamicStrings_Mark (StringConvert_IntegerToString (static_cast<int> (((unsigned int ) (i)) % base), 0, ' ', FALSE, base, lower)));
+ }
+ else
+ {
+ if (i <= 9)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) (((unsigned int ) (i))+ ((unsigned int) ('0')))))));
+ }
+ else
+ {
+ if (lower)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('a')))-10)))));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('A')))-10)))));
+ }
+ }
+ }
+ if (width > (DynamicStrings_Length (s)))
+ {
+ return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), DynamicStrings_Mark (s));
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CardinalToString - converts CARDINAL, c, into a String. The field with can be specified
+ if non zero. Leading characters are defined by padding.
+ The base allows the caller to generate binary, octal, decimal, hexidecimal
+ numbers. The value of lower is only used when hexidecimal numbers are
+ generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF
+ are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_CardinalToString (unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ if (c > (base-1))
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (StringConvert_CardinalToString (c / base, 0, ' ', base, lower))), DynamicStrings_Mark (StringConvert_CardinalToString (c % base, 0, ' ', base, lower)));
+ }
+ else
+ {
+ if (c <= 9)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) (c+ ((unsigned int) ('0')))))));
+ }
+ else
+ {
+ if (lower)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((c+ ((unsigned int) ('a')))-10)))));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((c+ ((unsigned int) ('A')))-10)))));
+ }
+ }
+ }
+ if (width > (DynamicStrings_Length (s)))
+ {
+ return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), s);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StringToInteger - converts a string, s, of, base, into an INTEGER.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" int StringConvert_StringToInteger (DynamicStrings_String s, unsigned int base, unsigned int *found)
+{
+ unsigned int n;
+ unsigned int l;
+ unsigned int c;
+ unsigned int negative;
+
+ s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */
+ l = DynamicStrings_Length (s); /* returns a new string, s */
+ c = 0;
+ n = 0;
+ negative = FALSE;
+ if (n < l)
+ {
+ /* parse leading + and - */
+ while (((DynamicStrings_char (s, static_cast<int> (n))) == '-') || ((DynamicStrings_char (s, static_cast<int> (n))) == '+'))
+ {
+ if ((DynamicStrings_char (s, static_cast<int> (n))) == '-')
+ {
+ negative = ! negative;
+ }
+ n += 1;
+ }
+ while ((n < l) && ((IsDecimalDigitValid (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValid (DynamicStrings_char (s, static_cast<int> (n)), base, &c))))
+ {
+ (*found) = TRUE;
+ n += 1;
+ }
+ }
+ s = DynamicStrings_KillString (s);
+ if (negative)
+ {
+ return -((int ) (Min (((unsigned int ) (INT_MAX))+1, c)));
+ }
+ else
+ {
+ return (int ) (Min (static_cast<unsigned int> (INT_MAX), c));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StringToCardinal - converts a string, s, of, base, into a CARDINAL.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" unsigned int StringConvert_StringToCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found)
+{
+ unsigned int n;
+ unsigned int l;
+ unsigned int c;
+
+ s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */
+ l = DynamicStrings_Length (s); /* returns a new string, s */
+ c = 0;
+ n = 0;
+ if (n < l)
+ {
+ /* parse leading + */
+ while ((DynamicStrings_char (s, static_cast<int> (n))) == '+')
+ {
+ n += 1;
+ }
+ while ((n < l) && ((IsDecimalDigitValid (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValid (DynamicStrings_char (s, static_cast<int> (n)), base, &c))))
+ {
+ (*found) = TRUE;
+ n += 1;
+ }
+ }
+ s = DynamicStrings_KillString (s);
+ return c;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LongIntegerToString - converts LONGINT, i, into a String. The field with
+ can be specified if non zero. Leading characters
+ are defined by padding and this function will
+ prepend a + if sign is set to TRUE.
+ The base allows the caller to generate binary,
+ octal, decimal, hexidecimal numbers.
+ The value of lower is only used when hexidecimal
+ numbers are generated and if TRUE then digits
+ abcdef are used, and if FALSE then ABCDEF are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_LongIntegerToString (long int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower)
+{
+ DynamicStrings_String s;
+ long unsigned int c;
+
+ if (i < 0)
+ {
+ if (i == (LONG_MIN))
+ {
+ /* remember that -15 MOD 4 is 1 in Modula-2, and although ABS(MIN(LONGINT)+1)
+ is very likely MAX(LONGINT), it is safer not to assume this is the case */
+ c = ((long unsigned int ) (labs (i+1)))+1;
+ if (width > 0)
+ {
+ return DynamicStrings_ConCat (StringConvert_LongIntegerToString (-((long int ) (c / ((long unsigned int ) (base)))), width-1, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_LongIntegerToString (static_cast<long int> (c % ((long unsigned int ) (base))), 0, ' ', FALSE, base, lower)));
+ }
+ else
+ {
+ return DynamicStrings_ConCat (StringConvert_LongIntegerToString (-((long int ) (c / ((long unsigned int ) (base)))), 0, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_LongIntegerToString (static_cast<long int> (c % ((long unsigned int ) (base))), 0, ' ', FALSE, base, lower)));
+ }
+ }
+ else
+ {
+ s = DynamicStrings_InitString ((const char *) "-", 1);
+ }
+ i = -i;
+ }
+ else
+ {
+ if (sign)
+ {
+ s = DynamicStrings_InitString ((const char *) "+", 1);
+ }
+ else
+ {
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ }
+ }
+ if (i > ((long int ) (base-1)))
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (StringConvert_LongIntegerToString (i / ((long int ) (base)), 0, ' ', FALSE, base, lower))), DynamicStrings_Mark (StringConvert_LongIntegerToString (i % ((long int ) (base)), 0, ' ', FALSE, base, lower)));
+ }
+ else
+ {
+ if (i <= 9)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) (((unsigned int ) (i))+ ((unsigned int) ('0')))))));
+ }
+ else
+ {
+ if (lower)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('a')))-10)))));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('A')))-10)))));
+ }
+ }
+ }
+ if (width > (DynamicStrings_Length (s)))
+ {
+ return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), s);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StringToLongInteger - converts a string, s, of, base, into an LONGINT.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" long int StringConvert_StringToLongInteger (DynamicStrings_String s, unsigned int base, unsigned int *found)
+{
+ unsigned int n;
+ unsigned int l;
+ long unsigned int c;
+ unsigned int negative;
+
+ s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */
+ l = DynamicStrings_Length (s); /* returns a new string, s */
+ c = 0;
+ n = 0;
+ negative = FALSE;
+ if (n < l)
+ {
+ /* parse leading + and - */
+ while (((DynamicStrings_char (s, static_cast<int> (n))) == '-') || ((DynamicStrings_char (s, static_cast<int> (n))) == '+'))
+ {
+ if ((DynamicStrings_char (s, static_cast<int> (n))) == '-')
+ {
+ negative = ! negative;
+ }
+ n += 1;
+ }
+ while ((n < l) && ((IsDecimalDigitValidLong (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValidLong (DynamicStrings_char (s, static_cast<int> (n)), base, &c))))
+ {
+ (*found) = TRUE;
+ n += 1;
+ }
+ }
+ s = DynamicStrings_KillString (s);
+ if (negative)
+ {
+ return -((long int ) (LongMin (((long unsigned int ) (LONG_MAX))+1, c)));
+ }
+ else
+ {
+ return (long int ) (LongMin (static_cast<long unsigned int> (LONG_MAX), c));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LongCardinalToString - converts LONGCARD, c, into a String. The field
+ width can be specified if non zero. Leading
+ characters are defined by padding.
+ The base allows the caller to generate binary,
+ octal, decimal, hexidecimal numbers.
+ The value of lower is only used when hexidecimal
+ numbers are generated and if TRUE then digits
+ abcdef are used, and if FALSE then ABCDEF are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_LongCardinalToString (long unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ if (c > ((long unsigned int ) (base-1)))
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, StringConvert_LongCardinalToString (c / ((long unsigned int ) (base)), 0, ' ', base, lower)), StringConvert_LongCardinalToString (c % ((long unsigned int ) (base)), 0, ' ', base, lower));
+ }
+ else
+ {
+ if (c <= 9)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) (((unsigned int ) (c))+ ((unsigned int) ('0'))))));
+ }
+ else
+ {
+ if (lower)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (c))+ ((unsigned int) ('a')))-10))));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (c))+ ((unsigned int) ('A')))-10))));
+ }
+ }
+ }
+ if (width > (DynamicStrings_Length (s)))
+ {
+ return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), s);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StringToLongCardinal - converts a string, s, of, base, into a LONGCARD.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" long unsigned int StringConvert_StringToLongCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found)
+{
+ unsigned int n;
+ unsigned int l;
+ long unsigned int c;
+
+ s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */
+ l = DynamicStrings_Length (s); /* returns a new string, s */
+ c = 0;
+ n = 0;
+ if (n < l)
+ {
+ /* parse leading + */
+ while ((DynamicStrings_char (s, static_cast<int> (n))) == '+')
+ {
+ n += 1;
+ }
+ while ((n < l) && ((IsDecimalDigitValidLong (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValidLong (DynamicStrings_char (s, static_cast<int> (n)), base, &c))))
+ {
+ (*found) = TRUE;
+ n += 1;
+ }
+ }
+ s = DynamicStrings_KillString (s);
+ return c;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ShortCardinalToString - converts SHORTCARD, c, into a String. The field
+ width can be specified if non zero. Leading
+ characters are defined by padding.
+ The base allows the caller to generate binary,
+ octal, decimal, hexidecimal numbers.
+ The value of lower is only used when hexidecimal
+ numbers are generated and if TRUE then digits
+ abcdef are used, and if FALSE then ABCDEF are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_ShortCardinalToString (short unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ if (((unsigned int ) (c)) > (base-1))
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, StringConvert_ShortCardinalToString (c / ((short unsigned int ) (base)), 0, ' ', base, lower)), StringConvert_ShortCardinalToString (c % ((short unsigned int ) (base)), 0, ' ', base, lower));
+ }
+ else
+ {
+ if (c <= 9)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) (((unsigned int ) (c))+ ((unsigned int) ('0'))))));
+ }
+ else
+ {
+ if (lower)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (c))+ ((unsigned int) ('a')))-10))));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (c))+ ((unsigned int) ('A')))-10))));
+ }
+ }
+ }
+ if (width > (DynamicStrings_Length (s)))
+ {
+ return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), s);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StringToShortCardinal - converts a string, s, of, base, into a SHORTCARD.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" short unsigned int StringConvert_StringToShortCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found)
+{
+ unsigned int n;
+ unsigned int l;
+ short unsigned int c;
+
+ s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */
+ l = DynamicStrings_Length (s); /* returns a new string, s */
+ c = 0;
+ n = 0;
+ if (n < l)
+ {
+ /* parse leading + */
+ while ((DynamicStrings_char (s, static_cast<int> (n))) == '+')
+ {
+ n += 1;
+ }
+ while ((n < l) && ((IsDecimalDigitValidShort (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValidShort (DynamicStrings_char (s, static_cast<int> (n)), base, &c))))
+ {
+ (*found) = TRUE;
+ n += 1;
+ }
+ }
+ s = DynamicStrings_KillString (s);
+ return c;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ stoi - decimal string to INTEGER
+*/
+
+extern "C" int StringConvert_stoi (DynamicStrings_String s)
+{
+ unsigned int found;
+
+ return StringConvert_StringToInteger (s, 10, &found);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ itos - integer to decimal string.
+*/
+
+extern "C" DynamicStrings_String StringConvert_itos (int i, unsigned int width, char padding, unsigned int sign)
+{
+ return StringConvert_IntegerToString (i, width, padding, sign, 10, FALSE);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ctos - cardinal to decimal string.
+*/
+
+extern "C" DynamicStrings_String StringConvert_ctos (unsigned int c, unsigned int width, char padding)
+{
+ return StringConvert_CardinalToString (c, width, padding, 10, FALSE);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ stoc - decimal string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_stoc (DynamicStrings_String s)
+{
+ unsigned int found;
+
+ return StringConvert_StringToCardinal (s, 10, &found);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ hstoi - hexidecimal string to INTEGER
+*/
+
+extern "C" int StringConvert_hstoi (DynamicStrings_String s)
+{
+ unsigned int found;
+
+ return StringConvert_StringToInteger (s, 16, &found);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ostoi - octal string to INTEGER
+*/
+
+extern "C" int StringConvert_ostoi (DynamicStrings_String s)
+{
+ unsigned int found;
+
+ return StringConvert_StringToInteger (s, 8, &found);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ bstoi - binary string to INTEGER
+*/
+
+extern "C" int StringConvert_bstoi (DynamicStrings_String s)
+{
+ unsigned int found;
+
+ return StringConvert_StringToInteger (s, 2, &found);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ hstoc - hexidecimal string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_hstoc (DynamicStrings_String s)
+{
+ unsigned int found;
+
+ return StringConvert_StringToCardinal (s, 16, &found);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ostoc - octal string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_ostoc (DynamicStrings_String s)
+{
+ unsigned int found;
+
+ return StringConvert_StringToCardinal (s, 8, &found);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ bstoc - binary string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_bstoc (DynamicStrings_String s)
+{
+ unsigned int found;
+
+ return StringConvert_StringToCardinal (s, 2, &found);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StringToLongreal - returns a LONGREAL and sets found to TRUE if a legal number is seen.
+*/
+
+extern "C" long double StringConvert_StringToLongreal (DynamicStrings_String s, unsigned int *found)
+{
+ unsigned int error;
+ long double value;
+
+ s = DynamicStrings_RemoveWhitePrefix (s); /* new string is created */
+ value = ldtoa_strtold (DynamicStrings_string (s), &error); /* new string is created */
+ s = DynamicStrings_KillString (s);
+ (*found) = ! error;
+ return value;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LongrealToString - converts a LONGREAL number, Real, which has,
+ TotalWidth, and FractionWidth into a string.
+ It uses decimal notation.
+
+ So for example:
+
+ LongrealToString(1.0, 4, 2) -> '1.00'
+ LongrealToString(12.3, 5, 2) -> '12.30'
+ LongrealToString(12.3, 6, 2) -> ' 12.30'
+ LongrealToString(12.3, 6, 3) -> '12.300'
+
+ if total width is too small then the fraction
+ becomes truncated.
+
+ LongrealToString(12.3, 5, 3) -> '12.30'
+
+ Positive numbers do not have a '+' prepended.
+ Negative numbers will have a '-' prepended and
+ the TotalWidth will need to be large enough
+ to contain the sign, whole number, '.' and
+ fractional components.
+*/
+
+extern "C" DynamicStrings_String StringConvert_LongrealToString (long double x, unsigned int TotalWidth, unsigned int FractionWidth)
+{
+ unsigned int maxprecision;
+ DynamicStrings_String s;
+ void * r;
+ int point;
+ unsigned int sign;
+ int l;
+
+ if (TotalWidth == 0)
+ {
+ maxprecision = TRUE;
+ r = ldtoa_ldtoa (x, ldtoa_decimaldigits, 100, &point, &sign);
+ }
+ else
+ {
+ r = ldtoa_ldtoa (x, ldtoa_decimaldigits, 100, &point, &sign);
+ }
+ s = DynamicStrings_InitStringCharStar (r);
+ libc_free (r);
+ l = DynamicStrings_Length (s);
+ if (point > l)
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), static_cast<unsigned int> (point-l))));
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".0", 2)));
+ if (! maxprecision && (FractionWidth > 0))
+ {
+ FractionWidth -= 1;
+ if (((int ) (FractionWidth)) > (point-l))
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "0", 1)), FractionWidth)));
+ }
+ }
+ }
+ else if (point < 0)
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), static_cast<unsigned int> (-point)), DynamicStrings_Mark (s));
+ l = DynamicStrings_Length (s);
+ s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0.", 2), DynamicStrings_Mark (s));
+ if (! maxprecision && (l < ((int ) (FractionWidth))))
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "0", 1)), static_cast<unsigned int> (((int ) (FractionWidth))-l))));
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ if (point == 0)
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0.", 2), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point, 0)));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), '.'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point, 0)));
+ }
+ if (! maxprecision && ((l-point) < ((int ) (FractionWidth))))
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "0", 1)), static_cast<unsigned int> (((int ) (FractionWidth))-(l-point)))));
+ }
+ }
+ if ((DynamicStrings_Length (s)) > TotalWidth)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (TotalWidth > 0)
+ {
+ if (sign)
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (StringConvert_ToDecimalPlaces (s, FractionWidth)), 0, static_cast<int> (TotalWidth-1));
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('-'), DynamicStrings_Mark (s));
+ sign = FALSE;
+ }
+ else
+ {
+ /* minus 1 because all results will include a '.' */
+ s = DynamicStrings_Slice (DynamicStrings_Mark (StringConvert_ToDecimalPlaces (s, FractionWidth)), 0, static_cast<int> (TotalWidth));
+ }
+ }
+ else
+ {
+ if (sign)
+ {
+ s = StringConvert_ToDecimalPlaces (s, FractionWidth);
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('-'), DynamicStrings_Mark (s));
+ sign = FALSE;
+ }
+ else
+ {
+ /* minus 1 because all results will include a '.' */
+ s = StringConvert_ToDecimalPlaces (s, FractionWidth);
+ }
+ }
+ }
+ if ((DynamicStrings_Length (s)) < TotalWidth)
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (' ')), TotalWidth-(DynamicStrings_Length (s))), DynamicStrings_Mark (s));
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ stor - returns a REAL given a string.
+*/
+
+extern "C" double StringConvert_stor (DynamicStrings_String s)
+{
+ unsigned int found;
+
+ return (double ) (StringConvert_StringToLongreal (s, &found));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ stolr - returns a LONGREAL given a string.
+*/
+
+extern "C" long double StringConvert_stolr (DynamicStrings_String s)
+{
+ unsigned int found;
+
+ return StringConvert_StringToLongreal (s, &found);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ToSigFig - returns a floating point or base 10 integer
+ string which is accurate to, n, significant
+ figures. It will return a new String
+ and, s, will be destroyed.
+
+
+ So: 12.345
+
+ rounded to the following significant figures yields
+
+ 5 12.345
+ 4 12.34
+ 3 12.3
+ 2 12
+ 1 10
+*/
+
+extern "C" DynamicStrings_String StringConvert_ToSigFig (DynamicStrings_String s, unsigned int n)
+{
+ int point;
+ unsigned int poTen;
+
+ Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/StringConvert.mod", 54, 1222, (const char *) "ToSigFig", 8);
+ point = DynamicStrings_Index (s, '.', 0);
+ if (point < 0)
+ {
+ poTen = DynamicStrings_Length (s);
+ }
+ else
+ {
+ poTen = point;
+ }
+ s = doSigFig (s, n);
+ /* if the last character is '.' remove it */
+ if (((DynamicStrings_Length (s)) > 0) && ((DynamicStrings_char (s, -1)) == '.'))
+ {
+ return DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
+ }
+ else
+ {
+ if (poTen > (DynamicStrings_Length (s)))
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), poTen-(DynamicStrings_Length (s)))));
+ }
+ return s;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ToDecimalPlaces - returns a floating point or base 10 integer
+ string which is accurate to, n, decimal
+ places. It will return a new String
+ and, s, will be destroyed.
+ Decimal places yields, n, digits after
+ the .
+
+ So: 12.345
+
+ rounded to the following decimal places yields
+
+ 5 12.34500
+ 4 12.3450
+ 3 12.345
+ 2 12.34
+ 1 12.3
+*/
+
+extern "C" DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_String s, unsigned int n)
+{
+ int point;
+
+ Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/StringConvert.mod", 54, 1069, (const char *) "ToDecimalPlaces", 15);
+ point = DynamicStrings_Index (s, '.', 0);
+ if (point < 0)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (n > 0)
+ {
+ return DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ('.'))), DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), n));
+ }
+ else
+ {
+ return s;
+ }
+ }
+ s = doDecimalPlaces (s, n);
+ /* if the last character is '.' remove it */
+ if (((DynamicStrings_Length (s)) > 0) && ((DynamicStrings_char (s, -1)) == '.'))
+ {
+ return DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
+ }
+ else
+ {
+ return s;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_StringConvert_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_StringConvert_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from SysStorage. */
+/* SysStorage.mod provides dynamic allocation for the system components.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _SysStorage_H
+#define _SysStorage_C
+
+# include "Glibc.h"
+# include "GDebug.h"
+# include "GSYSTEM.h"
+
+# define enableDeallocation TRUE
+# define enableZero FALSE
+# define enableTrace FALSE
+static unsigned int callno;
+static unsigned int zero;
+static unsigned int trace;
+extern "C" void SysStorage_ALLOCATE (void * *a, unsigned int size);
+extern "C" void SysStorage_DEALLOCATE (void * *a, unsigned int size);
+
+/*
+ REALLOCATE - attempts to reallocate storage. The address,
+ a, should either be NIL in which case ALLOCATE
+ is called, or alternatively it should have already
+ been initialized by ALLOCATE. The allocated storage
+ is resized accordingly.
+*/
+
+extern "C" void SysStorage_REALLOCATE (void * *a, unsigned int size);
+
+/*
+ REALLOCATE - attempts to reallocate storage. The address,
+ a, should either be NIL in which case ALLOCATE
+ is called, or alternatively it should have already
+ been initialized by ALLOCATE. The allocated storage
+ is resized accordingly.
+*/
+
+extern "C" unsigned int SysStorage_Available (unsigned int size);
+
+/*
+ Init - initializes the heap. This does nothing on a GNU/Linux system.
+ But it remains here since it might be used in an embedded system.
+*/
+
+extern "C" void SysStorage_Init (void);
+
+extern "C" void SysStorage_ALLOCATE (void * *a, unsigned int size)
+{
+ (*a) = libc_malloc (static_cast<size_t> (size));
+ if ((*a) == NULL)
+ {
+ Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ }
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) "<DEBUG-CALL> %d SysStorage.ALLOCATE (0x%x, %d bytes)\\n", 54, callno, (*a), size);
+ libc_printf ((const char *) "<MEM-ALLOC> %ld %d\\n", 20, (*a), size);
+ callno += 1;
+ }
+}
+
+extern "C" void SysStorage_DEALLOCATE (void * *a, unsigned int size)
+{
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) "<DEBUG-CALL> %d SysStorage.DEALLOCATE (0x%x, %d bytes)\\n", 56, callno, (*a), size);
+ callno += 1;
+ }
+ if (enableZero && zero)
+ {
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) " memset (0x%x, 0, %d bytes)\\n", 30, (*a), size);
+ }
+ if ((libc_memset ((*a), 0, static_cast<size_t> (size))) != (*a))
+ {
+ Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ }
+ }
+ if (enableDeallocation)
+ {
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) " free (0x%x) %d bytes\\n", 26, (*a), size);
+ libc_printf ((const char *) "<MEM-FREE> %ld %d\\n", 19, (*a), size);
+ }
+ libc_free ((*a));
+ }
+ (*a) = NULL;
+}
+
+
+/*
+ REALLOCATE - attempts to reallocate storage. The address,
+ a, should either be NIL in which case ALLOCATE
+ is called, or alternatively it should have already
+ been initialized by ALLOCATE. The allocated storage
+ is resized accordingly.
+*/
+
+extern "C" void SysStorage_REALLOCATE (void * *a, unsigned int size)
+{
+ if ((*a) == NULL)
+ {
+ SysStorage_ALLOCATE (a, size);
+ }
+ else
+ {
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) "<DEBUG-CALL> %d SysStorage.REALLOCATE (0x%x, %d bytes)\\n", 56, callno, (*a), size);
+ callno += 1;
+ }
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) " realloc (0x%x, %d bytes) -> ", 32, (*a), size);
+ libc_printf ((const char *) "<MEM-FREE> %ld %d\\n", 19, (*a), size);
+ }
+ (*a) = libc_realloc ((*a), static_cast<size_t> (size));
+ if ((*a) == NULL)
+ {
+ Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ }
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) "<MEM-ALLOC> %ld %d\\n", 20, (*a), size);
+ libc_printf ((const char *) " 0x%x %d bytes\\n", 18, (*a), size);
+ }
+ }
+}
+
+
+/*
+ REALLOCATE - attempts to reallocate storage. The address,
+ a, should either be NIL in which case ALLOCATE
+ is called, or alternatively it should have already
+ been initialized by ALLOCATE. The allocated storage
+ is resized accordingly.
+*/
+
+extern "C" unsigned int SysStorage_Available (unsigned int size)
+{
+ void * a;
+
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) "<DEBUG-CALL> %d SysStorage.Available (%d bytes)\\n", 49, callno, size);
+ callno += 1;
+ }
+ a = libc_malloc (static_cast<size_t> (size));
+ if (a == NULL)
+ {
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) " no\\n", 7, size);
+ }
+ return FALSE;
+ }
+ else
+ {
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) " yes\\n", 8, size);
+ }
+ libc_free (a);
+ return TRUE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Init - initializes the heap. This does nothing on a GNU/Linux system.
+ But it remains here since it might be used in an embedded system.
+*/
+
+extern "C" void SysStorage_Init (void)
+{
+}
+
+extern "C" void _M2_SysStorage_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ callno = 0;
+ if (enableTrace)
+ {
+ trace = (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("M2DEBUG_SYSSTORAGE_trace")))) != NULL;
+ }
+ else
+ {
+ trace = FALSE;
+ }
+ if (enableZero)
+ {
+ zero = (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("M2DEBUG_SYSSTORAGE_zero")))) != NULL;
+ }
+ else
+ {
+ zero = FALSE;
+ }
+}
+
+extern "C" void _M2_SysStorage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from TimeString. */
+/* TimeString.mod provides time related string manipulation procedures.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _TimeString_H
+#define _TimeString_C
+
+# include "Gwrapc.h"
+# include "GASCII.h"
+# include "GSYSTEM.h"
+
+
+/*
+ GetTimeString - places the time in ascii format into array, a.
+
+*/
+
+extern "C" void TimeString_GetTimeString (char *a, unsigned int _a_high);
+
+
+/*
+ GetTimeString - places the time in ascii format into array, a.
+
+*/
+
+extern "C" void TimeString_GetTimeString (char *a, unsigned int _a_high)
+{
+ typedef char *GetTimeString__T1;
+
+ GetTimeString__T1 Addr;
+ unsigned int i;
+
+ Addr = static_cast<GetTimeString__T1> (wrapc_strtime ());
+ i = 0;
+ if (Addr != NULL)
+ {
+ while ((i < _a_high) && ((*Addr) != ASCII_nul))
+ {
+ a[i] = (*Addr);
+ i += 1;
+ Addr += 1;
+ }
+ }
+ if (i < _a_high)
+ {
+ a[i] = ASCII_nul;
+ }
+}
+
+extern "C" void _M2_TimeString_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_TimeString_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from alists. */
+/* alists.mod address lists module.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _alists_H
+#define _alists_C
+
+# include "GStorage.h"
+
+typedef struct alists_performOperation_p alists_performOperation;
+
+# define MaxnoOfelements 5
+typedef struct alists__T1_r alists__T1;
+
+typedef struct alists__T2_a alists__T2;
+
+typedef alists__T1 *alists_alist;
+
+typedef void (*alists_performOperation_t) (void *);
+struct alists_performOperation_p { alists_performOperation_t proc; };
+
+struct alists__T2_a { void * array[MaxnoOfelements-1+1]; };
+struct alists__T1_r {
+ unsigned int noOfelements;
+ alists__T2 elements;
+ alists_alist next;
+ };
+
+
+/*
+ initList - creates a new alist, l.
+*/
+
+extern "C" alists_alist alists_initList (void);
+
+/*
+ killList - deletes the complete alist, l.
+*/
+
+extern "C" void alists_killList (alists_alist *l);
+
+/*
+ putItemIntoList - places an ADDRESS, c, into alist, l.
+*/
+
+extern "C" void alists_putItemIntoList (alists_alist l, void * c);
+
+/*
+ getItemFromList - retrieves the nth WORD from alist, l.
+*/
+
+extern "C" void * alists_getItemFromList (alists_alist l, unsigned int n);
+
+/*
+ getIndexOfList - returns the index for WORD, c, in alist, l.
+ If more than one WORD, c, exists the index
+ for the first is returned.
+*/
+
+extern "C" unsigned int alists_getIndexOfList (alists_alist l, void * c);
+
+/*
+ noOfItemsInList - returns the number of items in alist, l.
+*/
+
+extern "C" unsigned int alists_noOfItemsInList (alists_alist l);
+
+/*
+ includeItemIntoList - adds an ADDRESS, c, into a alist providing
+ the value does not already exist.
+*/
+
+extern "C" void alists_includeItemIntoList (alists_alist l, void * c);
+
+/*
+ removeItemFromList - removes a ADDRESS, c, from a alist.
+ It assumes that this value only appears once.
+*/
+
+extern "C" void alists_removeItemFromList (alists_alist l, void * c);
+
+/*
+ isItemInList - returns true if a ADDRESS, c, was found in alist, l.
+*/
+
+extern "C" unsigned int alists_isItemInList (alists_alist l, void * c);
+
+/*
+ foreachItemInListDo - calls procedure, P, foreach item in alist, l.
+*/
+
+extern "C" void alists_foreachItemInListDo (alists_alist l, alists_performOperation p);
+
+/*
+ duplicateList - returns a duplicate alist derived from, l.
+*/
+
+extern "C" alists_alist alists_duplicateList (alists_alist l);
+
+/*
+ removeItem - remove an element at index, i, from the alist data type.
+*/
+
+static void removeItem (alists_alist p, alists_alist l, unsigned int i);
+
+
+/*
+ removeItem - remove an element at index, i, from the alist data type.
+*/
+
+static void removeItem (alists_alist p, alists_alist l, unsigned int i)
+{
+ l->noOfelements -= 1;
+ while (i <= l->noOfelements)
+ {
+ l->elements.array[i-1] = l->elements.array[i+1-1];
+ i += 1;
+ }
+ if ((l->noOfelements == 0) && (p != NULL))
+ {
+ p->next = l->next;
+ Storage_DEALLOCATE ((void **) &l, sizeof (alists__T1));
+ }
+}
+
+
+/*
+ initList - creates a new alist, l.
+*/
+
+extern "C" alists_alist alists_initList (void)
+{
+ alists_alist l;
+
+ Storage_ALLOCATE ((void **) &l, sizeof (alists__T1));
+ l->noOfelements = 0;
+ l->next = NULL;
+ return l;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ killList - deletes the complete alist, l.
+*/
+
+extern "C" void alists_killList (alists_alist *l)
+{
+ if ((*l) != NULL)
+ {
+ if ((*l)->next != NULL)
+ {
+ alists_killList (&(*l)->next);
+ }
+ Storage_DEALLOCATE ((void **) &(*l), sizeof (alists__T1));
+ }
+}
+
+
+/*
+ putItemIntoList - places an ADDRESS, c, into alist, l.
+*/
+
+extern "C" void alists_putItemIntoList (alists_alist l, void * c)
+{
+ if (l->noOfelements < MaxnoOfelements)
+ {
+ l->noOfelements += 1;
+ l->elements.array[l->noOfelements-1] = c;
+ }
+ else if (l->next != NULL)
+ {
+ /* avoid dangling else. */
+ alists_putItemIntoList (l->next, c);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ l->next = alists_initList ();
+ alists_putItemIntoList (l->next, c);
+ }
+}
+
+
+/*
+ getItemFromList - retrieves the nth WORD from alist, l.
+*/
+
+extern "C" void * alists_getItemFromList (alists_alist l, unsigned int n)
+{
+ while (l != NULL)
+ {
+ if (n <= l->noOfelements)
+ {
+ return l->elements.array[n-1];
+ }
+ else
+ {
+ n -= l->noOfelements;
+ }
+ l = l->next;
+ }
+ return reinterpret_cast<void *> (0);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getIndexOfList - returns the index for WORD, c, in alist, l.
+ If more than one WORD, c, exists the index
+ for the first is returned.
+*/
+
+extern "C" unsigned int alists_getIndexOfList (alists_alist l, void * c)
+{
+ unsigned int i;
+
+ if (l == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ i = 1;
+ while (i <= l->noOfelements)
+ {
+ if (l->elements.array[i-1] == c)
+ {
+ return i;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ return l->noOfelements+(alists_getIndexOfList (l->next, c));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ noOfItemsInList - returns the number of items in alist, l.
+*/
+
+extern "C" unsigned int alists_noOfItemsInList (alists_alist l)
+{
+ unsigned int t;
+
+ if (l == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ t = 0;
+ do {
+ t += l->noOfelements;
+ l = l->next;
+ } while (! (l == NULL));
+ return t;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ includeItemIntoList - adds an ADDRESS, c, into a alist providing
+ the value does not already exist.
+*/
+
+extern "C" void alists_includeItemIntoList (alists_alist l, void * c)
+{
+ if (! (alists_isItemInList (l, c)))
+ {
+ alists_putItemIntoList (l, c);
+ }
+}
+
+
+/*
+ removeItemFromList - removes a ADDRESS, c, from a alist.
+ It assumes that this value only appears once.
+*/
+
+extern "C" void alists_removeItemFromList (alists_alist l, void * c)
+{
+ alists_alist p;
+ unsigned int i;
+ unsigned int found;
+
+ if (l != NULL)
+ {
+ found = FALSE;
+ p = NULL;
+ do {
+ i = 1;
+ while ((i <= l->noOfelements) && (l->elements.array[i-1] != c))
+ {
+ i += 1;
+ }
+ if ((i <= l->noOfelements) && (l->elements.array[i-1] == c))
+ {
+ found = TRUE;
+ }
+ else
+ {
+ p = l;
+ l = l->next;
+ }
+ } while (! ((l == NULL) || found));
+ if (found)
+ {
+ removeItem (p, l, i);
+ }
+ }
+}
+
+
+/*
+ isItemInList - returns true if a ADDRESS, c, was found in alist, l.
+*/
+
+extern "C" unsigned int alists_isItemInList (alists_alist l, void * c)
+{
+ unsigned int i;
+
+ do {
+ i = 1;
+ while (i <= l->noOfelements)
+ {
+ if (l->elements.array[i-1] == c)
+ {
+ return TRUE;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ l = l->next;
+ } while (! (l == NULL));
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ foreachItemInListDo - calls procedure, P, foreach item in alist, l.
+*/
+
+extern "C" void alists_foreachItemInListDo (alists_alist l, alists_performOperation p)
+{
+ unsigned int i;
+ unsigned int n;
+
+ n = alists_noOfItemsInList (l);
+ i = 1;
+ while (i <= n)
+ {
+ (*p.proc) (alists_getItemFromList (l, i));
+ i += 1;
+ }
+}
+
+
+/*
+ duplicateList - returns a duplicate alist derived from, l.
+*/
+
+extern "C" alists_alist alists_duplicateList (alists_alist l)
+{
+ alists_alist m;
+ unsigned int n;
+ unsigned int i;
+
+ m = alists_initList ();
+ n = alists_noOfItemsInList (l);
+ i = 1;
+ while (i <= n)
+ {
+ alists_putItemIntoList (m, alists_getItemFromList (l, i));
+ i += 1;
+ }
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_alists_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_alists_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from decl. */
+/* decl.mod declaration nodes used to create the AST.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+typedef unsigned int nameKey_Name;
+
+# define nameKey_NulName 0
+typedef struct mcPretty_writeProc_p mcPretty_writeProc;
+
+typedef struct symbolKey__T8_r symbolKey__T8;
+
+typedef symbolKey__T8 *symbolKey_symbolTree;
+
+typedef struct mcPretty_writeLnProc_p mcPretty_writeLnProc;
+
+typedef unsigned int FIO_File;
+
+extern FIO_File FIO_StdOut;
+# define symbolKey_NulKey NULL
+typedef struct symbolKey_performOperation_p symbolKey_performOperation;
+
+# define ASCII_tab ASCII_ht
+typedef struct alists__T13_r alists__T13;
+
+typedef alists__T13 *alists_alist;
+
+typedef struct alists__T14_a alists__T14;
+
+# define ASCII_ht (char) 011
+# define ASCII_lf ASCII_nl
+# define ASCII_nl (char) 012
+typedef struct Indexing_IndexProcedure_p Indexing_IndexProcedure;
+
+typedef struct decl_isNodeF_p decl_isNodeF;
+
+# define SYSTEM_BITSPERBYTE 8
+# define SYSTEM_BYTESPERWORD 4
+typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
+
+typedef struct symbolKey_isSymbol_p symbolKey_isSymbol;
+
+# define ASCII_nul (char) 000
+# define ASCII_soh (char) 001
+# define ASCII_stx (char) 002
+# define ASCII_etx (char) 003
+# define ASCII_eot (char) 004
+# define ASCII_enq (char) 005
+# define ASCII_ack (char) 006
+# define ASCII_bel (char) 007
+# define ASCII_bs (char) 010
+# define ASCII_vt (char) 013
+# define ASCII_np (char) 014
+# define ASCII_cr (char) 015
+# define ASCII_so (char) 016
+# define ASCII_si (char) 017
+# define ASCII_dle (char) 020
+# define ASCII_dc1 (char) 021
+# define ASCII_dc2 (char) 022
+# define ASCII_dc3 (char) 023
+# define ASCII_dc4 (char) 024
+# define ASCII_nak (char) 025
+# define ASCII_syn (char) 026
+# define ASCII_etb (char) 027
+# define ASCII_can (char) 030
+# define ASCII_em (char) 031
+# define ASCII_sub (char) 032
+# define ASCII_esc (char) 033
+# define ASCII_fs (char) 034
+# define ASCII_gs (char) 035
+# define ASCII_rs (char) 036
+# define ASCII_us (char) 037
+# define ASCII_sp (char) 040
+# define ASCII_ff ASCII_np
+# define ASCII_eof ASCII_eot
+# define ASCII_del (char) 0177
+# define ASCII_EOL ASCII_nl
+extern FIO_File FIO_StdErr;
+extern FIO_File FIO_StdIn;
+typedef long int libc_time_t;
+
+typedef struct libc_tm_r libc_tm;
+
+typedef libc_tm *libc_ptrToTM;
+
+typedef struct libc_timeb_r libc_timeb;
+
+typedef struct libc_exitP_p libc_exitP;
+
+typedef struct mcError__T11_r mcError__T11;
+
+typedef mcError__T11 *mcError_error;
+
+extern int mcLexBuf_currentinteger;
+extern unsigned int mcLexBuf_currentcolumn;
+extern void * mcLexBuf_currentstring;
+typedef struct alists_performOperation_p alists_performOperation;
+
+typedef struct wlists_performOperation_p wlists_performOperation;
+
+typedef struct StdIO_ProcWrite_p StdIO_ProcWrite;
+
+typedef struct StdIO_ProcRead_p StdIO_ProcRead;
+
+# define indentation 3
+# define indentationC 2
+# define debugScopes FALSE
+# define debugDecl FALSE
+# define caseException TRUE
+# define returnException TRUE
+# define forceCompoundStatement TRUE
+# define enableDefForCStrings FALSE
+# define enableMemsetOnAllocation TRUE
+# define forceQualified TRUE
+typedef struct decl_nodeRec_r decl_nodeRec;
+
+typedef struct decl_intrinsicT_r decl_intrinsicT;
+
+typedef struct decl_fixupInfo_r decl_fixupInfo;
+
+typedef struct decl_explistT_r decl_explistT;
+
+typedef struct decl_setvalueT_r decl_setvalueT;
+
+typedef struct decl_identlistT_r decl_identlistT;
+
+typedef struct decl_funccallT_r decl_funccallT;
+
+typedef struct decl_commentT_r decl_commentT;
+
+typedef struct decl_stmtT_r decl_stmtT;
+
+typedef struct decl_returnT_r decl_returnT;
+
+typedef struct decl_exitT_r decl_exitT;
+
+typedef struct decl_vardeclT_r decl_vardeclT;
+
+typedef struct decl_typeT_r decl_typeT;
+
+typedef struct decl_recordT_r decl_recordT;
+
+typedef struct decl_varientT_r decl_varientT;
+
+typedef struct decl_varT_r decl_varT;
+
+typedef struct decl_enumerationT_r decl_enumerationT;
+
+typedef struct decl_subrangeT_r decl_subrangeT;
+
+typedef struct decl_subscriptT_r decl_subscriptT;
+
+typedef struct decl_arrayT_r decl_arrayT;
+
+typedef struct decl_stringT_r decl_stringT;
+
+typedef struct decl_literalT_r decl_literalT;
+
+typedef struct decl_constT_r decl_constT;
+
+typedef struct decl_varparamT_r decl_varparamT;
+
+typedef struct decl_paramT_r decl_paramT;
+
+typedef struct decl_varargsT_r decl_varargsT;
+
+typedef struct decl_optargT_r decl_optargT;
+
+typedef struct decl_pointerT_r decl_pointerT;
+
+typedef struct decl_recordfieldT_r decl_recordfieldT;
+
+typedef struct decl_varientfieldT_r decl_varientfieldT;
+
+typedef struct decl_enumerationfieldT_r decl_enumerationfieldT;
+
+typedef struct decl_setT_r decl_setT;
+
+typedef struct decl_componentrefT_r decl_componentrefT;
+
+typedef struct decl_pointerrefT_r decl_pointerrefT;
+
+typedef struct decl_arrayrefT_r decl_arrayrefT;
+
+typedef struct decl_commentPair_r decl_commentPair;
+
+typedef struct decl_assignmentT_r decl_assignmentT;
+
+typedef struct decl_ifT_r decl_ifT;
+
+typedef struct decl_elsifT_r decl_elsifT;
+
+typedef struct decl_loopT_r decl_loopT;
+
+typedef struct decl_whileT_r decl_whileT;
+
+typedef struct decl_repeatT_r decl_repeatT;
+
+typedef struct decl_caseT_r decl_caseT;
+
+typedef struct decl_caselabellistT_r decl_caselabellistT;
+
+typedef struct decl_caselistT_r decl_caselistT;
+
+typedef struct decl_rangeT_r decl_rangeT;
+
+typedef struct decl_forT_r decl_forT;
+
+typedef struct decl_statementT_r decl_statementT;
+
+typedef struct decl_scopeT_r decl_scopeT;
+
+typedef struct decl_procedureT_r decl_procedureT;
+
+typedef struct decl_proctypeT_r decl_proctypeT;
+
+typedef struct decl_binaryT_r decl_binaryT;
+
+typedef struct decl_unaryT_r decl_unaryT;
+
+typedef struct decl_moduleT_r decl_moduleT;
+
+typedef struct decl_defT_r decl_defT;
+
+typedef struct decl_impT_r decl_impT;
+
+typedef struct decl_where_r decl_where;
+
+typedef struct decl_nodeProcedure_p decl_nodeProcedure;
+
+typedef struct decl_cnameT_r decl_cnameT;
+
+# define MaxBuf 127
+# define maxNoOfElements 5
+typedef enum {decl_explist, decl_funccall, decl_exit, decl_return, decl_stmtseq, decl_comment, decl_halt, decl_new, decl_dispose, decl_inc, decl_dec, decl_incl, decl_excl, decl_length, decl_nil, decl_true, decl_false, decl_address, decl_loc, decl_byte, decl_word, decl_csizet, decl_cssizet, decl_char, decl_cardinal, decl_longcard, decl_shortcard, decl_integer, decl_longint, decl_shortint, decl_real, decl_longreal, decl_shortreal, decl_bitset, decl_boolean, decl_proc, decl_ztype, decl_rtype, decl_complex, decl_longcomplex, decl_shortcomplex, decl_type, decl_record, decl_varient, decl_var, decl_enumeration, decl_subrange, decl_array, decl_subscript, decl_string, decl_const, decl_literal, decl_varparam, decl_param, decl_varargs, decl_optarg, decl_pointer, decl_recordfield, decl_varientfield, decl_enumerationfield, decl_set, decl_proctype, decl_procedure, decl_def, decl_imp, decl_module, decl_loop, decl_while, decl_for, decl_repeat, decl_case, decl_caselabellist, decl_caselist, decl_range, decl_assignment, decl_if, decl_elsif, decl_constexp, decl_neg, decl_cast, decl_val, decl_plus, decl_sub, decl_div, decl_mod, decl_mult, decl_divide, decl_in, decl_adr, decl_size, decl_tsize, decl_ord, decl_float, decl_trunc, decl_chr, decl_abs, decl_cap, decl_high, decl_throw, decl_unreachable, decl_cmplx, decl_re, decl_im, decl_min, decl_max, decl_componentref, decl_pointerref, decl_arrayref, decl_deref, decl_equal, decl_notequal, decl_less, decl_greater, decl_greequal, decl_lessequal, decl_lsl, decl_lsr, decl_lor, decl_land, decl_lnot, decl_lxor, decl_and, decl_or, decl_not, decl_identlist, decl_vardecl, decl_setvalue} decl_nodeT;
+
+# define MaxnoOfelements 5
+typedef enum {mcReserved_eoftok, mcReserved_plustok, mcReserved_minustok, mcReserved_timestok, mcReserved_dividetok, mcReserved_becomestok, mcReserved_ambersandtok, mcReserved_periodtok, mcReserved_commatok, mcReserved_semicolontok, mcReserved_lparatok, mcReserved_rparatok, mcReserved_lsbratok, mcReserved_rsbratok, mcReserved_lcbratok, mcReserved_rcbratok, mcReserved_uparrowtok, mcReserved_singlequotetok, mcReserved_equaltok, mcReserved_hashtok, mcReserved_lesstok, mcReserved_greatertok, mcReserved_lessgreatertok, mcReserved_lessequaltok, mcReserved_greaterequaltok, mcReserved_ldirectivetok, mcReserved_rdirectivetok, mcReserved_periodperiodtok, mcReserved_colontok, mcReserved_doublequotestok, mcReserved_bartok, mcReserved_andtok, mcReserved_arraytok, mcReserved_begintok, mcReserved_bytok, mcReserved_casetok, mcReserved_consttok, mcReserved_definitiontok, mcReserved_divtok, mcReserved_dotok, mcReserved_elsetok, mcReserved_elsiftok, mcReserved_endtok, mcReserved_excepttok, mcReserved_exittok, mcReserved_exporttok, mcReserved_finallytok, mcReserved_fortok, mcReserved_fromtok, mcReserved_iftok, mcReserved_implementationtok, mcReserved_importtok, mcReserved_intok, mcReserved_looptok, mcReserved_modtok, mcReserved_moduletok, mcReserved_nottok, mcReserved_oftok, mcReserved_ortok, mcReserved_packedsettok, mcReserved_pointertok, mcReserved_proceduretok, mcReserved_qualifiedtok, mcReserved_unqualifiedtok, mcReserved_recordtok, mcReserved_remtok, mcReserved_repeattok, mcReserved_retrytok, mcReserved_returntok, mcReserved_settok, mcReserved_thentok, mcReserved_totok, mcReserved_typetok, mcReserved_untiltok, mcReserved_vartok, mcReserved_whiletok, mcReserved_withtok, mcReserved_asmtok, mcReserved_volatiletok, mcReserved_periodperiodperiodtok, mcReserved_datetok, mcReserved_linetok, mcReserved_filetok, mcReserved_attributetok, mcReserved_builtintok, mcReserved_inlinetok, mcReserved_integertok, mcReserved_identtok, mcReserved_realtok, mcReserved_stringtok, mcReserved_commenttok} mcReserved_toktype;
+
+extern mcReserved_toktype mcLexBuf_currenttoken;
+typedef enum {decl_ansiC, decl_ansiCP, decl_pim4} decl_language;
+
+typedef enum {decl_completed, decl_blocked, decl_partial, decl_recursive} decl_dependentState;
+
+typedef enum {decl_text, decl_punct, decl_space} decl_outputStates;
+
+typedef decl_nodeRec *decl_node;
+
+typedef struct Indexing__T5_r Indexing__T5;
+
+typedef struct mcComment__T6_r mcComment__T6;
+
+typedef enum {mcComment_unknown, mcComment_procedureHeading, mcComment_inBody, mcComment_afterStatement} mcComment_commentType;
+
+typedef struct DynamicStrings_stringRecord_r DynamicStrings_stringRecord;
+
+typedef struct DynamicStrings_Contents_r DynamicStrings_Contents;
+
+typedef struct wlists__T9_r wlists__T9;
+
+typedef struct mcPretty__T12_r mcPretty__T12;
+
+typedef struct wlists__T10_a wlists__T10;
+
+typedef struct DynamicStrings__T7_a DynamicStrings__T7;
+
+typedef Indexing__T5 *Indexing_Index;
+
+typedef mcComment__T6 *mcComment_commentDesc;
+
+extern mcComment_commentDesc mcLexBuf_currentcomment;
+extern mcComment_commentDesc mcLexBuf_lastcomment;
+typedef DynamicStrings_stringRecord *DynamicStrings_String;
+
+typedef wlists__T9 *wlists_wlist;
+
+typedef mcPretty__T12 *mcPretty_pretty;
+
+typedef void (*mcPretty_writeProc_t) (char);
+struct mcPretty_writeProc_p { mcPretty_writeProc_t proc; };
+
+struct symbolKey__T8_r {
+ nameKey_Name name;
+ void *key;
+ symbolKey_symbolTree left;
+ symbolKey_symbolTree right;
+ };
+
+typedef void (*mcPretty_writeLnProc_t) (void);
+struct mcPretty_writeLnProc_p { mcPretty_writeLnProc_t proc; };
+
+typedef void (*symbolKey_performOperation_t) (void *);
+struct symbolKey_performOperation_p { symbolKey_performOperation_t proc; };
+
+struct alists__T14_a { void * array[MaxnoOfelements-1+1]; };
+typedef void (*Indexing_IndexProcedure_t) (void *);
+struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; };
+
+typedef unsigned int (*decl_isNodeF_t) (decl_node);
+struct decl_isNodeF_p { decl_isNodeF_t proc; };
+
+typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
+struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
+
+typedef unsigned int (*symbolKey_isSymbol_t) (void *);
+struct symbolKey_isSymbol_p { symbolKey_isSymbol_t proc; };
+
+struct libc_tm_r {
+ int tm_sec;
+ int tm_min;
+ int tm_hour;
+ int tm_mday;
+ int tm_mon;
+ int tm_year;
+ int tm_wday;
+ int tm_yday;
+ int tm_isdst;
+ long int tm_gmtoff;
+ void *tm_zone;
+ };
+
+struct libc_timeb_r {
+ libc_time_t time_;
+ short unsigned int millitm;
+ short unsigned int timezone;
+ short unsigned int dstflag;
+ };
+
+typedef int (*libc_exitP_t) (void);
+typedef libc_exitP_t libc_exitP_C;
+
+struct libc_exitP_p { libc_exitP_t proc; };
+
+struct mcError__T11_r {
+ mcError_error parent;
+ mcError_error child;
+ mcError_error next;
+ unsigned int fatal;
+ DynamicStrings_String s;
+ unsigned int token;
+ };
+
+typedef void (*alists_performOperation_t) (void *);
+struct alists_performOperation_p { alists_performOperation_t proc; };
+
+typedef void (*wlists_performOperation_t) (unsigned int);
+struct wlists_performOperation_p { wlists_performOperation_t proc; };
+
+typedef void (*StdIO_ProcWrite_t) (char);
+struct StdIO_ProcWrite_p { StdIO_ProcWrite_t proc; };
+
+typedef void (*StdIO_ProcRead_t) (char *);
+struct StdIO_ProcRead_p { StdIO_ProcRead_t proc; };
+
+struct decl_fixupInfo_r {
+ unsigned int count;
+ Indexing_Index info;
+ };
+
+struct decl_explistT_r {
+ Indexing_Index exp;
+ };
+
+struct decl_setvalueT_r {
+ decl_node type;
+ Indexing_Index values;
+ };
+
+struct decl_identlistT_r {
+ wlists_wlist names;
+ unsigned int cnamed;
+ };
+
+struct decl_commentT_r {
+ mcComment_commentDesc content;
+ };
+
+struct decl_stmtT_r {
+ Indexing_Index statements;
+ };
+
+struct decl_exitT_r {
+ decl_node loop;
+ };
+
+struct decl_vardeclT_r {
+ wlists_wlist names;
+ decl_node type;
+ decl_node scope;
+ };
+
+struct decl_typeT_r {
+ nameKey_Name name;
+ decl_node type;
+ decl_node scope;
+ unsigned int isHidden;
+ unsigned int isInternal;
+ };
+
+struct decl_recordT_r {
+ symbolKey_symbolTree localSymbols;
+ Indexing_Index listOfSons;
+ decl_node scope;
+ };
+
+struct decl_varientT_r {
+ Indexing_Index listOfSons;
+ decl_node varient;
+ decl_node tag;
+ decl_node scope;
+ };
+
+struct decl_enumerationT_r {
+ unsigned int noOfElements;
+ symbolKey_symbolTree localSymbols;
+ Indexing_Index listOfSons;
+ decl_node low;
+ decl_node high;
+ decl_node scope;
+ };
+
+struct decl_subrangeT_r {
+ decl_node low;
+ decl_node high;
+ decl_node type;
+ decl_node scope;
+ };
+
+struct decl_subscriptT_r {
+ decl_node type;
+ decl_node expr;
+ };
+
+struct decl_arrayT_r {
+ decl_node subr;
+ decl_node type;
+ decl_node scope;
+ unsigned int isUnbounded;
+ };
+
+struct decl_stringT_r {
+ nameKey_Name name;
+ unsigned int length;
+ unsigned int isCharCompatible;
+ DynamicStrings_String cstring;
+ unsigned int clength;
+ DynamicStrings_String cchar;
+ };
+
+struct decl_literalT_r {
+ nameKey_Name name;
+ decl_node type;
+ };
+
+struct decl_constT_r {
+ nameKey_Name name;
+ decl_node type;
+ decl_node value;
+ decl_node scope;
+ };
+
+struct decl_varparamT_r {
+ decl_node namelist;
+ decl_node type;
+ decl_node scope;
+ unsigned int isUnbounded;
+ unsigned int isForC;
+ unsigned int isUsed;
+ };
+
+struct decl_paramT_r {
+ decl_node namelist;
+ decl_node type;
+ decl_node scope;
+ unsigned int isUnbounded;
+ unsigned int isForC;
+ unsigned int isUsed;
+ };
+
+struct decl_varargsT_r {
+ decl_node scope;
+ };
+
+struct decl_optargT_r {
+ decl_node namelist;
+ decl_node type;
+ decl_node scope;
+ decl_node init;
+ };
+
+struct decl_pointerT_r {
+ decl_node type;
+ decl_node scope;
+ };
+
+struct decl_varientfieldT_r {
+ nameKey_Name name;
+ decl_node parent;
+ decl_node varient;
+ unsigned int simple;
+ Indexing_Index listOfSons;
+ decl_node scope;
+ };
+
+struct decl_setT_r {
+ decl_node type;
+ decl_node scope;
+ };
+
+struct decl_componentrefT_r {
+ decl_node rec;
+ decl_node field;
+ decl_node resultType;
+ };
+
+struct decl_pointerrefT_r {
+ decl_node ptr;
+ decl_node field;
+ decl_node resultType;
+ };
+
+struct decl_arrayrefT_r {
+ decl_node array;
+ decl_node index;
+ decl_node resultType;
+ };
+
+struct decl_commentPair_r {
+ decl_node after;
+ decl_node body;
+ };
+
+struct decl_loopT_r {
+ decl_node statements;
+ unsigned int labelno;
+ };
+
+struct decl_caseT_r {
+ decl_node expression;
+ Indexing_Index caseLabelList;
+ decl_node else_;
+ };
+
+struct decl_caselabellistT_r {
+ decl_node caseList;
+ decl_node statements;
+ };
+
+struct decl_caselistT_r {
+ Indexing_Index rangePairs;
+ };
+
+struct decl_rangeT_r {
+ decl_node lo;
+ decl_node hi;
+ };
+
+struct decl_forT_r {
+ decl_node des;
+ decl_node start;
+ decl_node end;
+ decl_node increment;
+ decl_node statements;
+ };
+
+struct decl_statementT_r {
+ Indexing_Index sequence;
+ };
+
+struct decl_scopeT_r {
+ symbolKey_symbolTree symbols;
+ Indexing_Index constants;
+ Indexing_Index types;
+ Indexing_Index procedures;
+ Indexing_Index variables;
+ };
+
+struct decl_proctypeT_r {
+ Indexing_Index parameters;
+ unsigned int returnopt;
+ unsigned int vararg;
+ decl_node optarg_;
+ decl_node scope;
+ decl_node returnType;
+ };
+
+struct decl_binaryT_r {
+ decl_node left;
+ decl_node right;
+ decl_node resultType;
+ };
+
+struct decl_unaryT_r {
+ decl_node arg;
+ decl_node resultType;
+ };
+
+struct decl_where_r {
+ unsigned int defDeclared;
+ unsigned int modDeclared;
+ unsigned int firstUsed;
+ };
+
+typedef void (*decl_nodeProcedure_t) (decl_node);
+struct decl_nodeProcedure_p { decl_nodeProcedure_t proc; };
+
+struct decl_cnameT_r {
+ nameKey_Name name;
+ unsigned int init;
+ };
+
+struct Indexing__T5_r {
+ void *ArrayStart;
+ unsigned int ArraySize;
+ unsigned int Used;
+ unsigned int Low;
+ unsigned int High;
+ unsigned int Debug;
+ unsigned int Map;
+ };
+
+struct mcComment__T6_r {
+ mcComment_commentType type;
+ DynamicStrings_String content;
+ nameKey_Name procName;
+ unsigned int used;
+ };
+
+struct wlists__T10_a { unsigned int array[maxNoOfElements-1+1]; };
+struct DynamicStrings__T7_a { char array[(MaxBuf-1)+1]; };
+struct alists__T13_r {
+ unsigned int noOfelements;
+ alists__T14 elements;
+ alists_alist next;
+ };
+
+struct decl_intrinsicT_r {
+ decl_node args;
+ unsigned int noArgs;
+ decl_node type;
+ decl_commentPair intrinsicComment;
+ unsigned int postUnreachable;
+ };
+
+struct decl_funccallT_r {
+ decl_node function;
+ decl_node args;
+ decl_node type;
+ decl_commentPair funccallComment;
+ };
+
+struct decl_returnT_r {
+ decl_node exp;
+ decl_node scope;
+ decl_commentPair returnComment;
+ };
+
+struct decl_varT_r {
+ nameKey_Name name;
+ decl_node type;
+ decl_node decl;
+ decl_node scope;
+ unsigned int isInitialised;
+ unsigned int isParameter;
+ unsigned int isVarParameter;
+ unsigned int isUsed;
+ decl_cnameT cname;
+ };
+
+struct decl_recordfieldT_r {
+ nameKey_Name name;
+ decl_node type;
+ unsigned int tag;
+ decl_node parent;
+ decl_node varient;
+ decl_node scope;
+ decl_cnameT cname;
+ };
+
+struct decl_enumerationfieldT_r {
+ nameKey_Name name;
+ decl_node type;
+ decl_node scope;
+ unsigned int value;
+ decl_cnameT cname;
+ };
+
+struct decl_assignmentT_r {
+ decl_node des;
+ decl_node expr;
+ decl_commentPair assignComment;
+ };
+
+struct decl_ifT_r {
+ decl_node expr;
+ decl_node elsif;
+ decl_node then;
+ decl_node else_;
+ decl_commentPair ifComment;
+ decl_commentPair elseComment;
+ decl_commentPair endComment;
+ };
+
+struct decl_elsifT_r {
+ decl_node expr;
+ decl_node elsif;
+ decl_node then;
+ decl_node else_;
+ decl_commentPair elseComment;
+ };
+
+struct decl_whileT_r {
+ decl_node expr;
+ decl_node statements;
+ decl_commentPair doComment;
+ decl_commentPair endComment;
+ };
+
+struct decl_repeatT_r {
+ decl_node expr;
+ decl_node statements;
+ decl_commentPair repeatComment;
+ decl_commentPair untilComment;
+ };
+
+struct decl_procedureT_r {
+ nameKey_Name name;
+ decl_scopeT decls;
+ decl_node scope;
+ Indexing_Index parameters;
+ unsigned int isForC;
+ unsigned int built;
+ unsigned int checking;
+ unsigned int returnopt;
+ unsigned int vararg;
+ unsigned int noreturnused;
+ unsigned int noreturn;
+ unsigned int paramcount;
+ decl_node optarg_;
+ decl_node returnType;
+ decl_node beginStatements;
+ decl_cnameT cname;
+ mcComment_commentDesc defComment;
+ mcComment_commentDesc modComment;
+ };
+
+struct decl_moduleT_r {
+ nameKey_Name name;
+ nameKey_Name source;
+ Indexing_Index importedModules;
+ decl_fixupInfo constFixup;
+ decl_fixupInfo enumFixup;
+ decl_scopeT decls;
+ decl_node beginStatements;
+ decl_node finallyStatements;
+ unsigned int enumsComplete;
+ unsigned int constsComplete;
+ unsigned int visited;
+ decl_commentPair com;
+ };
+
+struct decl_defT_r {
+ nameKey_Name name;
+ nameKey_Name source;
+ unsigned int hasHidden;
+ unsigned int forC;
+ Indexing_Index exported;
+ Indexing_Index importedModules;
+ decl_fixupInfo constFixup;
+ decl_fixupInfo enumFixup;
+ decl_scopeT decls;
+ unsigned int enumsComplete;
+ unsigned int constsComplete;
+ unsigned int visited;
+ decl_commentPair com;
+ };
+
+struct decl_impT_r {
+ nameKey_Name name;
+ nameKey_Name source;
+ Indexing_Index importedModules;
+ decl_fixupInfo constFixup;
+ decl_fixupInfo enumFixup;
+ decl_node beginStatements;
+ decl_node finallyStatements;
+ decl_node definitionModule;
+ decl_scopeT decls;
+ unsigned int enumsComplete;
+ unsigned int constsComplete;
+ unsigned int visited;
+ decl_commentPair com;
+ };
+
+struct DynamicStrings_Contents_r {
+ DynamicStrings__T7 buf;
+ unsigned int len;
+ DynamicStrings_String next;
+ };
+
+struct wlists__T9_r {
+ unsigned int noOfElements;
+ wlists__T10 elements;
+ wlists_wlist next;
+ };
+
+struct mcPretty__T12_r {
+ mcPretty_writeProc write_;
+ mcPretty_writeLnProc writeln;
+ unsigned int needsSpace;
+ unsigned int needsIndent;
+ unsigned int seekPos;
+ unsigned int curLine;
+ unsigned int curPos;
+ unsigned int indent;
+ mcPretty_pretty stacked;
+ };
+
+typedef struct DynamicStrings_descriptor_r DynamicStrings_descriptor;
+
+typedef DynamicStrings_descriptor *DynamicStrings_Descriptor;
+
+typedef struct DynamicStrings_DebugInfo_r DynamicStrings_DebugInfo;
+
+typedef enum {DynamicStrings_inuse, DynamicStrings_marked, DynamicStrings_onlist, DynamicStrings_poisoned} DynamicStrings_desState;
+
+struct DynamicStrings_descriptor_r {
+ unsigned int charStarUsed;
+ void *charStar;
+ unsigned int charStarSize;
+ unsigned int charStarValid;
+ DynamicStrings_desState state;
+ DynamicStrings_String garbage;
+ };
+
+struct DynamicStrings_DebugInfo_r {
+ DynamicStrings_String next;
+ void *file;
+ unsigned int line;
+ void *proc;
+ };
+
+struct decl_nodeRec_r {
+ decl_nodeT kind; /* case tag */
+ union {
+ decl_intrinsicT intrinsicF;
+ decl_explistT explistF;
+ decl_exitT exitF;
+ decl_returnT returnF;
+ decl_stmtT stmtF;
+ decl_commentT commentF;
+ decl_typeT typeF;
+ decl_recordT recordF;
+ decl_varientT varientF;
+ decl_varT varF;
+ decl_enumerationT enumerationF;
+ decl_subrangeT subrangeF;
+ decl_subscriptT subscriptF;
+ decl_arrayT arrayF;
+ decl_stringT stringF;
+ decl_constT constF;
+ decl_literalT literalF;
+ decl_varparamT varparamF;
+ decl_paramT paramF;
+ decl_varargsT varargsF;
+ decl_optargT optargF;
+ decl_pointerT pointerF;
+ decl_recordfieldT recordfieldF;
+ decl_varientfieldT varientfieldF;
+ decl_enumerationfieldT enumerationfieldF;
+ decl_setT setF;
+ decl_proctypeT proctypeF;
+ decl_procedureT procedureF;
+ decl_defT defF;
+ decl_impT impF;
+ decl_moduleT moduleF;
+ decl_loopT loopF;
+ decl_whileT whileF;
+ decl_forT forF;
+ decl_repeatT repeatF;
+ decl_caseT caseF;
+ decl_caselabellistT caselabellistF;
+ decl_caselistT caselistF;
+ decl_rangeT rangeF;
+ decl_ifT ifF;
+ decl_elsifT elsifF;
+ decl_assignmentT assignmentF;
+ decl_arrayrefT arrayrefF;
+ decl_pointerrefT pointerrefF;
+ decl_componentrefT componentrefF;
+ decl_binaryT binaryF;
+ decl_unaryT unaryF;
+ decl_identlistT identlistF;
+ decl_vardeclT vardeclF;
+ decl_funccallT funccallF;
+ decl_setvalueT setvalueF;
+ };
+ decl_where at;
+ };
+
+struct DynamicStrings_stringRecord_r {
+ DynamicStrings_Contents contents;
+ DynamicStrings_Descriptor head;
+ DynamicStrings_DebugInfo debug;
+ };
+
+static FIO_File outputFile;
+static decl_language lang;
+static decl_node bitsperunitN;
+static decl_node bitsperwordN;
+static decl_node bitspercharN;
+static decl_node unitsperwordN;
+static decl_node mainModule;
+static decl_node currentModule;
+static decl_node defModule;
+static decl_node systemN;
+static decl_node addressN;
+static decl_node locN;
+static decl_node byteN;
+static decl_node wordN;
+static decl_node csizetN;
+static decl_node cssizetN;
+static decl_node adrN;
+static decl_node sizeN;
+static decl_node tsizeN;
+static decl_node newN;
+static decl_node disposeN;
+static decl_node lengthN;
+static decl_node incN;
+static decl_node decN;
+static decl_node inclN;
+static decl_node exclN;
+static decl_node highN;
+static decl_node m2rtsN;
+static decl_node haltN;
+static decl_node throwN;
+static decl_node chrN;
+static decl_node capN;
+static decl_node absN;
+static decl_node floatN;
+static decl_node truncN;
+static decl_node ordN;
+static decl_node valN;
+static decl_node minN;
+static decl_node maxN;
+static decl_node booleanN;
+static decl_node procN;
+static decl_node charN;
+static decl_node integerN;
+static decl_node cardinalN;
+static decl_node longcardN;
+static decl_node shortcardN;
+static decl_node longintN;
+static decl_node shortintN;
+static decl_node bitsetN;
+static decl_node bitnumN;
+static decl_node ztypeN;
+static decl_node rtypeN;
+static decl_node complexN;
+static decl_node longcomplexN;
+static decl_node shortcomplexN;
+static decl_node cmplxN;
+static decl_node reN;
+static decl_node imN;
+static decl_node realN;
+static decl_node longrealN;
+static decl_node shortrealN;
+static decl_node nilN;
+static decl_node trueN;
+static decl_node falseN;
+static Indexing_Index scopeStack;
+static Indexing_Index defUniverseI;
+static Indexing_Index modUniverseI;
+static symbolKey_symbolTree modUniverse;
+static symbolKey_symbolTree defUniverse;
+static symbolKey_symbolTree baseSymbols;
+static decl_outputStates outputState;
+static mcPretty_pretty doP;
+static alists_alist todoQ;
+static alists_alist partialQ;
+static alists_alist doneQ;
+static unsigned int mustVisitScope;
+static unsigned int simplified;
+static unsigned int tempCount;
+static decl_node globalNode;
+extern "C" void SYSTEM_ShiftVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int ShiftCount);
+extern "C" void SYSTEM_ShiftLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount);
+extern "C" void SYSTEM_ShiftRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int ShiftCount);
+extern "C" void SYSTEM_RotateVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int RotateCount);
+extern "C" void SYSTEM_RotateLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
+extern "C" void SYSTEM_RotateRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
+extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p);
+extern "C" void M2RTS_ExecuteInitialProcedures (void);
+extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p);
+extern "C" void M2RTS_ExecuteTerminationProcedures (void);
+extern "C" void M2RTS_Terminate (void) __attribute__ ((noreturn));
+extern "C" void M2RTS_HALT (int exitcode) __attribute__ ((noreturn));
+extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn));
+extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) __attribute__ ((noreturn));
+extern "C" void M2RTS_ExitOnHalt (int e);
+extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high) __attribute__ ((noreturn));
+extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high);
+extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+
+/*
+ getDeclaredMod - returns the token number associated with the nodes declaration
+ in the implementation or program module.
+*/
+
+extern "C" unsigned int decl_getDeclaredMod (decl_node n);
+
+/*
+ getDeclaredDef - returns the token number associated with the nodes declaration
+ in the definition module.
+*/
+
+extern "C" unsigned int decl_getDeclaredDef (decl_node n);
+
+/*
+ getFirstUsed - returns the token number associated with the first use of
+ node, n.
+*/
+
+extern "C" unsigned int decl_getFirstUsed (decl_node n);
+
+/*
+ isDef - return TRUE if node, n, is a definition module.
+*/
+
+extern "C" unsigned int decl_isDef (decl_node n);
+
+/*
+ isImp - return TRUE if node, n, is an implementation module.
+*/
+
+extern "C" unsigned int decl_isImp (decl_node n);
+
+/*
+ isImpOrModule - returns TRUE if, n, is a program module or implementation module.
+*/
+
+extern "C" unsigned int decl_isImpOrModule (decl_node n);
+
+/*
+ isVisited - returns TRUE if the node was visited.
+*/
+
+extern "C" unsigned int decl_isVisited (decl_node n);
+
+/*
+ unsetVisited - unset the visited flag on a def/imp/module node.
+*/
+
+extern "C" void decl_unsetVisited (decl_node n);
+
+/*
+ setVisited - set the visited flag on a def/imp/module node.
+*/
+
+extern "C" void decl_setVisited (decl_node n);
+
+/*
+ setEnumsComplete - sets the field inside the def or imp or module, n.
+*/
+
+extern "C" void decl_setEnumsComplete (decl_node n);
+
+/*
+ getEnumsComplete - gets the field from the def or imp or module, n.
+*/
+
+extern "C" unsigned int decl_getEnumsComplete (decl_node n);
+
+/*
+ resetEnumPos - resets the index into the saved list of enums inside
+ module, n.
+*/
+
+extern "C" void decl_resetEnumPos (decl_node n);
+
+/*
+ getNextEnum - returns the next enumeration node.
+*/
+
+extern "C" decl_node decl_getNextEnum (void);
+
+/*
+ isModule - return TRUE if node, n, is a program module.
+*/
+
+extern "C" unsigned int decl_isModule (decl_node n);
+
+/*
+ isMainModule - return TRUE if node, n, is the main module specified
+ by the source file. This might be a definition,
+ implementation or program module.
+*/
+
+extern "C" unsigned int decl_isMainModule (decl_node n);
+
+/*
+ setMainModule - sets node, n, as the main module to be compiled.
+*/
+
+extern "C" void decl_setMainModule (decl_node n);
+
+/*
+ setCurrentModule - sets node, n, as the current module being compiled.
+*/
+
+extern "C" void decl_setCurrentModule (decl_node n);
+
+/*
+ lookupDef - returns a definition module node named, n.
+*/
+
+extern "C" decl_node decl_lookupDef (nameKey_Name n);
+
+/*
+ lookupImp - returns an implementation module node named, n.
+*/
+
+extern "C" decl_node decl_lookupImp (nameKey_Name n);
+
+/*
+ lookupModule - returns a module node named, n.
+*/
+
+extern "C" decl_node decl_lookupModule (nameKey_Name n);
+
+/*
+ putDefForC - the definition module was defined FOR "C".
+*/
+
+extern "C" void decl_putDefForC (decl_node n);
+
+/*
+ lookupInScope - looks up a symbol named, n, from, scope.
+*/
+
+extern "C" decl_node decl_lookupInScope (decl_node scope, nameKey_Name n);
+
+/*
+ isConst - returns TRUE if node, n, is a const.
+*/
+
+extern "C" unsigned int decl_isConst (decl_node n);
+
+/*
+ isType - returns TRUE if node, n, is a type.
+*/
+
+extern "C" unsigned int decl_isType (decl_node n);
+
+/*
+ putType - places, exp, as the type alias to des.
+ TYPE des = exp ;
+*/
+
+extern "C" void decl_putType (decl_node des, decl_node exp);
+
+/*
+ getType - returns the type associated with node, n.
+*/
+
+extern "C" decl_node decl_getType (decl_node n);
+
+/*
+ skipType - skips over type aliases.
+*/
+
+extern "C" decl_node decl_skipType (decl_node n);
+
+/*
+ putTypeHidden - marks type, des, as being a hidden type.
+ TYPE des ;
+*/
+
+extern "C" void decl_putTypeHidden (decl_node des);
+
+/*
+ isTypeHidden - returns TRUE if type, n, is hidden.
+*/
+
+extern "C" unsigned int decl_isTypeHidden (decl_node n);
+
+/*
+ hasHidden - returns TRUE if module, n, has a hidden type.
+*/
+
+extern "C" unsigned int decl_hasHidden (decl_node n);
+
+/*
+ isVar - returns TRUE if node, n, is a type.
+*/
+
+extern "C" unsigned int decl_isVar (decl_node n);
+
+/*
+ isTemporary - returns TRUE if node, n, is a variable and temporary.
+*/
+
+extern "C" unsigned int decl_isTemporary (decl_node n);
+
+/*
+ isExported - returns TRUE if symbol, n, is exported from
+ the definition module.
+*/
+
+extern "C" unsigned int decl_isExported (decl_node n);
+
+/*
+ getDeclScope - returns the node representing the
+ current declaration scope.
+*/
+
+extern "C" decl_node decl_getDeclScope (void);
+
+/*
+ getScope - returns the scope associated with node, n.
+*/
+
+extern "C" decl_node decl_getScope (decl_node n);
+
+/*
+ isLiteral - returns TRUE if, n, is a literal.
+*/
+
+extern "C" unsigned int decl_isLiteral (decl_node n);
+
+/*
+ isConstSet - returns TRUE if, n, is a constant set.
+*/
+
+extern "C" unsigned int decl_isConstSet (decl_node n);
+
+/*
+ isEnumerationField - returns TRUE if, n, is an enumeration field.
+*/
+
+extern "C" unsigned int decl_isEnumerationField (decl_node n);
+
+/*
+ isEnumeration - returns TRUE if node, n, is an enumeration type.
+*/
+
+extern "C" unsigned int decl_isEnumeration (decl_node n);
+
+/*
+ isUnbounded - returns TRUE if, n, is an unbounded array.
+*/
+
+extern "C" unsigned int decl_isUnbounded (decl_node n);
+
+/*
+ isParameter - returns TRUE if, n, is a parameter.
+*/
+
+extern "C" unsigned int decl_isParameter (decl_node n);
+
+/*
+ isVarParam - returns TRUE if, n, is a var parameter.
+*/
+
+extern "C" unsigned int decl_isVarParam (decl_node n);
+
+/*
+ isParam - returns TRUE if, n, is a non var parameter.
+*/
+
+extern "C" unsigned int decl_isParam (decl_node n);
+
+/*
+ isNonVarParam - is an alias to isParam.
+*/
+
+extern "C" unsigned int decl_isNonVarParam (decl_node n);
+
+/*
+ addOptParameter - returns an optarg which has been created and added to
+ procedure node, proc. It has a name, id, and, type,
+ and an initial value, init.
+*/
+
+extern "C" decl_node decl_addOptParameter (decl_node proc, nameKey_Name id, decl_node type, decl_node init);
+
+/*
+ isOptarg - returns TRUE if, n, is an optarg.
+*/
+
+extern "C" unsigned int decl_isOptarg (decl_node n);
+
+/*
+ isRecord - returns TRUE if, n, is a record.
+*/
+
+extern "C" unsigned int decl_isRecord (decl_node n);
+
+/*
+ isRecordField - returns TRUE if, n, is a record field.
+*/
+
+extern "C" unsigned int decl_isRecordField (decl_node n);
+
+/*
+ isVarientField - returns TRUE if, n, is a varient field.
+*/
+
+extern "C" unsigned int decl_isVarientField (decl_node n);
+
+/*
+ isArray - returns TRUE if, n, is an array.
+*/
+
+extern "C" unsigned int decl_isArray (decl_node n);
+
+/*
+ isProcType - returns TRUE if, n, is a procedure type.
+*/
+
+extern "C" unsigned int decl_isProcType (decl_node n);
+
+/*
+ isPointer - returns TRUE if, n, is a pointer.
+*/
+
+extern "C" unsigned int decl_isPointer (decl_node n);
+
+/*
+ isProcedure - returns TRUE if, n, is a procedure.
+*/
+
+extern "C" unsigned int decl_isProcedure (decl_node n);
+
+/*
+ isVarient - returns TRUE if, n, is a varient record.
+*/
+
+extern "C" unsigned int decl_isVarient (decl_node n);
+
+/*
+ isSet - returns TRUE if, n, is a set type.
+*/
+
+extern "C" unsigned int decl_isSet (decl_node n);
+
+/*
+ isSubrange - returns TRUE if, n, is a subrange type.
+*/
+
+extern "C" unsigned int decl_isSubrange (decl_node n);
+
+/*
+ isZtype - returns TRUE if, n, is the Z type.
+*/
+
+extern "C" unsigned int decl_isZtype (decl_node n);
+
+/*
+ isRtype - returns TRUE if, n, is the R type.
+*/
+
+extern "C" unsigned int decl_isRtype (decl_node n);
+
+/*
+ makeConst - create, initialise and return a const node.
+*/
+
+extern "C" decl_node decl_makeConst (nameKey_Name n);
+
+/*
+ putConst - places value, v, into node, n.
+*/
+
+extern "C" void decl_putConst (decl_node n, decl_node v);
+
+/*
+ makeType - create, initialise and return a type node.
+*/
+
+extern "C" decl_node decl_makeType (nameKey_Name n);
+
+/*
+ makeTypeImp - lookup a type in the definition module
+ and return it. Otherwise create a new type.
+*/
+
+extern "C" decl_node decl_makeTypeImp (nameKey_Name n);
+
+/*
+ makeVar - create, initialise and return a var node.
+*/
+
+extern "C" decl_node decl_makeVar (nameKey_Name n);
+
+/*
+ putVar - places, type, as the type for var.
+*/
+
+extern "C" void decl_putVar (decl_node var, decl_node type, decl_node decl);
+
+/*
+ makeVarDecl - create a vardecl node and create a shadow variable in the
+ current scope.
+*/
+
+extern "C" decl_node decl_makeVarDecl (decl_node i, decl_node type);
+
+/*
+ makeEnum - creates an enumerated type and returns the node.
+*/
+
+extern "C" decl_node decl_makeEnum (void);
+
+/*
+ makeEnumField - returns an enumeration field, named, n.
+*/
+
+extern "C" decl_node decl_makeEnumField (decl_node e, nameKey_Name n);
+
+/*
+ makeSubrange - returns a subrange node, built from range: low..high.
+*/
+
+extern "C" decl_node decl_makeSubrange (decl_node low, decl_node high);
+
+/*
+ putSubrangeType - assigns, type, to the subrange type, sub.
+*/
+
+extern "C" void decl_putSubrangeType (decl_node sub, decl_node type);
+
+/*
+ makePointer - returns a pointer of, type, node.
+*/
+
+extern "C" decl_node decl_makePointer (decl_node type);
+
+/*
+ makeSet - returns a set of, type, node.
+*/
+
+extern "C" decl_node decl_makeSet (decl_node type);
+
+/*
+ makeArray - returns a node representing ARRAY subr OF type.
+*/
+
+extern "C" decl_node decl_makeArray (decl_node subr, decl_node type);
+
+/*
+ putUnbounded - sets array, n, as unbounded.
+*/
+
+extern "C" void decl_putUnbounded (decl_node n);
+
+/*
+ makeRecord - creates and returns a record node.
+*/
+
+extern "C" decl_node decl_makeRecord (void);
+
+/*
+ makeVarient - creates a new symbol, a varient symbol for record or varient field
+ symbol, r.
+*/
+
+extern "C" decl_node decl_makeVarient (decl_node r);
+
+/*
+ addFieldsToRecord - adds fields, i, of type, t, into a record, r.
+ It returns, r.
+*/
+
+extern "C" decl_node decl_addFieldsToRecord (decl_node r, decl_node v, decl_node i, decl_node t);
+
+/*
+ buildVarientSelector - builds a field of name, tag, of, type onto:
+ record or varient field, r.
+ varient, v.
+*/
+
+extern "C" void decl_buildVarientSelector (decl_node r, decl_node v, nameKey_Name tag, decl_node type);
+
+/*
+ buildVarientFieldRecord - builds a varient field into a varient symbol, v.
+ The varient field is returned.
+*/
+
+extern "C" decl_node decl_buildVarientFieldRecord (decl_node v, decl_node p);
+
+/*
+ getSymName - returns the name of symbol, n.
+*/
+
+extern "C" nameKey_Name decl_getSymName (decl_node n);
+
+/*
+ import - attempts to add node, n, into the scope of module, m.
+ It might fail due to a name clash in which case the
+ previous named symbol is returned. On success, n,
+ is returned.
+*/
+
+extern "C" decl_node decl_import (decl_node m, decl_node n);
+
+/*
+ lookupExported - attempts to lookup a node named, i, from definition
+ module, n. The node is returned if found.
+ NIL is returned if not found.
+*/
+
+extern "C" decl_node decl_lookupExported (decl_node n, nameKey_Name i);
+
+/*
+ lookupSym - returns the symbol named, n, from the scope stack.
+*/
+
+extern "C" decl_node decl_lookupSym (nameKey_Name n);
+
+/*
+ addImportedModule - add module, i, to be imported by, m.
+ If scoped then module, i, is added to the
+ module, m, scope.
+*/
+
+extern "C" void decl_addImportedModule (decl_node m, decl_node i, unsigned int scoped);
+
+/*
+ setSource - sets the source filename for module, n, to s.
+*/
+
+extern "C" void decl_setSource (decl_node n, nameKey_Name s);
+
+/*
+ getSource - returns the source filename for module, n.
+*/
+
+extern "C" nameKey_Name decl_getSource (decl_node n);
+
+/*
+ getMainModule - returns the main module node.
+*/
+
+extern "C" decl_node decl_getMainModule (void);
+
+/*
+ getCurrentModule - returns the current module being compiled.
+*/
+
+extern "C" decl_node decl_getCurrentModule (void);
+
+/*
+ foreachDefModuleDo - foreach definition node, n, in the module universe,
+ call p (n).
+*/
+
+extern "C" void decl_foreachDefModuleDo (symbolKey_performOperation p);
+
+/*
+ foreachModModuleDo - foreach implementation or module node, n, in the module universe,
+ call p (n).
+*/
+
+extern "C" void decl_foreachModModuleDo (symbolKey_performOperation p);
+
+/*
+ enterScope - pushes symbol, n, to the scope stack.
+*/
+
+extern "C" void decl_enterScope (decl_node n);
+
+/*
+ leaveScope - removes the top level scope.
+*/
+
+extern "C" void decl_leaveScope (void);
+
+/*
+ makeProcedure - create, initialise and return a procedure node.
+*/
+
+extern "C" decl_node decl_makeProcedure (nameKey_Name n);
+
+/*
+ putCommentDefProcedure - remembers the procedure comment (if it exists) as a
+ definition module procedure heading. NIL is placed
+ if there is no procedure comment available.
+*/
+
+extern "C" void decl_putCommentDefProcedure (decl_node n);
+
+/*
+ putCommentModProcedure - remembers the procedure comment (if it exists) as an
+ implementation/program module procedure heading. NIL is placed
+ if there is no procedure comment available.
+*/
+
+extern "C" void decl_putCommentModProcedure (decl_node n);
+
+/*
+ makeProcType - returns a proctype node.
+*/
+
+extern "C" decl_node decl_makeProcType (void);
+
+/*
+ putReturnType - sets the return type of procedure or proctype, proc, to, type.
+*/
+
+extern "C" void decl_putReturnType (decl_node proc, decl_node type);
+
+/*
+ putOptReturn - sets, proctype or procedure, proc, to have an optional return type.
+*/
+
+extern "C" void decl_putOptReturn (decl_node proc);
+
+/*
+ makeVarParameter - returns a var parameter node with, name: type.
+*/
+
+extern "C" decl_node decl_makeVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused);
+
+/*
+ makeNonVarParameter - returns a non var parameter node with, name: type.
+*/
+
+extern "C" decl_node decl_makeNonVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused);
+
+/*
+ paramEnter - reset the parameter count.
+*/
+
+extern "C" void decl_paramEnter (decl_node n);
+
+/*
+ paramLeave - set paramater checking to TRUE from now onwards.
+*/
+
+extern "C" void decl_paramLeave (decl_node n);
+
+/*
+ makeIdentList - returns a node which will be used to maintain an ident list.
+*/
+
+extern "C" decl_node decl_makeIdentList (void);
+
+/*
+ putIdent - places ident, i, into identlist, n. It returns TRUE if
+ ident, i, is unique.
+*/
+
+extern "C" unsigned int decl_putIdent (decl_node n, nameKey_Name i);
+
+/*
+ addVarParameters - adds the identlist, i, of, type, to be VAR parameters
+ in procedure, n.
+*/
+
+extern "C" void decl_addVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused);
+
+/*
+ addNonVarParameters - adds the identlist, i, of, type, to be parameters
+ in procedure, n.
+*/
+
+extern "C" void decl_addNonVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused);
+
+/*
+ makeVarargs - returns a varargs node.
+*/
+
+extern "C" decl_node decl_makeVarargs (void);
+
+/*
+ isVarargs - returns TRUE if, n, is a varargs node.
+*/
+
+extern "C" unsigned int decl_isVarargs (decl_node n);
+
+/*
+ addParameter - adds a parameter, param, to procedure or proctype, proc.
+*/
+
+extern "C" void decl_addParameter (decl_node proc, decl_node param);
+
+/*
+ makeBinaryTok - creates and returns a boolean type node with,
+ l, and, r, nodes.
+*/
+
+extern "C" decl_node decl_makeBinaryTok (mcReserved_toktype op, decl_node l, decl_node r);
+
+/*
+ makeUnaryTok - creates and returns a boolean type node with,
+ e, node.
+*/
+
+extern "C" decl_node decl_makeUnaryTok (mcReserved_toktype op, decl_node e);
+
+/*
+ makeComponentRef - build a componentref node which accesses, field,
+ within, record, rec.
+*/
+
+extern "C" decl_node decl_makeComponentRef (decl_node rec, decl_node field);
+
+/*
+ makePointerRef - build a pointerref node which accesses, field,
+ within, pointer to record, ptr.
+*/
+
+extern "C" decl_node decl_makePointerRef (decl_node ptr, decl_node field);
+
+/*
+ isPointerRef - returns TRUE if, n, is a pointerref node.
+*/
+
+extern "C" unsigned int decl_isPointerRef (decl_node n);
+
+/*
+ makeDeRef - dereferences the pointer defined by, n.
+*/
+
+extern "C" decl_node decl_makeDeRef (decl_node n);
+
+/*
+ makeArrayRef - build an arrayref node which access element,
+ index, in, array. array is a variable/expression/constant
+ which has a type array.
+*/
+
+extern "C" decl_node decl_makeArrayRef (decl_node array, decl_node index);
+
+/*
+ getLastOp - return the right most non leaf node.
+*/
+
+extern "C" decl_node decl_getLastOp (decl_node n);
+
+/*
+ getCardinal - returns the cardinal type node.
+*/
+
+extern "C" decl_node decl_getCardinal (void);
+
+/*
+ makeLiteralInt - creates and returns a literal node based on an integer type.
+*/
+
+extern "C" decl_node decl_makeLiteralInt (nameKey_Name n);
+
+/*
+ makeLiteralReal - creates and returns a literal node based on a real type.
+*/
+
+extern "C" decl_node decl_makeLiteralReal (nameKey_Name n);
+
+/*
+ makeString - creates and returns a node containing string, n.
+*/
+
+extern "C" decl_node decl_makeString (nameKey_Name n);
+
+/*
+ makeSetValue - creates and returns a setvalue node.
+*/
+
+extern "C" decl_node decl_makeSetValue (void);
+
+/*
+ isSetValue - returns TRUE if, n, is a setvalue node.
+*/
+
+extern "C" unsigned int decl_isSetValue (decl_node n);
+
+/*
+ putSetValue - assigns the type, t, to the set value, n. The
+ node, n, is returned.
+*/
+
+extern "C" decl_node decl_putSetValue (decl_node n, decl_node t);
+
+/*
+ includeSetValue - includes the range l..h into the setvalue.
+ h might be NIL indicating that a single element
+ is to be included into the set.
+ n is returned.
+*/
+
+extern "C" decl_node decl_includeSetValue (decl_node n, decl_node l, decl_node h);
+
+/*
+ getBuiltinConst - creates and returns a builtin const if available.
+*/
+
+extern "C" decl_node decl_getBuiltinConst (nameKey_Name n);
+
+/*
+ makeExpList - creates and returns an expList node.
+*/
+
+extern "C" decl_node decl_makeExpList (void);
+
+/*
+ isExpList - returns TRUE if, n, is an explist node.
+*/
+
+extern "C" unsigned int decl_isExpList (decl_node n);
+
+/*
+ putExpList - places, expression, e, within the explist, n.
+*/
+
+extern "C" void decl_putExpList (decl_node n, decl_node e);
+
+/*
+ makeConstExp - returns a constexp node.
+*/
+
+extern "C" decl_node decl_makeConstExp (void);
+
+/*
+ getNextConstExp - returns the next constexp node.
+*/
+
+extern "C" decl_node decl_getNextConstExp (void);
+
+/*
+ setConstExpComplete - sets the field inside the def or imp or module, n.
+*/
+
+extern "C" void decl_setConstExpComplete (decl_node n);
+
+/*
+ fixupConstExp - assign fixup expression, e, into the argument of, c.
+*/
+
+extern "C" decl_node decl_fixupConstExp (decl_node c, decl_node e);
+
+/*
+ resetConstExpPos - resets the index into the saved list of constexps inside
+ module, n.
+*/
+
+extern "C" void decl_resetConstExpPos (decl_node n);
+
+/*
+ makeFuncCall - builds a function call to c with param list, n.
+*/
+
+extern "C" decl_node decl_makeFuncCall (decl_node c, decl_node n);
+
+/*
+ makeStatementSequence - create and return a statement sequence node.
+*/
+
+extern "C" decl_node decl_makeStatementSequence (void);
+
+/*
+ isStatementSequence - returns TRUE if node, n, is a statement sequence.
+*/
+
+extern "C" unsigned int decl_isStatementSequence (decl_node n);
+
+/*
+ addStatement - adds node, n, as a statement to statememt sequence, s.
+*/
+
+extern "C" void decl_addStatement (decl_node s, decl_node n);
+
+/*
+ addCommentBody - adds a body comment to a statement sequence node.
+*/
+
+extern "C" void decl_addCommentBody (decl_node n);
+
+/*
+ addCommentAfter - adds an after comment to a statement sequence node.
+*/
+
+extern "C" void decl_addCommentAfter (decl_node n);
+
+/*
+ addIfComments - adds the, body, and, after, comments to if node, n.
+*/
+
+extern "C" void decl_addIfComments (decl_node n, decl_node body, decl_node after);
+
+/*
+ addElseComments - adds the, body, and, after, comments to an, if, or an elsif, node, n.
+*/
+
+extern "C" void decl_addElseComments (decl_node n, decl_node body, decl_node after);
+
+/*
+ addIfEndComments - adds the, body, and, after, comments to an, if, node, n.
+*/
+
+extern "C" void decl_addIfEndComments (decl_node n, decl_node body, decl_node after);
+
+/*
+ makeReturn - creates and returns a return node.
+*/
+
+extern "C" decl_node decl_makeReturn (void);
+
+/*
+ isReturn - returns TRUE if node, n, is a return.
+*/
+
+extern "C" unsigned int decl_isReturn (decl_node n);
+
+/*
+ putReturn - assigns node, e, as the expression on the return node.
+*/
+
+extern "C" void decl_putReturn (decl_node n, decl_node e);
+
+/*
+ makeWhile - creates and returns a while node.
+*/
+
+extern "C" decl_node decl_makeWhile (void);
+
+/*
+ putWhile - places an expression, e, and statement sequence, s, into the while
+ node, n.
+*/
+
+extern "C" void decl_putWhile (decl_node n, decl_node e, decl_node s);
+
+/*
+ isWhile - returns TRUE if node, n, is a while.
+*/
+
+extern "C" unsigned int decl_isWhile (decl_node n);
+
+/*
+ addWhileDoComment - adds body and after comments to while node, w.
+*/
+
+extern "C" void decl_addWhileDoComment (decl_node w, decl_node body, decl_node after);
+
+/*
+ addWhileEndComment - adds body and after comments to the end of a while node, w.
+*/
+
+extern "C" void decl_addWhileEndComment (decl_node w, decl_node body, decl_node after);
+
+/*
+ makeAssignment - creates and returns an assignment node.
+ The designator is, d, and expression, e.
+*/
+
+extern "C" decl_node decl_makeAssignment (decl_node d, decl_node e);
+
+/*
+ putBegin - assigns statements, s, to be the normal part in
+ block, b. The block may be a procedure or module,
+ or implementation node.
+*/
+
+extern "C" void decl_putBegin (decl_node b, decl_node s);
+
+/*
+ putFinally - assigns statements, s, to be the final part in
+ block, b. The block may be a module
+ or implementation node.
+*/
+
+extern "C" void decl_putFinally (decl_node b, decl_node s);
+
+/*
+ makeExit - creates and returns an exit node.
+*/
+
+extern "C" decl_node decl_makeExit (decl_node l, unsigned int n);
+
+/*
+ isExit - returns TRUE if node, n, is an exit.
+*/
+
+extern "C" unsigned int decl_isExit (decl_node n);
+
+/*
+ makeLoop - creates and returns a loop node.
+*/
+
+extern "C" decl_node decl_makeLoop (void);
+
+/*
+ isLoop - returns TRUE if, n, is a loop node.
+*/
+
+extern "C" unsigned int decl_isLoop (decl_node n);
+
+/*
+ putLoop - places statement sequence, s, into loop, l.
+*/
+
+extern "C" void decl_putLoop (decl_node l, decl_node s);
+
+/*
+ makeComment - creates and returns a comment node.
+*/
+
+extern "C" decl_node decl_makeComment (const char *a_, unsigned int _a_high);
+
+/*
+ makeCommentS - creates and returns a comment node.
+*/
+
+extern "C" decl_node decl_makeCommentS (mcComment_commentDesc c);
+
+/*
+ makeIf - creates and returns an if node. The if node
+ will have expression, e, and statement sequence, s,
+ as the then component.
+*/
+
+extern "C" decl_node decl_makeIf (decl_node e, decl_node s);
+
+/*
+ isIf - returns TRUE if, n, is an if node.
+*/
+
+extern "C" unsigned int decl_isIf (decl_node n);
+
+/*
+ makeElsif - creates and returns an elsif node.
+ This node has an expression, e, and statement
+ sequence, s.
+*/
+
+extern "C" decl_node decl_makeElsif (decl_node i, decl_node e, decl_node s);
+
+/*
+ isElsif - returns TRUE if node, n, is an elsif node.
+*/
+
+extern "C" unsigned int decl_isElsif (decl_node n);
+
+/*
+ putElse - the else is grafted onto the if/elsif node, i,
+ and the statement sequence will be, s.
+*/
+
+extern "C" void decl_putElse (decl_node i, decl_node s);
+
+/*
+ makeFor - creates and returns a for node.
+*/
+
+extern "C" decl_node decl_makeFor (void);
+
+/*
+ isFor - returns TRUE if node, n, is a for node.
+*/
+
+extern "C" unsigned int decl_isFor (decl_node n);
+
+/*
+ putFor - assigns the fields of the for node with
+ ident, i,
+ start, s,
+ end, e,
+ increment, i,
+ statements, sq.
+*/
+
+extern "C" void decl_putFor (decl_node f, decl_node i, decl_node s, decl_node e, decl_node b, decl_node sq);
+
+/*
+ makeRepeat - creates and returns a repeat node.
+*/
+
+extern "C" decl_node decl_makeRepeat (void);
+
+/*
+ isRepeat - returns TRUE if node, n, is a repeat node.
+*/
+
+extern "C" unsigned int decl_isRepeat (decl_node n);
+
+/*
+ putRepeat - places statements, s, and expression, e, into
+ repeat statement, n.
+*/
+
+extern "C" void decl_putRepeat (decl_node n, decl_node s, decl_node e);
+
+/*
+ addRepeatComment - adds body and after comments to repeat node, r.
+*/
+
+extern "C" void decl_addRepeatComment (decl_node r, decl_node body, decl_node after);
+
+/*
+ addUntilComment - adds body and after comments to the until section of a repeat node, r.
+*/
+
+extern "C" void decl_addUntilComment (decl_node r, decl_node body, decl_node after);
+
+/*
+ makeCase - builds and returns a case statement node.
+*/
+
+extern "C" decl_node decl_makeCase (void);
+
+/*
+ isCase - returns TRUE if node, n, is a case statement.
+*/
+
+extern "C" unsigned int decl_isCase (decl_node n);
+
+/*
+ putCaseExpression - places expression, e, into case statement, n.
+ n is returned.
+*/
+
+extern "C" decl_node decl_putCaseExpression (decl_node n, decl_node e);
+
+/*
+ putCaseElse - places else statement, e, into case statement, n.
+ n is returned.
+*/
+
+extern "C" decl_node decl_putCaseElse (decl_node n, decl_node e);
+
+/*
+ putCaseStatement - places a caselist, l, and associated
+ statement sequence, s, into case statement, n.
+ n is returned.
+*/
+
+extern "C" decl_node decl_putCaseStatement (decl_node n, decl_node l, decl_node s);
+
+/*
+ makeCaseLabelList - creates and returns a caselabellist node.
+*/
+
+extern "C" decl_node decl_makeCaseLabelList (decl_node l, decl_node s);
+
+/*
+ isCaseLabelList - returns TRUE if, n, is a caselabellist.
+*/
+
+extern "C" unsigned int decl_isCaseLabelList (decl_node n);
+
+/*
+ makeCaseList - creates and returns a case statement node.
+*/
+
+extern "C" decl_node decl_makeCaseList (void);
+
+/*
+ isCaseList - returns TRUE if, n, is a case list.
+*/
+
+extern "C" unsigned int decl_isCaseList (decl_node n);
+
+/*
+ putCaseRange - places the case range lo..hi into caselist, n.
+*/
+
+extern "C" decl_node decl_putCaseRange (decl_node n, decl_node lo, decl_node hi);
+
+/*
+ makeRange - creates and returns a case range.
+*/
+
+extern "C" decl_node decl_makeRange (decl_node lo, decl_node hi);
+
+/*
+ isRange - returns TRUE if node, n, is a range.
+*/
+
+extern "C" unsigned int decl_isRange (decl_node n);
+
+/*
+ setNoReturn - sets noreturn field inside procedure.
+*/
+
+extern "C" void decl_setNoReturn (decl_node n, unsigned int value);
+
+/*
+ dupExpr - duplicate the expression nodes, it does not duplicate
+ variables, literals, constants but only the expression
+ operators (including function calls and parameter lists).
+*/
+
+extern "C" decl_node decl_dupExpr (decl_node n);
+
+/*
+ setLangC -
+*/
+
+extern "C" void decl_setLangC (void);
+
+/*
+ setLangCP -
+*/
+
+extern "C" void decl_setLangCP (void);
+
+/*
+ setLangM2 -
+*/
+
+extern "C" void decl_setLangM2 (void);
+
+/*
+ out - walks the tree of node declarations for the main module
+ and writes the output to the outputFile specified in
+ mcOptions. It outputs the declarations in the language
+ specified above.
+*/
+
+extern "C" void decl_out (void);
+extern "C" nameKey_Name nameKey_makeKey (const char *a_, unsigned int _a_high);
+extern "C" nameKey_Name nameKey_makekey (void * a);
+extern "C" void nameKey_getKey (nameKey_Name key, char *a, unsigned int _a_high);
+extern "C" unsigned int nameKey_lengthKey (nameKey_Name key);
+extern "C" unsigned int nameKey_isKey (const char *a_, unsigned int _a_high);
+extern "C" void nameKey_writeKey (nameKey_Name key);
+extern "C" unsigned int nameKey_isSameExcludingCase (nameKey_Name key1, nameKey_Name key2);
+extern "C" void * nameKey_keyToCharStar (nameKey_Name key);
+extern "C" symbolKey_symbolTree symbolKey_initTree (void);
+extern "C" void symbolKey_killTree (symbolKey_symbolTree *t);
+extern "C" void * symbolKey_getSymKey (symbolKey_symbolTree t, nameKey_Name name);
+extern "C" void symbolKey_putSymKey (symbolKey_symbolTree t, nameKey_Name name, void * key);
+
+/*
+ delSymKey - deletes an entry in the binary tree.
+
+ NB in order for this to work we must ensure that the InitTree sets
+ both left and right to NIL.
+*/
+
+extern "C" void symbolKey_delSymKey (symbolKey_symbolTree t, nameKey_Name name);
+
+/*
+ isEmptyTree - returns true if symbolTree, t, is empty.
+*/
+
+extern "C" unsigned int symbolKey_isEmptyTree (symbolKey_symbolTree t);
+
+/*
+ doesTreeContainAny - returns true if symbolTree, t, contains any
+ symbols which in turn return true when procedure,
+ p, is called with a symbol as its parameter.
+ The symbolTree root is empty apart from the field,
+ left, hence we need two procedures.
+*/
+
+extern "C" unsigned int symbolKey_doesTreeContainAny (symbolKey_symbolTree t, symbolKey_isSymbol p);
+
+/*
+ foreachNodeDo - for each node in symbolTree, t, a procedure, p,
+ is called with the node symbol as its parameter.
+ The tree root node only contains a legal left pointer,
+ therefore we need two procedures to examine this tree.
+*/
+
+extern "C" void symbolKey_foreachNodeDo (symbolKey_symbolTree t, symbolKey_performOperation p);
+
+/*
+ initComment - the start of a new comment has been seen by the lexical analyser.
+ A new comment block is created and all addText contents are placed
+ in this block. onlySpaces indicates whether we have only seen
+ spaces on this line.
+*/
+
+extern "C" mcComment_commentDesc mcComment_initComment (unsigned int onlySpaces);
+
+/*
+ addText - cs is a C string (null terminated) which contains comment text.
+ This is appended to the comment, cd.
+*/
+
+extern "C" void mcComment_addText (mcComment_commentDesc cd, void * cs);
+
+/*
+ getContent - returns the content of comment, cd.
+*/
+
+extern "C" DynamicStrings_String mcComment_getContent (mcComment_commentDesc cd);
+
+/*
+ getCommentCharStar - returns the C string content of comment, cd.
+*/
+
+extern "C" void * mcComment_getCommentCharStar (mcComment_commentDesc cd);
+
+/*
+ setProcedureComment - changes the type of comment, cd, to a
+ procedure heading comment,
+ providing it has the procname as the first word.
+*/
+
+extern "C" void mcComment_setProcedureComment (mcComment_commentDesc cd, nameKey_Name procname);
+
+/*
+ getProcedureComment - returns the current procedure comment if available.
+*/
+
+extern "C" DynamicStrings_String mcComment_getProcedureComment (mcComment_commentDesc cd);
+
+/*
+ getAfterStatementComment - returns the current statement after comment if available.
+*/
+
+extern "C" DynamicStrings_String mcComment_getAfterStatementComment (mcComment_commentDesc cd);
+
+/*
+ getInbodyStatementComment - returns the current statement after comment if available.
+*/
+
+extern "C" DynamicStrings_String mcComment_getInbodyStatementComment (mcComment_commentDesc cd);
+
+/*
+ isProcedureComment - returns TRUE if, cd, is a procedure comment.
+*/
+
+extern "C" unsigned int mcComment_isProcedureComment (mcComment_commentDesc cd);
+
+/*
+ isBodyComment - returns TRUE if, cd, is a body comment.
+*/
+
+extern "C" unsigned int mcComment_isBodyComment (mcComment_commentDesc cd);
+
+/*
+ isAfterComment - returns TRUE if, cd, is an after comment.
+*/
+
+extern "C" unsigned int mcComment_isAfterComment (mcComment_commentDesc cd);
+extern "C" void mcDebug_assert (unsigned int q);
+extern "C" void mcDebug_writeDebug (const char *a_, unsigned int _a_high);
+extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size);
+extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size);
+extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size);
+extern "C" unsigned int Storage_Available (unsigned int Size);
+extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname);
+extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname);
+extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname);
+extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile);
+extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s);
+extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file);
+extern "C" unsigned int FIO_IsNoError (FIO_File f);
+extern "C" unsigned int FIO_IsActive (FIO_File f);
+extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile);
+extern "C" void FIO_Close (FIO_File f);
+extern "C" unsigned int FIO_exists (void * fname, unsigned int flength);
+extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength);
+extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength);
+extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile);
+extern "C" void FIO_FlushBuffer (FIO_File f);
+extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest);
+extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high);
+extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src);
+extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high);
+extern "C" void FIO_WriteChar (FIO_File f, char ch);
+extern "C" unsigned int FIO_EOF (FIO_File f);
+extern "C" unsigned int FIO_EOLN (FIO_File f);
+extern "C" unsigned int FIO_WasEOLN (FIO_File f);
+extern "C" char FIO_ReadChar (FIO_File f);
+extern "C" void FIO_UnReadChar (FIO_File f, char ch);
+extern "C" void FIO_WriteLine (FIO_File f);
+extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high);
+extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high);
+extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c);
+extern "C" unsigned int FIO_ReadCardinal (FIO_File f);
+extern "C" int FIO_GetUnixFileDescriptor (FIO_File f);
+extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos);
+extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos);
+extern "C" long int FIO_FindPosition (FIO_File f);
+extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high);
+extern "C" void * FIO_getFileName (FIO_File f);
+extern "C" unsigned int FIO_getFileNameLength (FIO_File f);
+extern "C" void FIO_FlushOutErr (void);
+
+/*
+ InitString - creates and returns a String type object.
+ Initial contents are, a.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high);
+
+/*
+ KillString - frees String, s, and its contents.
+ NIL is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s);
+
+/*
+ Fin - finishes with a string, it calls KillString with, s.
+ The purpose of the procedure is to provide a short cut
+ to calling KillString and then testing the return result.
+*/
+
+extern "C" void DynamicStrings_Fin (DynamicStrings_String s);
+
+/*
+ InitStringCharStar - initializes and returns a String to contain the C string.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a);
+
+/*
+ InitStringChar - initializes and returns a String to contain the single character, ch.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch);
+
+/*
+ Mark - marks String, s, ready for garbage collection.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s);
+
+/*
+ Length - returns the length of the String, s.
+*/
+
+extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s);
+
+/*
+ ConCat - returns String, a, after the contents of, b, have been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ ConCatChar - returns String, a, after character, ch, has been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch);
+
+/*
+ Assign - assigns the contents of, b, into, a.
+ String, a, is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ Dup - duplicate a String, s, returning the copy of s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s);
+
+/*
+ Add - returns a new String which contains the contents of a and b.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ Equal - returns TRUE if String, a, and, b, are equal.
+*/
+
+extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ EqualCharStar - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a);
+
+/*
+ EqualArray - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high);
+
+/*
+ Mult - returns a new string which is n concatenations of String, s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n);
+
+/*
+ Slice - returns a new string which contains the elements
+ low..high-1
+
+ strings start at element 0
+ Slice(s, 0, 2) will return elements 0, 1 but not 2
+ Slice(s, 1, 3) will return elements 1, 2 but not 3
+ Slice(s, 2, 0) will return elements 2..max
+ Slice(s, 3, -1) will return elements 3..max-1
+ Slice(s, 4, -2) will return elements 4..max-2
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high);
+
+/*
+ Index - returns the indice of the first occurance of, ch, in
+ String, s. -1 is returned if, ch, does not exist.
+ The search starts at position, o.
+*/
+
+extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o);
+
+/*
+ RIndex - returns the indice of the last occurance of, ch,
+ in String, s. The search starts at position, o.
+ -1 is returned if, ch, is not found.
+*/
+
+extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o);
+
+/*
+ RemoveComment - assuming that, comment, is a comment delimiter
+ which indicates anything to its right is a comment
+ then strip off the comment and also any white space
+ on the remaining right hand side.
+ It leaves any white space on the left hand side alone.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment);
+
+/*
+ RemoveWhitePrefix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s);
+
+/*
+ RemoveWhitePostfix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s);
+
+/*
+ ToUpper - returns string, s, after it has had its lower case characters
+ replaced by upper case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s);
+
+/*
+ ToLower - returns string, s, after it has had its upper case characters
+ replaced by lower case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s);
+
+/*
+ CopyOut - copies string, s, to a.
+*/
+
+extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s);
+
+/*
+ char - returns the character, ch, at position, i, in String, s.
+*/
+
+extern "C" char DynamicStrings_char (DynamicStrings_String s, int i);
+
+/*
+ string - returns the C style char * of String, s.
+*/
+
+extern "C" void * DynamicStrings_string (DynamicStrings_String s);
+
+/*
+ InitStringDB - the debug version of InitString.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ InitStringCharStarDB - the debug version of InitStringCharStar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ InitStringCharDB - the debug version of InitStringChar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ MultDB - the debug version of MultDB.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ DupDB - the debug version of Dup.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ SliceDB - debug version of Slice.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ PushAllocation - pushes the current allocation/deallocation lists.
+*/
+
+extern "C" void DynamicStrings_PushAllocation (void);
+
+/*
+ PopAllocation - test to see that all strings are deallocated since
+ the last push. Then it pops to the previous
+ allocation/deallocation lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" void DynamicStrings_PopAllocation (unsigned int halt);
+
+/*
+ PopAllocationExemption - test to see that all strings are deallocated, except
+ string, e, since the last push.
+ Then it pops to the previous allocation/deallocation
+ lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e);
+extern "C" DynamicStrings_String StringConvert_IntegerToString (int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower);
+extern "C" DynamicStrings_String StringConvert_CardinalToString (unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower);
+extern "C" int StringConvert_StringToInteger (DynamicStrings_String s, unsigned int base, unsigned int *found);
+extern "C" unsigned int StringConvert_StringToCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found);
+extern "C" DynamicStrings_String StringConvert_LongIntegerToString (long int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower);
+extern "C" long int StringConvert_StringToLongInteger (DynamicStrings_String s, unsigned int base, unsigned int *found);
+extern "C" DynamicStrings_String StringConvert_LongCardinalToString (long unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower);
+extern "C" long unsigned int StringConvert_StringToLongCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found);
+extern "C" DynamicStrings_String StringConvert_ShortCardinalToString (short unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower);
+extern "C" short unsigned int StringConvert_StringToShortCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found);
+extern "C" int StringConvert_stoi (DynamicStrings_String s);
+extern "C" DynamicStrings_String StringConvert_itos (int i, unsigned int width, char padding, unsigned int sign);
+extern "C" DynamicStrings_String StringConvert_ctos (unsigned int c, unsigned int width, char padding);
+extern "C" unsigned int StringConvert_stoc (DynamicStrings_String s);
+extern "C" int StringConvert_hstoi (DynamicStrings_String s);
+extern "C" int StringConvert_ostoi (DynamicStrings_String s);
+extern "C" int StringConvert_bstoi (DynamicStrings_String s);
+extern "C" unsigned int StringConvert_hstoc (DynamicStrings_String s);
+extern "C" unsigned int StringConvert_ostoc (DynamicStrings_String s);
+extern "C" unsigned int StringConvert_bstoc (DynamicStrings_String s);
+extern "C" long double StringConvert_StringToLongreal (DynamicStrings_String s, unsigned int *found);
+extern "C" DynamicStrings_String StringConvert_LongrealToString (long double x, unsigned int TotalWidth, unsigned int FractionWidth);
+extern "C" double StringConvert_stor (DynamicStrings_String s);
+extern "C" long double StringConvert_stolr (DynamicStrings_String s);
+extern "C" DynamicStrings_String StringConvert_ToSigFig (DynamicStrings_String s, unsigned int n);
+extern "C" DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_String s, unsigned int n);
+extern "C" DynamicStrings_String mcOptions_handleOptions (void);
+extern "C" unsigned int mcOptions_getQuiet (void);
+extern "C" unsigned int mcOptions_getVerbose (void);
+extern "C" unsigned int mcOptions_getInternalDebugging (void);
+extern "C" DynamicStrings_String mcOptions_getCppCommandLine (void);
+extern "C" DynamicStrings_String mcOptions_getOutputFile (void);
+extern "C" unsigned int mcOptions_getExtendedOpaque (void);
+extern "C" void mcOptions_setDebugTopological (unsigned int value);
+extern "C" unsigned int mcOptions_getDebugTopological (void);
+extern "C" DynamicStrings_String mcOptions_getHPrefix (void);
+extern "C" unsigned int mcOptions_getIgnoreFQ (void);
+extern "C" unsigned int mcOptions_getGccConfigSystem (void);
+extern "C" unsigned int mcOptions_getScaffoldDynamic (void);
+extern "C" unsigned int mcOptions_getScaffoldMain (void);
+extern "C" void mcOptions_writeGPLheader (FIO_File f);
+extern "C" void mcOptions_setSuppressNoReturn (unsigned int value);
+extern "C" unsigned int mcOptions_getSuppressNoReturn (void);
+extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt);
+extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high);
+extern "C" DynamicStrings_String FormatStrings_Sprintf2 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+extern "C" DynamicStrings_String FormatStrings_Sprintf3 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+extern "C" DynamicStrings_String FormatStrings_Sprintf4 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high);
+extern "C" DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s);
+extern "C" ssize_t libc_write (int d, void * buf, size_t nbytes);
+extern "C" ssize_t libc_read (int d, void * buf, size_t nbytes);
+extern "C" int libc_system (void * a);
+extern "C" void libc_abort (void) __attribute__ ((noreturn));
+extern "C" void * libc_malloc (size_t size);
+extern "C" void libc_free (void * ptr);
+extern "C" void * libc_realloc (void * ptr, size_t size);
+extern "C" int libc_isatty (int fd);
+extern "C" void libc_exit (int r) __attribute__ ((noreturn));
+extern "C" void * libc_getenv (void * s);
+extern "C" int libc_putenv (void * s);
+extern "C" int libc_getpid (void);
+extern "C" int libc_dup (int d);
+extern "C" int libc_close (int d);
+extern "C" int libc_open (void * filename, int oflag, ...);
+extern "C" int libc_creat (void * filename, unsigned int mode);
+extern "C" long int libc_lseek (int fd, long int offset, int whence);
+extern "C" void libc_perror (const char *string_, unsigned int _string_high);
+extern "C" int libc_readv (int fd, void * v, int n);
+extern "C" int libc_writev (int fd, void * v, int n);
+extern "C" void * libc_getcwd (void * buf, size_t size);
+extern "C" int libc_chown (void * filename, int uid, int gid);
+extern "C" size_t libc_strlen (void * a);
+extern "C" void * libc_strcpy (void * dest, void * src);
+extern "C" void * libc_strncpy (void * dest, void * src, unsigned int n);
+extern "C" int libc_unlink (void * file);
+extern "C" void * libc_memcpy (void * dest, void * src, size_t size);
+extern "C" void * libc_memset (void * s, int c, size_t size);
+extern "C" void * libc_memmove (void * dest, void * src, size_t size);
+extern "C" int libc_printf (const char *format_, unsigned int _format_high, ...);
+extern "C" int libc_snprintf (void * dest, size_t size, const char *format_, unsigned int _format_high, ...);
+extern "C" int libc_setenv (void * name, void * value, int overwrite);
+extern "C" void libc_srand (int seed);
+extern "C" int libc_rand (void);
+extern "C" libc_time_t libc_time (void * a);
+extern "C" void * libc_localtime (libc_time_t *t);
+extern "C" int libc_ftime (libc_timeb *t);
+extern "C" int libc_shutdown (int s, int how);
+extern "C" int libc_rename (void * oldpath, void * newpath);
+extern "C" int libc_setjmp (void * env);
+extern "C" void libc_longjmp (void * env, int val);
+extern "C" int libc_atexit (libc_exitP_C proc);
+extern "C" void * libc_ttyname (int filedes);
+extern "C" unsigned int libc_sleep (unsigned int seconds);
+extern "C" int libc_execv (void * pathname, void * argv);
+extern "C" void mcMetaError_metaError1 (const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high);
+extern "C" void mcMetaError_metaError2 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+extern "C" void mcMetaError_metaError3 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+extern "C" void mcMetaError_metaError4 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+extern "C" void mcMetaError_metaErrors1 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high);
+extern "C" void mcMetaError_metaErrors2 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+extern "C" void mcMetaError_metaErrors3 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+extern "C" void mcMetaError_metaErrors4 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+extern "C" void mcMetaError_metaErrorT1 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high);
+extern "C" void mcMetaError_metaErrorT2 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+extern "C" void mcMetaError_metaErrorT3 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+extern "C" void mcMetaError_metaErrorT4 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+extern "C" void mcMetaError_metaErrorsT1 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high);
+extern "C" void mcMetaError_metaErrorsT2 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+extern "C" void mcMetaError_metaErrorsT3 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+extern "C" void mcMetaError_metaErrorsT4 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+extern "C" void mcMetaError_metaErrorString1 (DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high);
+extern "C" void mcMetaError_metaErrorString2 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+extern "C" void mcMetaError_metaErrorString3 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+extern "C" void mcMetaError_metaErrorString4 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+extern "C" void mcMetaError_metaErrorStringT1 (unsigned int tok, DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high);
+extern "C" void mcMetaError_metaErrorStringT2 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+extern "C" void mcMetaError_metaErrorStringT3 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+extern "C" void mcMetaError_metaErrorStringT4 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+
+/*
+ internalError - displays an internal error message together with the compiler source
+ file and line number.
+ This function is not buffered and is used when the compiler is about
+ to give up.
+*/
+
+extern "C" void mcError_internalError (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ writeFormat0 - displays the source module and line together
+ with the encapsulated format string.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat0 (const char *a_, unsigned int _a_high);
+
+/*
+ writeFormat1 - displays the source module and line together
+ with the encapsulated format string.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ writeFormat2 - displays the module and line together with the encapsulated
+ format strings.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+
+/*
+ writeFormat3 - displays the module and line together with the encapsulated
+ format strings.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+
+/*
+ newError - creates and returns a new error handle.
+*/
+
+extern "C" mcError_error mcError_newError (unsigned int atTokenNo);
+
+/*
+ newWarning - creates and returns a new error handle suitable for a warning.
+ A warning will not stop compilation.
+*/
+
+extern "C" mcError_error mcError_newWarning (unsigned int atTokenNo);
+
+/*
+ chainError - creates and returns a new error handle, this new error
+ is associated with, e, and is chained onto the end of, e.
+ If, e, is NIL then the result to NewError is returned.
+*/
+
+extern "C" mcError_error mcError_chainError (unsigned int atTokenNo, mcError_error e);
+extern "C" void mcError_errorFormat0 (mcError_error e, const char *a_, unsigned int _a_high);
+extern "C" void mcError_errorFormat1 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+extern "C" void mcError_errorFormat2 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+extern "C" void mcError_errorFormat3 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+extern "C" void mcError_errorString (mcError_error e, DynamicStrings_String str);
+
+/*
+ errorStringAt - given an error string, s, it places this
+ string at token position, tok.
+ The string is consumed.
+*/
+
+extern "C" void mcError_errorStringAt (DynamicStrings_String s, unsigned int tok);
+
+/*
+ errorStringAt2 - given an error string, s, it places this
+ string at token positions, tok1 and tok2, respectively.
+ The string is consumed.
+*/
+
+extern "C" void mcError_errorStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2);
+
+/*
+ errorStringsAt2 - given error strings, s1, and, s2, it places these
+ strings at token positions, tok1 and tok2, respectively.
+ Both strings are consumed.
+*/
+
+extern "C" void mcError_errorStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2);
+
+/*
+ warnStringAt - given an error string, s, it places this
+ string at token position, tok.
+ The string is consumed.
+*/
+
+extern "C" void mcError_warnStringAt (DynamicStrings_String s, unsigned int tok);
+
+/*
+ warnStringAt2 - given an warning string, s, it places this
+ string at token positions, tok1 and tok2, respectively.
+ The string is consumed.
+*/
+
+extern "C" void mcError_warnStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2);
+
+/*
+ warnStringsAt2 - given warning strings, s1, and, s2, it places these
+ strings at token positions, tok1 and tok2, respectively.
+ Both strings are consumed.
+*/
+
+extern "C" void mcError_warnStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2);
+extern "C" void mcError_warnFormat0 (const char *a_, unsigned int _a_high);
+
+/*
+ warnFormat1 - displays the source module and line together
+ with the encapsulated format string.
+ Used for simple warning messages tied to the current token.
+*/
+
+extern "C" void mcError_warnFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ flushErrors - switches the output channel to the error channel
+ and then writes out all errors.
+*/
+
+extern "C" void mcError_flushErrors (void);
+
+/*
+ flushWarnings - switches the output channel to the error channel
+ and then writes out all warnings.
+ If an error is present the compilation is terminated,
+ if warnings only were emitted then compilation will
+ continue.
+*/
+
+extern "C" void mcError_flushWarnings (void);
+
+/*
+ errorAbort0 - aborts compiling, it flushes all warnings and errors before aborting.
+*/
+
+extern "C" void mcError_errorAbort0 (const char *a_, unsigned int _a_high);
+extern "C" mcComment_commentDesc mcLexBuf_getProcedureComment (void);
+extern "C" mcComment_commentDesc mcLexBuf_getBodyComment (void);
+extern "C" mcComment_commentDesc mcLexBuf_getAfterComment (void);
+extern "C" unsigned int mcLexBuf_openSource (DynamicStrings_String s);
+extern "C" void mcLexBuf_closeSource (void);
+extern "C" void mcLexBuf_reInitialize (void);
+extern "C" void mcLexBuf_resetForNewPass (void);
+extern "C" void mcLexBuf_getToken (void);
+extern "C" void mcLexBuf_insertToken (mcReserved_toktype token);
+extern "C" void mcLexBuf_insertTokenAndRewind (mcReserved_toktype token);
+extern "C" unsigned int mcLexBuf_getPreviousTokenLineNo (void);
+extern "C" unsigned int mcLexBuf_getLineNo (void);
+extern "C" unsigned int mcLexBuf_getTokenNo (void);
+extern "C" unsigned int mcLexBuf_tokenToLineNo (unsigned int tokenNo, unsigned int depth);
+extern "C" unsigned int mcLexBuf_getColumnNo (void);
+extern "C" unsigned int mcLexBuf_tokenToColumnNo (unsigned int tokenNo, unsigned int depth);
+extern "C" DynamicStrings_String mcLexBuf_findFileNameFromToken (unsigned int tokenNo, unsigned int depth);
+extern "C" DynamicStrings_String mcLexBuf_getFileName (void);
+extern "C" void mcLexBuf_addTok (mcReserved_toktype t);
+extern "C" void mcLexBuf_addTokCharStar (mcReserved_toktype t, void * s);
+extern "C" void mcLexBuf_addTokInteger (mcReserved_toktype t, int i);
+extern "C" void mcLexBuf_addTokComment (mcReserved_toktype t, mcComment_commentDesc com);
+extern "C" void mcLexBuf_setFile (void * filename);
+extern "C" void mcLexBuf_pushFile (void * filename);
+extern "C" void mcLexBuf_popFile (void * filename);
+extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high);
+extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high);
+extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high);
+extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+
+/*
+ initPretty - initialise a pretty print data structure.
+*/
+
+extern "C" mcPretty_pretty mcPretty_initPretty (mcPretty_writeProc w, mcPretty_writeLnProc l);
+
+/*
+ dupPretty - duplicate a pretty print data structure.
+*/
+
+extern "C" mcPretty_pretty mcPretty_dupPretty (mcPretty_pretty p);
+
+/*
+ killPretty - destroy a pretty print data structure.
+ Post condition: p is assigned to NIL.
+*/
+
+extern "C" void mcPretty_killPretty (mcPretty_pretty *p);
+
+/*
+ pushPretty - duplicate, p. Push, p, and return the duplicate.
+*/
+
+extern "C" mcPretty_pretty mcPretty_pushPretty (mcPretty_pretty p);
+
+/*
+ popPretty - pops the pretty object from the stack.
+*/
+
+extern "C" mcPretty_pretty mcPretty_popPretty (mcPretty_pretty p);
+
+/*
+ getindent - returns the current indent value.
+*/
+
+extern "C" unsigned int mcPretty_getindent (mcPretty_pretty p);
+
+/*
+ setindent - sets the current indent to, n.
+*/
+
+extern "C" void mcPretty_setindent (mcPretty_pretty p, unsigned int n);
+
+/*
+ getcurpos - returns the current cursor position.
+*/
+
+extern "C" unsigned int mcPretty_getcurpos (mcPretty_pretty s);
+
+/*
+ getseekpos - returns the seek position.
+*/
+
+extern "C" unsigned int mcPretty_getseekpos (mcPretty_pretty s);
+
+/*
+ getcurline - returns the current line number.
+*/
+
+extern "C" unsigned int mcPretty_getcurline (mcPretty_pretty s);
+extern "C" void mcPretty_setNeedSpace (mcPretty_pretty s);
+
+/*
+ noSpace - unset needsSpace.
+*/
+
+extern "C" void mcPretty_noSpace (mcPretty_pretty s);
+
+/*
+ print - print a string using, p.
+*/
+
+extern "C" void mcPretty_print (mcPretty_pretty p, const char *a_, unsigned int _a_high);
+
+/*
+ prints - print a string using, p.
+*/
+
+extern "C" void mcPretty_prints (mcPretty_pretty p, DynamicStrings_String s);
+
+/*
+ raw - print out string, s, without any translation of
+ escape sequences.
+*/
+
+extern "C" void mcPretty_raw (mcPretty_pretty p, DynamicStrings_String s);
+
+/*
+ InitIndex - creates and returns an Index.
+*/
+
+extern "C" Indexing_Index Indexing_InitIndex (unsigned int low);
+
+/*
+ KillIndex - returns Index to free storage.
+*/
+
+extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i);
+
+/*
+ DebugIndex - turns on debugging within an index.
+*/
+
+extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i);
+
+/*
+ InBounds - returns TRUE if indice, n, is within the bounds
+ of the dynamic array.
+*/
+
+extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n);
+
+/*
+ HighIndice - returns the last legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_HighIndice (Indexing_Index i);
+
+/*
+ LowIndice - returns the first legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_LowIndice (Indexing_Index i);
+
+/*
+ PutIndice - places, a, into the dynamic array at position i[n]
+*/
+
+extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a);
+
+/*
+ GetIndice - retrieves, element i[n] from the dynamic array.
+*/
+
+extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n);
+
+/*
+ IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*/
+
+extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a);
+
+/*
+ RemoveIndiceFromIndex - removes, a, from Index, i.
+*/
+
+extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a);
+
+/*
+ DeleteIndice - delete i[j] from the array.
+*/
+
+extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j);
+
+/*
+ IncludeIndiceIntoIndex - if the indice is not in the index, then
+ add it at the end.
+*/
+
+extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a);
+
+/*
+ ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*/
+
+extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p);
+
+/*
+ initList - creates a new alist, l.
+*/
+
+extern "C" alists_alist alists_initList (void);
+
+/*
+ killList - deletes the complete alist, l.
+*/
+
+extern "C" void alists_killList (alists_alist *l);
+
+/*
+ putItemIntoList - places an ADDRESS, c, into alist, l.
+*/
+
+extern "C" void alists_putItemIntoList (alists_alist l, void * c);
+
+/*
+ getItemFromList - retrieves the nth WORD from alist, l.
+*/
+
+extern "C" void * alists_getItemFromList (alists_alist l, unsigned int n);
+
+/*
+ getIndexOfList - returns the index for WORD, c, in alist, l.
+ If more than one WORD, c, exists the index
+ for the first is returned.
+*/
+
+extern "C" unsigned int alists_getIndexOfList (alists_alist l, void * c);
+
+/*
+ noOfItemsInList - returns the number of items in alist, l.
+*/
+
+extern "C" unsigned int alists_noOfItemsInList (alists_alist l);
+
+/*
+ includeItemIntoList - adds an ADDRESS, c, into a alist providing
+ the value does not already exist.
+*/
+
+extern "C" void alists_includeItemIntoList (alists_alist l, void * c);
+
+/*
+ removeItemFromList - removes a ADDRESS, c, from a alist.
+ It assumes that this value only appears once.
+*/
+
+extern "C" void alists_removeItemFromList (alists_alist l, void * c);
+
+/*
+ isItemInList - returns true if a ADDRESS, c, was found in alist, l.
+*/
+
+extern "C" unsigned int alists_isItemInList (alists_alist l, void * c);
+
+/*
+ foreachItemInListDo - calls procedure, P, foreach item in alist, l.
+*/
+
+extern "C" void alists_foreachItemInListDo (alists_alist l, alists_performOperation p);
+
+/*
+ duplicateList - returns a duplicate alist derived from, l.
+*/
+
+extern "C" alists_alist alists_duplicateList (alists_alist l);
+
+/*
+ initList - creates a new wlist, l.
+*/
+
+extern "C" wlists_wlist wlists_initList (void);
+
+/*
+ killList - deletes the complete wlist, l.
+*/
+
+extern "C" void wlists_killList (wlists_wlist *l);
+
+/*
+ putItemIntoList - places an WORD, c, into wlist, l.
+*/
+
+extern "C" void wlists_putItemIntoList (wlists_wlist l, unsigned int c);
+
+/*
+ getItemFromList - retrieves the nth WORD from wlist, l.
+*/
+
+extern "C" unsigned int wlists_getItemFromList (wlists_wlist l, unsigned int n);
+
+/*
+ getIndexOfList - returns the index for WORD, c, in wlist, l.
+ If more than one WORD, c, exists the index
+ for the first is returned.
+*/
+
+extern "C" unsigned int wlists_getIndexOfList (wlists_wlist l, unsigned int c);
+
+/*
+ noOfItemsInList - returns the number of items in wlist, l.
+*/
+
+extern "C" unsigned int wlists_noOfItemsInList (wlists_wlist l);
+
+/*
+ includeItemIntoList - adds an WORD, c, into a wlist providing
+ the value does not already exist.
+*/
+
+extern "C" void wlists_includeItemIntoList (wlists_wlist l, unsigned int c);
+
+/*
+ removeItemFromList - removes a WORD, c, from a wlist.
+ It assumes that this value only appears once.
+*/
+
+extern "C" void wlists_removeItemFromList (wlists_wlist l, unsigned int c);
+
+/*
+ replaceItemInList - replace the nth WORD in wlist, l.
+ The first item in a wlists is at index, 1.
+ If the index, n, is out of range nothing is changed.
+*/
+
+extern "C" void wlists_replaceItemInList (wlists_wlist l, unsigned int n, unsigned int w);
+
+/*
+ isItemInList - returns true if a WORD, c, was found in wlist, l.
+*/
+
+extern "C" unsigned int wlists_isItemInList (wlists_wlist l, unsigned int c);
+
+/*
+ foreachItemInListDo - calls procedure, P, foreach item in wlist, l.
+*/
+
+extern "C" void wlists_foreachItemInListDo (wlists_wlist l, wlists_performOperation p);
+
+/*
+ duplicateList - returns a duplicate wlist derived from, l.
+*/
+
+extern "C" wlists_wlist wlists_duplicateList (wlists_wlist l);
+extern "C" void keyc_useUnistd (void);
+extern "C" void keyc_useThrow (void);
+extern "C" void keyc_useStorage (void);
+extern "C" void keyc_useFree (void);
+extern "C" void keyc_useMalloc (void);
+extern "C" void keyc_useProc (void);
+extern "C" void keyc_useTrue (void);
+extern "C" void keyc_useFalse (void);
+extern "C" void keyc_useNull (void);
+extern "C" void keyc_useMemcpy (void);
+extern "C" void keyc_useIntMin (void);
+extern "C" void keyc_useUIntMin (void);
+extern "C" void keyc_useLongMin (void);
+extern "C" void keyc_useULongMin (void);
+extern "C" void keyc_useCharMin (void);
+extern "C" void keyc_useUCharMin (void);
+extern "C" void keyc_useIntMax (void);
+extern "C" void keyc_useUIntMax (void);
+extern "C" void keyc_useLongMax (void);
+extern "C" void keyc_useULongMax (void);
+extern "C" void keyc_useCharMax (void);
+extern "C" void keyc_useUCharMax (void);
+extern "C" void keyc_useSize_t (void);
+extern "C" void keyc_useSSize_t (void);
+extern "C" void keyc_useLabs (void);
+extern "C" void keyc_useAbs (void);
+extern "C" void keyc_useFabs (void);
+extern "C" void keyc_useFabsl (void);
+extern "C" void keyc_useException (void);
+extern "C" void keyc_useComplex (void);
+extern "C" void keyc_useM2RTS (void);
+extern "C" void keyc_useStrlen (void);
+extern "C" void keyc_useCtype (void);
+extern "C" void keyc_genDefs (mcPretty_pretty p);
+extern "C" void keyc_genConfigSystem (mcPretty_pretty p);
+extern "C" void keyc_enterScope (decl_node n);
+extern "C" void keyc_leaveScope (decl_node n);
+extern "C" DynamicStrings_String keyc_cname (nameKey_Name n, unsigned int scopes);
+extern "C" nameKey_Name keyc_cnamen (nameKey_Name n, unsigned int scopes);
+extern "C" void keyc_cp (void);
+extern "C" FIO_File mcStream_openFrag (unsigned int id);
+extern "C" void mcStream_setDest (FIO_File f);
+extern "C" FIO_File mcStream_combine (void);
+extern "C" void mcStream_removeFiles (void);
+extern "C" void StrIO_WriteLn (void);
+extern "C" void StrIO_ReadString (char *a, unsigned int _a_high);
+extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high);
+extern "C" void NumberIO_ReadCard (unsigned int *x);
+extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n);
+extern "C" void NumberIO_ReadHex (unsigned int *x);
+extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n);
+extern "C" void NumberIO_ReadInt (int *x);
+extern "C" void NumberIO_WriteInt (int x, unsigned int n);
+extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_ReadOct (unsigned int *x);
+extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n);
+extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_ReadBin (unsigned int *x);
+extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n);
+extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high);
+extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high);
+extern "C" void Assertion_Assert (unsigned int Condition);
+extern "C" void StdIO_Read (char *ch);
+extern "C" void StdIO_Write (char ch);
+extern "C" void StdIO_PushOutput (StdIO_ProcWrite p);
+extern "C" void StdIO_PopOutput (void);
+extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void);
+extern "C" void StdIO_PushInput (StdIO_ProcRead p);
+extern "C" void StdIO_PopInput (void);
+extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void);
+extern "C" void mcPrintf_printf0 (const char *a_, unsigned int _a_high);
+extern "C" void mcPrintf_printf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+extern "C" void mcPrintf_printf2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+extern "C" void mcPrintf_printf3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+extern "C" void mcPrintf_printf4 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high);
+extern "C" void mcPrintf_fprintf0 (FIO_File file, const char *a_, unsigned int _a_high);
+extern "C" void mcPrintf_fprintf1 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+extern "C" void mcPrintf_fprintf2 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+extern "C" void mcPrintf_fprintf3 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+extern "C" void mcPrintf_fprintf4 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high);
+
+/*
+ newNode - create and return a new node of kind k.
+*/
+
+static decl_node newNode (decl_nodeT k);
+
+/*
+ disposeNode - dispose node, n.
+*/
+
+static void disposeNode (decl_node *n);
+
+/*
+ isLocal - returns TRUE if symbol, n, is locally declared in a procedure.
+*/
+
+static unsigned int isLocal (decl_node n);
+
+/*
+ importEnumFields - if, n, is an enumeration type import the all fields into module, m.
+*/
+
+static void importEnumFields (decl_node m, decl_node n);
+
+/*
+ isComplex - returns TRUE if, n, is the complex type.
+*/
+
+static unsigned int isComplex (decl_node n);
+
+/*
+ isLongComplex - returns TRUE if, n, is the longcomplex type.
+*/
+
+static unsigned int isLongComplex (decl_node n);
+
+/*
+ isShortComplex - returns TRUE if, n, is the shortcomplex type.
+*/
+
+static unsigned int isShortComplex (decl_node n);
+
+/*
+ isAProcType - returns TRUE if, n, is a proctype or proc node.
+*/
+
+static unsigned int isAProcType (decl_node n);
+
+/*
+ initFixupInfo - initialize the fixupInfo record.
+*/
+
+static decl_fixupInfo initFixupInfo (void);
+
+/*
+ makeDef - returns a definition module node named, n.
+*/
+
+static decl_node makeDef (nameKey_Name n);
+
+/*
+ makeImp - returns an implementation module node named, n.
+*/
+
+static decl_node makeImp (nameKey_Name n);
+
+/*
+ makeModule - returns a module node named, n.
+*/
+
+static decl_node makeModule (nameKey_Name n);
+
+/*
+ isDefForC - returns TRUE if the definition module was defined FOR "C".
+*/
+
+static unsigned int isDefForC (decl_node n);
+
+/*
+ initDecls - initialize the decls, scopeT.
+*/
+
+static void initDecls (decl_scopeT *decls);
+
+/*
+ addTo - adds node, d, to scope decls and returns, d.
+ It stores, d, in the symbols tree associated with decls.
+*/
+
+static decl_node addTo (decl_scopeT *decls, decl_node d);
+
+/*
+ export - export node, n, from definition module, d.
+*/
+
+static void export_ (decl_node d, decl_node n);
+
+/*
+ addToScope - adds node, n, to the current scope and returns, n.
+*/
+
+static decl_node addToScope (decl_node n);
+
+/*
+ addModuleToScope - adds module, i, to module, m, scope.
+*/
+
+static void addModuleToScope (decl_node m, decl_node i);
+
+/*
+ completedEnum - assign boolean enumsComplete to TRUE if a definition,
+ implementation or module symbol.
+*/
+
+static void completedEnum (decl_node n);
+
+/*
+ setUnary - sets a unary node to contain, arg, a, and type, t.
+*/
+
+static void setUnary (decl_node u, decl_nodeT k, decl_node a, decl_node t);
+
+/*
+ putVarBool - assigns the four booleans associated with a variable.
+*/
+
+static void putVarBool (decl_node v, unsigned int init, unsigned int param, unsigned int isvar, unsigned int isused);
+
+/*
+ checkPtr - in C++ we need to create a typedef for a pointer
+ in case we need to use reinterpret_cast.
+*/
+
+static decl_node checkPtr (decl_node n);
+
+/*
+ isVarDecl - returns TRUE if, n, is a vardecl node.
+*/
+
+static unsigned int isVarDecl (decl_node n);
+
+/*
+ makeVariablesFromParameters - creates variables which are really parameters.
+*/
+
+static void makeVariablesFromParameters (decl_node proc, decl_node id, decl_node type, unsigned int isvar, unsigned int isused);
+
+/*
+ addProcedureToScope - add a procedure name n and node d to the
+ current scope.
+*/
+
+static decl_node addProcedureToScope (decl_node d, nameKey_Name n);
+
+/*
+ putProcTypeReturn - sets the return type of, proc, to, type.
+*/
+
+static void putProcTypeReturn (decl_node proc, decl_node type);
+
+/*
+ putProcTypeOptReturn - sets, proc, to have an optional return type.
+*/
+
+static void putProcTypeOptReturn (decl_node proc);
+
+/*
+ makeOptParameter - creates and returns an optarg.
+*/
+
+static decl_node makeOptParameter (decl_node l, decl_node type, decl_node init);
+
+/*
+ setwatch - assign the globalNode to n.
+*/
+
+static unsigned int setwatch (decl_node n);
+
+/*
+ runwatch - set the globalNode to an identlist.
+*/
+
+static unsigned int runwatch (void);
+
+/*
+ isIdentList - returns TRUE if, n, is an identlist.
+*/
+
+static unsigned int isIdentList (decl_node n);
+
+/*
+ identListLen - returns the length of identlist.
+*/
+
+static unsigned int identListLen (decl_node n);
+
+/*
+ checkParameters - placeholder for future parameter checking.
+*/
+
+static void checkParameters (decl_node p, decl_node i, decl_node type, unsigned int isvar, unsigned int isused);
+
+/*
+ checkMakeVariables - create shadow local variables for parameters providing that
+ procedure n has not already been built and we are compiling
+ a module or an implementation module.
+*/
+
+static void checkMakeVariables (decl_node n, decl_node i, decl_node type, unsigned int isvar, unsigned int isused);
+
+/*
+ makeVarientField - create a varient field within varient, v,
+ The new varient field is returned.
+*/
+
+static decl_node makeVarientField (decl_node v, decl_node p);
+
+/*
+ putFieldVarient - places the field varient, f, as a brother to, the
+ varient symbol, v, and also tells, f, that its varient
+ parent is, v.
+*/
+
+static void putFieldVarient (decl_node f, decl_node v);
+
+/*
+ putFieldRecord - create a new recordfield and place it into record r.
+ The new field has a tagname and type and can have a
+ variant field v.
+*/
+
+static decl_node putFieldRecord (decl_node r, nameKey_Name tag, decl_node type, decl_node v);
+
+/*
+ ensureOrder - ensures that, a, and, b, exist in, i, and also
+ ensure that, a, is before, b.
+*/
+
+static void ensureOrder (Indexing_Index i, decl_node a, decl_node b);
+
+/*
+ putVarientTag - places tag into variant v.
+*/
+
+static void putVarientTag (decl_node v, decl_node tag);
+
+/*
+ getParent - returns the parent field of recordfield or varientfield symbol, n.
+*/
+
+static decl_node getParent (decl_node n);
+
+/*
+ getRecord - returns the record associated with node, n.
+ (Parental record).
+*/
+
+static decl_node getRecord (decl_node n);
+
+/*
+ isConstExp - return TRUE if the node kind is a constexp.
+*/
+
+static unsigned int isConstExp (decl_node c);
+
+/*
+ addEnumToModule - adds enumeration type, e, into the list of enums
+ in module, m.
+*/
+
+static void addEnumToModule (decl_node m, decl_node e);
+
+/*
+ getNextFixup - return the next fixup from from f.
+*/
+
+static decl_node getNextFixup (decl_fixupInfo *f);
+
+/*
+ doMakeEnum - create an enumeration type and add it to the current module.
+*/
+
+static decl_node doMakeEnum (void);
+
+/*
+ doMakeEnumField - create an enumeration field name and add it to enumeration e.
+ Return the new field.
+*/
+
+static decl_node doMakeEnumField (decl_node e, nameKey_Name n);
+
+/*
+ getExpList - returns the, n, th argument in an explist.
+*/
+
+static decl_node getExpList (decl_node p, unsigned int n);
+
+/*
+ expListLen - returns the length of explist, p.
+*/
+
+static unsigned int expListLen (decl_node p);
+
+/*
+ getConstExpComplete - gets the field from the def or imp or module, n.
+*/
+
+static unsigned int getConstExpComplete (decl_node n);
+
+/*
+ addConstToModule - adds const exp, e, into the list of constant
+ expressions in module, m.
+*/
+
+static void addConstToModule (decl_node m, decl_node e);
+
+/*
+ doMakeConstExp - create a constexp node and add it to the current module.
+*/
+
+static decl_node doMakeConstExp (void);
+
+/*
+ isAnyType - return TRUE if node n is any type kind.
+*/
+
+static unsigned int isAnyType (decl_node n);
+
+/*
+ makeVal - creates a VAL (type, expression) node.
+*/
+
+static decl_node makeVal (decl_node params);
+
+/*
+ makeCast - creates a cast node TYPENAME (expr).
+*/
+
+static decl_node makeCast (decl_node c, decl_node p);
+static decl_node makeIntrinsicProc (decl_nodeT k, unsigned int noArgs, decl_node p);
+
+/*
+ makeIntrinsicUnaryType - create an intrisic unary type.
+*/
+
+static decl_node makeIntrinsicUnaryType (decl_nodeT k, decl_node paramList, decl_node returnType);
+
+/*
+ makeIntrinsicBinaryType - create an intrisic binary type.
+*/
+
+static decl_node makeIntrinsicBinaryType (decl_nodeT k, decl_node paramList, decl_node returnType);
+
+/*
+ checkIntrinsic - checks to see if the function call to, c, with
+ parameter list, n, is really an intrinic. If it
+ is an intrinic then an intrinic node is created
+ and returned. Otherwise NIL is returned.
+*/
+
+static decl_node checkIntrinsic (decl_node c, decl_node n);
+
+/*
+ checkCHeaders - check to see if the function is a C system function and
+ requires a header file included.
+*/
+
+static void checkCHeaders (decl_node c);
+
+/*
+ isFuncCall - returns TRUE if, n, is a function/procedure call.
+*/
+
+static unsigned int isFuncCall (decl_node n);
+
+/*
+ putTypeInternal - marks type, des, as being an internally generated type.
+*/
+
+static void putTypeInternal (decl_node des);
+
+/*
+ isTypeInternal - returns TRUE if type, n, is internal.
+*/
+
+static unsigned int isTypeInternal (decl_node n);
+
+/*
+ lookupBase - return node named n from the base symbol scope.
+*/
+
+static decl_node lookupBase (nameKey_Name n);
+
+/*
+ dumpScopes - display the names of all the scopes stacked.
+*/
+
+static void dumpScopes (void);
+
+/*
+ out0 - write string a to StdOut.
+*/
+
+static void out0 (const char *a_, unsigned int _a_high);
+
+/*
+ out1 - write string a to StdOut using format specifier a.
+*/
+
+static void out1 (const char *a_, unsigned int _a_high, decl_node s);
+
+/*
+ out2 - write string a to StdOut using format specifier a.
+*/
+
+static void out2 (const char *a_, unsigned int _a_high, unsigned int c, decl_node s);
+
+/*
+ out3 - write string a to StdOut using format specifier a.
+*/
+
+static void out3 (const char *a_, unsigned int _a_high, unsigned int l, nameKey_Name n, decl_node s);
+
+/*
+ isUnary - returns TRUE if, n, is an unary node.
+*/
+
+static unsigned int isUnary (decl_node n);
+
+/*
+ isBinary - returns TRUE if, n, is an binary node.
+*/
+
+static unsigned int isBinary (decl_node n);
+
+/*
+ makeUnary - create a unary expression node with, e, as the argument
+ and res as the return type.
+*/
+
+static decl_node makeUnary (decl_nodeT k, decl_node e, decl_node res);
+
+/*
+ isLeafString - returns TRUE if n is a leaf node which is a string constant.
+*/
+
+static unsigned int isLeafString (decl_node n);
+
+/*
+ getLiteralStringContents - return the contents of a literal node as a string.
+*/
+
+static DynamicStrings_String getLiteralStringContents (decl_node n);
+
+/*
+ getStringContents - return the string contents of a constant, literal,
+ string or a constexp node.
+*/
+
+static DynamicStrings_String getStringContents (decl_node n);
+
+/*
+ addNames -
+*/
+
+static nameKey_Name addNames (decl_node a, decl_node b);
+
+/*
+ resolveString -
+*/
+
+static decl_node resolveString (decl_node n);
+
+/*
+ foldBinary -
+*/
+
+static decl_node foldBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res);
+
+/*
+ makeBinary - create a binary node with left/right/result type: l, r and resultType.
+*/
+
+static decl_node makeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node resultType);
+
+/*
+ doMakeBinary - returns a binary node containing left/right/result values
+ l, r, res, with a node operator, k.
+*/
+
+static decl_node doMakeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res);
+
+/*
+ doMakeComponentRef -
+*/
+
+static decl_node doMakeComponentRef (decl_node rec, decl_node field);
+
+/*
+ isComponentRef -
+*/
+
+static unsigned int isComponentRef (decl_node n);
+
+/*
+ isArrayRef - returns TRUE if the node was an arrayref.
+*/
+
+static unsigned int isArrayRef (decl_node n);
+
+/*
+ isDeref - returns TRUE if, n, is a deref node.
+*/
+
+static unsigned int isDeref (decl_node n);
+
+/*
+ makeBase - create a base type or constant.
+ It only supports the base types and constants
+ enumerated below.
+*/
+
+static decl_node makeBase (decl_nodeT k);
+
+/*
+ isOrdinal - returns TRUE if, n, is an ordinal type.
+*/
+
+static unsigned int isOrdinal (decl_node n);
+
+/*
+ mixTypes -
+*/
+
+static decl_node mixTypes (decl_node a, decl_node b);
+
+/*
+ doSetExprType -
+*/
+
+static decl_node doSetExprType (decl_node *t, decl_node n);
+
+/*
+ getMaxMinType -
+*/
+
+static decl_node getMaxMinType (decl_node n);
+
+/*
+ doGetFuncType -
+*/
+
+static decl_node doGetFuncType (decl_node n);
+
+/*
+ doGetExprType - works out the type which is associated with node, n.
+*/
+
+static decl_node doGetExprType (decl_node n);
+
+/*
+ getExprType - return the expression type.
+*/
+
+static decl_node getExprType (decl_node n);
+
+/*
+ openOutput -
+*/
+
+static void openOutput (void);
+
+/*
+ closeOutput -
+*/
+
+static void closeOutput (void);
+
+/*
+ write - outputs a single char, ch.
+*/
+
+static void write_ (char ch);
+
+/*
+ writeln -
+*/
+
+static void writeln (void);
+
+/*
+ doIncludeC - include header file for definition module, n.
+*/
+
+static void doIncludeC (decl_node n);
+
+/*
+ getSymScope - returns the scope where node, n, was declared.
+*/
+
+static decl_node getSymScope (decl_node n);
+
+/*
+ isQualifiedForced - should the node be written with a module prefix?
+*/
+
+static unsigned int isQualifiedForced (decl_node n);
+
+/*
+ getFQstring -
+*/
+
+static DynamicStrings_String getFQstring (decl_node n);
+
+/*
+ getFQDstring -
+*/
+
+static DynamicStrings_String getFQDstring (decl_node n, unsigned int scopes);
+
+/*
+ getString - returns the name as a string.
+*/
+
+static DynamicStrings_String getString (decl_node n);
+
+/*
+ doNone - call HALT.
+*/
+
+static void doNone (decl_node n);
+
+/*
+ doNothing - does nothing!
+*/
+
+static void doNothing (decl_node n);
+
+/*
+ doConstC -
+*/
+
+static void doConstC (decl_node n);
+
+/*
+ needsParen - returns TRUE if expression, n, needs to be enclosed in ().
+*/
+
+static unsigned int needsParen (decl_node n);
+
+/*
+ doUnary -
+*/
+
+static void doUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr, decl_node type, unsigned int l, unsigned int r);
+
+/*
+ doSetSub - perform l & (~ r)
+*/
+
+static void doSetSub (mcPretty_pretty p, decl_node left, decl_node right);
+
+/*
+ doPolyBinary -
+*/
+
+static void doPolyBinary (mcPretty_pretty p, decl_nodeT op, decl_node left, decl_node right, unsigned int l, unsigned int r);
+
+/*
+ doBinary -
+*/
+
+static void doBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r, unsigned int unpackProc);
+
+/*
+ doPostUnary -
+*/
+
+static void doPostUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr);
+
+/*
+ doDeRefC -
+*/
+
+static void doDeRefC (mcPretty_pretty p, decl_node expr);
+
+/*
+ doGetLastOp - returns, a, if b is a terminal otherwise walk right.
+*/
+
+static decl_node doGetLastOp (decl_node a, decl_node b);
+
+/*
+ doComponentRefC -
+*/
+
+static void doComponentRefC (mcPretty_pretty p, decl_node l, decl_node r);
+
+/*
+ doPointerRefC -
+*/
+
+static void doPointerRefC (mcPretty_pretty p, decl_node l, decl_node r);
+
+/*
+ doPreBinary -
+*/
+
+static void doPreBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r);
+
+/*
+ doConstExpr -
+*/
+
+static void doConstExpr (mcPretty_pretty p, decl_node n);
+
+/*
+ doEnumerationField -
+*/
+
+static void doEnumerationField (mcPretty_pretty p, decl_node n);
+
+/*
+ isZero - returns TRUE if node, n, is zero.
+*/
+
+static unsigned int isZero (decl_node n);
+
+/*
+ doArrayRef -
+*/
+
+static void doArrayRef (mcPretty_pretty p, decl_node n);
+
+/*
+ doProcedure -
+*/
+
+static void doProcedure (mcPretty_pretty p, decl_node n);
+
+/*
+ doRecordfield -
+*/
+
+static void doRecordfield (mcPretty_pretty p, decl_node n);
+
+/*
+ doCastC -
+*/
+
+static void doCastC (mcPretty_pretty p, decl_node t, decl_node e);
+
+/*
+ doSetValueC -
+*/
+
+static void doSetValueC (mcPretty_pretty p, decl_node n);
+
+/*
+ getSetLow - returns the low value of the set type from
+ expression, n.
+*/
+
+static decl_node getSetLow (decl_node n);
+
+/*
+ doInC - performs (((1 << (l)) & (r)) != 0)
+*/
+
+static void doInC (mcPretty_pretty p, decl_node l, decl_node r);
+
+/*
+ doThrowC -
+*/
+
+static void doThrowC (mcPretty_pretty p, decl_node n);
+
+/*
+ doUnreachableC -
+*/
+
+static void doUnreachableC (mcPretty_pretty p, decl_node n);
+
+/*
+ outNull -
+*/
+
+static void outNull (mcPretty_pretty p);
+
+/*
+ outTrue -
+*/
+
+static void outTrue (mcPretty_pretty p);
+
+/*
+ outFalse -
+*/
+
+static void outFalse (mcPretty_pretty p);
+
+/*
+ doExprC -
+*/
+
+static void doExprC (mcPretty_pretty p, decl_node n);
+
+/*
+ doExprCup -
+*/
+
+static void doExprCup (mcPretty_pretty p, decl_node n, unsigned int unpackProc);
+
+/*
+ doExprM2 -
+*/
+
+static void doExprM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doVar -
+*/
+
+static void doVar (mcPretty_pretty p, decl_node n);
+
+/*
+ doLiteralC -
+*/
+
+static void doLiteralC (mcPretty_pretty p, decl_node n);
+
+/*
+ doLiteral -
+*/
+
+static void doLiteral (mcPretty_pretty p, decl_node n);
+
+/*
+ isString - returns TRUE if node, n, is a string.
+*/
+
+static unsigned int isString (decl_node n);
+
+/*
+ doString -
+*/
+
+static void doString (mcPretty_pretty p, decl_node n);
+
+/*
+ replaceChar - replace every occurance of, ch, by, a and return modified string, s.
+*/
+
+static DynamicStrings_String replaceChar (DynamicStrings_String s, char ch, const char *a_, unsigned int _a_high);
+
+/*
+ toCstring - translates string, n, into a C string
+ and returns the new String.
+*/
+
+static DynamicStrings_String toCstring (nameKey_Name n);
+
+/*
+ toCchar -
+*/
+
+static DynamicStrings_String toCchar (nameKey_Name n);
+
+/*
+ countChar -
+*/
+
+static unsigned int countChar (DynamicStrings_String s, char ch);
+
+/*
+ lenCstring -
+*/
+
+static unsigned int lenCstring (DynamicStrings_String s);
+
+/*
+ outCstring -
+*/
+
+static void outCstring (mcPretty_pretty p, decl_node s, unsigned int aString);
+
+/*
+ doStringC -
+*/
+
+static void doStringC (mcPretty_pretty p, decl_node n);
+
+/*
+ isPunct -
+*/
+
+static unsigned int isPunct (char ch);
+
+/*
+ isWhite -
+*/
+
+static unsigned int isWhite (char ch);
+
+/*
+ outText -
+*/
+
+static void outText (mcPretty_pretty p, const char *a_, unsigned int _a_high);
+
+/*
+ outRawS -
+*/
+
+static void outRawS (mcPretty_pretty p, DynamicStrings_String s);
+
+/*
+ outKm2 -
+*/
+
+static mcPretty_pretty outKm2 (mcPretty_pretty p, const char *a_, unsigned int _a_high);
+
+/*
+ outKc -
+*/
+
+static mcPretty_pretty outKc (mcPretty_pretty p, const char *a_, unsigned int _a_high);
+
+/*
+ outTextS -
+*/
+
+static void outTextS (mcPretty_pretty p, DynamicStrings_String s);
+
+/*
+ outCard -
+*/
+
+static void outCard (mcPretty_pretty p, unsigned int c);
+
+/*
+ outTextN -
+*/
+
+static void outTextN (mcPretty_pretty p, nameKey_Name n);
+
+/*
+ doTypeAliasC -
+*/
+
+static void doTypeAliasC (mcPretty_pretty p, decl_node n, decl_node *m);
+
+/*
+ doEnumerationC -
+*/
+
+static void doEnumerationC (mcPretty_pretty p, decl_node n);
+
+/*
+ doNamesC -
+*/
+
+static void doNamesC (mcPretty_pretty p, nameKey_Name n);
+
+/*
+ doNameC -
+*/
+
+static void doNameC (mcPretty_pretty p, decl_node n);
+
+/*
+ initCname -
+*/
+
+static void initCname (decl_cnameT *c);
+
+/*
+ doCname -
+*/
+
+static nameKey_Name doCname (nameKey_Name n, decl_cnameT *c, unsigned int scopes);
+
+/*
+ getDName -
+*/
+
+static nameKey_Name getDName (decl_node n, unsigned int scopes);
+
+/*
+ doDNameC -
+*/
+
+static void doDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes);
+
+/*
+ doFQDNameC -
+*/
+
+static void doFQDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes);
+
+/*
+ doFQNameC -
+*/
+
+static void doFQNameC (mcPretty_pretty p, decl_node n);
+
+/*
+ doNameM2 -
+*/
+
+static void doNameM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doUsed -
+*/
+
+static void doUsed (mcPretty_pretty p, unsigned int used);
+
+/*
+ doHighC -
+*/
+
+static void doHighC (mcPretty_pretty p, decl_node a, nameKey_Name n, unsigned int isused);
+
+/*
+ doParamConstCast -
+*/
+
+static void doParamConstCast (mcPretty_pretty p, decl_node n);
+
+/*
+ getParameterVariable - returns the variable which shadows the parameter
+ named, m, in parameter block, n.
+*/
+
+static decl_node getParameterVariable (decl_node n, nameKey_Name m);
+
+/*
+ doParamTypeEmit - emit parameter type for C/C++. It checks to see if the
+ parameter type is a procedure type and if it were declared
+ in a definition module for "C" and if so it uses the "C"
+ definition for a procedure type, rather than the mc
+ C++ version.
+*/
+
+static void doParamTypeEmit (mcPretty_pretty p, decl_node paramnode, decl_node paramtype);
+
+/*
+ doParamC - emit parameter for C/C++.
+*/
+
+static void doParamC (mcPretty_pretty p, decl_node n);
+
+/*
+ doVarParamC - emit a VAR parameter for C/C++.
+*/
+
+static void doVarParamC (mcPretty_pretty p, decl_node n);
+
+/*
+ doOptargC -
+*/
+
+static void doOptargC (mcPretty_pretty p, decl_node n);
+
+/*
+ doParameterC -
+*/
+
+static void doParameterC (mcPretty_pretty p, decl_node n);
+
+/*
+ doProcTypeC -
+*/
+
+static void doProcTypeC (mcPretty_pretty p, decl_node t, decl_node n);
+
+/*
+ doTypesC -
+*/
+
+static void doTypesC (decl_node n);
+
+/*
+ doCompletePartialC -
+*/
+
+static void doCompletePartialC (decl_node n);
+
+/*
+ doCompletePartialRecord -
+*/
+
+static void doCompletePartialRecord (mcPretty_pretty p, decl_node t, decl_node r);
+
+/*
+ doCompletePartialArray -
+*/
+
+static void doCompletePartialArray (mcPretty_pretty p, decl_node t, decl_node r);
+
+/*
+ lookupConst -
+*/
+
+static decl_node lookupConst (decl_node type, nameKey_Name n);
+
+/*
+ doMin -
+*/
+
+static decl_node doMin (decl_node n);
+
+/*
+ doMax -
+*/
+
+static decl_node doMax (decl_node n);
+
+/*
+ getMax -
+*/
+
+static decl_node getMax (decl_node n);
+
+/*
+ getMin -
+*/
+
+static decl_node getMin (decl_node n);
+
+/*
+ doSubtractC -
+*/
+
+static void doSubtractC (mcPretty_pretty p, decl_node s);
+
+/*
+ doSubrC -
+*/
+
+static void doSubrC (mcPretty_pretty p, decl_node s);
+
+/*
+ doCompletePartialProcType -
+*/
+
+static void doCompletePartialProcType (mcPretty_pretty p, decl_node t, decl_node n);
+
+/*
+ isBase -
+*/
+
+static unsigned int isBase (decl_node n);
+
+/*
+ doBaseC -
+*/
+
+static void doBaseC (mcPretty_pretty p, decl_node n);
+
+/*
+ isSystem -
+*/
+
+static unsigned int isSystem (decl_node n);
+
+/*
+ doSystemC -
+*/
+
+static void doSystemC (mcPretty_pretty p, decl_node n);
+
+/*
+ doArrayC -
+*/
+
+static void doArrayC (mcPretty_pretty p, decl_node n);
+
+/*
+ doPointerC -
+*/
+
+static void doPointerC (mcPretty_pretty p, decl_node n, decl_node *m);
+
+/*
+ doRecordFieldC -
+*/
+
+static void doRecordFieldC (mcPretty_pretty p, decl_node f);
+
+/*
+ doVarientFieldC -
+*/
+
+static void doVarientFieldC (mcPretty_pretty p, decl_node n);
+
+/*
+ doVarientC -
+*/
+
+static void doVarientC (mcPretty_pretty p, decl_node n);
+
+/*
+ doRecordC -
+*/
+
+static void doRecordC (mcPretty_pretty p, decl_node n, decl_node *m);
+
+/*
+ isBitset -
+*/
+
+static unsigned int isBitset (decl_node n);
+
+/*
+ isNegative - returns TRUE if expression, n, is negative.
+*/
+
+static unsigned int isNegative (decl_node n);
+
+/*
+ doSubrangeC -
+*/
+
+static void doSubrangeC (mcPretty_pretty p, decl_node n);
+
+/*
+ doSetC - generates a C type which holds the set.
+ Currently we only support sets of size WORD.
+*/
+
+static void doSetC (mcPretty_pretty p, decl_node n);
+
+/*
+ doTypeC -
+*/
+
+static void doTypeC (mcPretty_pretty p, decl_node n, decl_node *m);
+
+/*
+ doArrayNameC - it displays the array declaration (it might be an unbounded).
+*/
+
+static void doArrayNameC (mcPretty_pretty p, decl_node n);
+
+/*
+ doRecordNameC - emit the C/C++ record name <name of n>"_r".
+*/
+
+static void doRecordNameC (mcPretty_pretty p, decl_node n);
+
+/*
+ doPointerNameC - emit the C/C++ pointer type <name of n>*.
+*/
+
+static void doPointerNameC (mcPretty_pretty p, decl_node n);
+
+/*
+ doTypeNameC -
+*/
+
+static void doTypeNameC (mcPretty_pretty p, decl_node n);
+
+/*
+ isExternal - returns TRUE if symbol, n, was declared in another module.
+*/
+
+static unsigned int isExternal (decl_node n);
+
+/*
+ doVarC -
+*/
+
+static void doVarC (decl_node n);
+
+/*
+ doExternCP -
+*/
+
+static void doExternCP (mcPretty_pretty p);
+
+/*
+ doProcedureCommentText -
+*/
+
+static void doProcedureCommentText (mcPretty_pretty p, DynamicStrings_String s);
+
+/*
+ doProcedureComment -
+*/
+
+static void doProcedureComment (mcPretty_pretty p, DynamicStrings_String s);
+
+/*
+ doProcedureHeadingC -
+*/
+
+static void doProcedureHeadingC (decl_node n, unsigned int prototype);
+
+/*
+ checkDeclareUnboundedParamCopyC -
+*/
+
+static unsigned int checkDeclareUnboundedParamCopyC (mcPretty_pretty p, decl_node n);
+
+/*
+ checkUnboundedParamCopyC -
+*/
+
+static void checkUnboundedParamCopyC (mcPretty_pretty p, decl_node n);
+
+/*
+ doUnboundedParamCopyC -
+*/
+
+static void doUnboundedParamCopyC (mcPretty_pretty p, decl_node n);
+
+/*
+ doPrototypeC -
+*/
+
+static void doPrototypeC (decl_node n);
+
+/*
+ addTodo - adds, n, to the todo list.
+*/
+
+static void addTodo (decl_node n);
+
+/*
+ addVariablesTodo -
+*/
+
+static void addVariablesTodo (decl_node n);
+
+/*
+ addTypesTodo -
+*/
+
+static void addTypesTodo (decl_node n);
+
+/*
+ tempName -
+*/
+
+static DynamicStrings_String tempName (void);
+
+/*
+ makeIntermediateType -
+*/
+
+static decl_node makeIntermediateType (DynamicStrings_String s, decl_node p);
+
+/*
+ simplifyType -
+*/
+
+static void simplifyType (alists_alist l, decl_node *p);
+
+/*
+ simplifyVar -
+*/
+
+static void simplifyVar (alists_alist l, decl_node n);
+
+/*
+ simplifyRecord -
+*/
+
+static void simplifyRecord (alists_alist l, decl_node n);
+
+/*
+ simplifyVarient -
+*/
+
+static void simplifyVarient (alists_alist l, decl_node n);
+
+/*
+ simplifyVarientField -
+*/
+
+static void simplifyVarientField (alists_alist l, decl_node n);
+
+/*
+ doSimplifyNode -
+*/
+
+static void doSimplifyNode (alists_alist l, decl_node n);
+
+/*
+ simplifyNode -
+*/
+
+static void simplifyNode (alists_alist l, decl_node n);
+
+/*
+ doSimplify -
+*/
+
+static void doSimplify (decl_node n);
+
+/*
+ simplifyTypes -
+*/
+
+static void simplifyTypes (decl_scopeT s);
+
+/*
+ outDeclsDefC -
+*/
+
+static void outDeclsDefC (mcPretty_pretty p, decl_node n);
+
+/*
+ includeConstType -
+*/
+
+static void includeConstType (decl_scopeT s);
+
+/*
+ includeVarProcedure -
+*/
+
+static void includeVarProcedure (decl_scopeT s);
+
+/*
+ includeVar -
+*/
+
+static void includeVar (decl_scopeT s);
+
+/*
+ includeExternals -
+*/
+
+static void includeExternals (decl_node n);
+
+/*
+ checkSystemInclude -
+*/
+
+static void checkSystemInclude (decl_node n);
+
+/*
+ addExported -
+*/
+
+static void addExported (decl_node n);
+
+/*
+ addExternal - only adds, n, if this symbol is external to the
+ implementation module and is not a hidden type.
+*/
+
+static void addExternal (decl_node n);
+
+/*
+ includeDefConstType -
+*/
+
+static void includeDefConstType (decl_node n);
+
+/*
+ runIncludeDefConstType -
+*/
+
+static void runIncludeDefConstType (decl_node n);
+
+/*
+ joinProcedures - copies procedures from definition module,
+ d, into implementation module, i.
+*/
+
+static void joinProcedures (decl_node i, decl_node d);
+
+/*
+ includeDefVarProcedure -
+*/
+
+static void includeDefVarProcedure (decl_node n);
+
+/*
+ foreachModuleDo -
+*/
+
+static void foreachModuleDo (decl_node n, symbolKey_performOperation p);
+
+/*
+ outDeclsImpC -
+*/
+
+static void outDeclsImpC (mcPretty_pretty p, decl_scopeT s);
+
+/*
+ doStatementSequenceC -
+*/
+
+static void doStatementSequenceC (mcPretty_pretty p, decl_node s);
+
+/*
+ isStatementSequenceEmpty -
+*/
+
+static unsigned int isStatementSequenceEmpty (decl_node s);
+
+/*
+ isSingleStatement - returns TRUE if the statement sequence, s, has
+ only one statement.
+*/
+
+static unsigned int isSingleStatement (decl_node s);
+
+/*
+ doCommentC -
+*/
+
+static void doCommentC (mcPretty_pretty p, decl_node s);
+
+/*
+ doAfterCommentC - emit an after comment, c, or a newline if, c, is empty.
+*/
+
+static void doAfterCommentC (mcPretty_pretty p, decl_node c);
+
+/*
+ doReturnC - issue a return statement and also place in an after comment if one exists.
+*/
+
+static void doReturnC (mcPretty_pretty p, decl_node s);
+
+/*
+ isZtypeEquivalent -
+*/
+
+static unsigned int isZtypeEquivalent (decl_node type);
+
+/*
+ isEquivalentType - returns TRUE if type1 and type2 are equivalent.
+*/
+
+static unsigned int isEquivalentType (decl_node type1, decl_node type2);
+
+/*
+ doExprCastC - build a cast if necessary.
+*/
+
+static void doExprCastC (mcPretty_pretty p, decl_node e, decl_node type);
+
+/*
+ requiresUnpackProc - returns TRUE if either the expr is a procedure or the proctypes differ.
+*/
+
+static unsigned int requiresUnpackProc (decl_node s);
+
+/*
+ doAssignmentC -
+*/
+
+static void doAssignmentC (mcPretty_pretty p, decl_node s);
+
+/*
+ containsStatement -
+*/
+
+static unsigned int containsStatement (decl_node s);
+
+/*
+ doCompoundStmt -
+*/
+
+static void doCompoundStmt (mcPretty_pretty p, decl_node s);
+
+/*
+ doElsifC -
+*/
+
+static void doElsifC (mcPretty_pretty p, decl_node s);
+
+/*
+ noIfElse -
+*/
+
+static unsigned int noIfElse (decl_node n);
+
+/*
+ noIfElseChained - returns TRUE if, n, is an IF statement which
+ has no associated ELSE statement. An IF with an
+ ELSIF is also checked for no ELSE and will result
+ in a return value of TRUE.
+*/
+
+static unsigned int noIfElseChained (decl_node n);
+
+/*
+ hasIfElse -
+*/
+
+static unsigned int hasIfElse (decl_node n);
+
+/*
+ isIfElse -
+*/
+
+static unsigned int isIfElse (decl_node n);
+
+/*
+ hasIfAndNoElse - returns TRUE if statement, n, is a single statement
+ which is an IF and it has no else statement.
+*/
+
+static unsigned int hasIfAndNoElse (decl_node n);
+
+/*
+ doIfC - issue an if statement and also place in an after comment if one exists.
+ The if statement might contain an else or elsif which are also handled.
+*/
+
+static void doIfC (mcPretty_pretty p, decl_node s);
+
+/*
+ doForIncCP -
+*/
+
+static void doForIncCP (mcPretty_pretty p, decl_node s);
+
+/*
+ doForIncC -
+*/
+
+static void doForIncC (mcPretty_pretty p, decl_node s);
+
+/*
+ doForInc -
+*/
+
+static void doForInc (mcPretty_pretty p, decl_node s);
+
+/*
+ doForC -
+*/
+
+static void doForC (mcPretty_pretty p, decl_node s);
+
+/*
+ doRepeatC -
+*/
+
+static void doRepeatC (mcPretty_pretty p, decl_node s);
+
+/*
+ doWhileC -
+*/
+
+static void doWhileC (mcPretty_pretty p, decl_node s);
+
+/*
+ doFuncHighC -
+*/
+
+static void doFuncHighC (mcPretty_pretty p, decl_node a);
+
+/*
+ doMultiplyBySize -
+*/
+
+static void doMultiplyBySize (mcPretty_pretty p, decl_node a);
+
+/*
+ doTotype -
+*/
+
+static void doTotype (mcPretty_pretty p, decl_node a, decl_node t);
+
+/*
+ doFuncUnbounded -
+*/
+
+static void doFuncUnbounded (mcPretty_pretty p, decl_node actual, decl_node formalParam, decl_node formal, decl_node func);
+
+/*
+ doProcedureParamC -
+*/
+
+static void doProcedureParamC (mcPretty_pretty p, decl_node actual, decl_node formal);
+
+/*
+ doAdrExprC -
+*/
+
+static void doAdrExprC (mcPretty_pretty p, decl_node n);
+
+/*
+ typePair -
+*/
+
+static unsigned int typePair (decl_node a, decl_node b, decl_node x, decl_node y);
+
+/*
+ needsCast - return TRUE if the actual type parameter needs to be cast to
+ the formal type.
+*/
+
+static unsigned int needsCast (decl_node at, decl_node ft);
+
+/*
+ checkSystemCast - checks to see if we are passing to/from
+ a system generic type (WORD, BYTE, ADDRESS)
+ and if so emit a cast. It returns the number of
+ open parenthesis.
+*/
+
+static unsigned int checkSystemCast (mcPretty_pretty p, decl_node actual, decl_node formal);
+
+/*
+ emitN -
+*/
+
+static void emitN (mcPretty_pretty p, const char *a_, unsigned int _a_high, unsigned int n);
+
+/*
+ isForC - return true if node n is a varparam, param or procedure
+ which was declared inside a definition module for "C".
+*/
+
+static unsigned int isForC (decl_node n);
+
+/*
+ isDefForCNode - return TRUE if node n was declared inside a definition module for "C".
+*/
+
+static unsigned int isDefForCNode (decl_node n);
+
+/*
+ doFuncParamC -
+*/
+
+static void doFuncParamC (mcPretty_pretty p, decl_node actual, decl_node formal, decl_node func);
+
+/*
+ getNthParamType - return the type of parameter, i, in list, l.
+ If the parameter is a vararg NIL is returned.
+*/
+
+static decl_node getNthParamType (Indexing_Index l, unsigned int i);
+
+/*
+ getNthParam - return the parameter, i, in list, l.
+ If the parameter is a vararg NIL is returned.
+*/
+
+static decl_node getNthParam (Indexing_Index l, unsigned int i);
+
+/*
+ doFuncArgsC -
+*/
+
+static void doFuncArgsC (mcPretty_pretty p, decl_node s, Indexing_Index l, unsigned int needParen);
+
+/*
+ doProcTypeArgsC -
+*/
+
+static void doProcTypeArgsC (mcPretty_pretty p, decl_node s, Indexing_Index args, unsigned int needParen);
+
+/*
+ doAdrArgC -
+*/
+
+static void doAdrArgC (mcPretty_pretty p, decl_node n);
+
+/*
+ doAdrC -
+*/
+
+static void doAdrC (mcPretty_pretty p, decl_node n);
+
+/*
+ doInc -
+*/
+
+static void doInc (mcPretty_pretty p, decl_node n);
+
+/*
+ doDec -
+*/
+
+static void doDec (mcPretty_pretty p, decl_node n);
+
+/*
+ doIncDecC -
+*/
+
+static void doIncDecC (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high);
+
+/*
+ doIncDecCP -
+*/
+
+static void doIncDecCP (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high);
+
+/*
+ doInclC -
+*/
+
+static void doInclC (mcPretty_pretty p, decl_node n);
+
+/*
+ doExclC -
+*/
+
+static void doExclC (mcPretty_pretty p, decl_node n);
+
+/*
+ doNewC -
+*/
+
+static void doNewC (mcPretty_pretty p, decl_node n);
+
+/*
+ doDisposeC -
+*/
+
+static void doDisposeC (mcPretty_pretty p, decl_node n);
+
+/*
+ doCapC -
+*/
+
+static void doCapC (mcPretty_pretty p, decl_node n);
+
+/*
+ doLengthC -
+*/
+
+static void doLengthC (mcPretty_pretty p, decl_node n);
+
+/*
+ doAbsC -
+*/
+
+static void doAbsC (mcPretty_pretty p, decl_node n);
+
+/*
+ doValC -
+*/
+
+static void doValC (mcPretty_pretty p, decl_node n);
+
+/*
+ doMinC -
+*/
+
+static void doMinC (mcPretty_pretty p, decl_node n);
+
+/*
+ doMaxC -
+*/
+
+static void doMaxC (mcPretty_pretty p, decl_node n);
+
+/*
+ isIntrinsic - returns if, n, is an intrinsic procedure.
+ The intrinsic functions are represented as unary and binary nodes.
+*/
+
+static unsigned int isIntrinsic (decl_node n);
+
+/*
+ doHalt -
+*/
+
+static void doHalt (mcPretty_pretty p, decl_node n);
+
+/*
+ doCreal - emit the appropriate creal function.
+*/
+
+static void doCreal (mcPretty_pretty p, decl_node t);
+
+/*
+ doCimag - emit the appropriate cimag function.
+*/
+
+static void doCimag (mcPretty_pretty p, decl_node t);
+
+/*
+ doReC -
+*/
+
+static void doReC (mcPretty_pretty p, decl_node n);
+
+/*
+ doImC -
+*/
+
+static void doImC (mcPretty_pretty p, decl_node n);
+
+/*
+ doCmplx -
+*/
+
+static void doCmplx (mcPretty_pretty p, decl_node n);
+
+/*
+ doIntrinsicC -
+*/
+
+static void doIntrinsicC (mcPretty_pretty p, decl_node n);
+
+/*
+ isIntrinsicFunction - returns true if, n, is an instrinsic function.
+*/
+
+static unsigned int isIntrinsicFunction (decl_node n);
+
+/*
+ doSizeC -
+*/
+
+static void doSizeC (mcPretty_pretty p, decl_node n);
+
+/*
+ doConvertC -
+*/
+
+static void doConvertC (mcPretty_pretty p, decl_node n, const char *conversion_, unsigned int _conversion_high);
+
+/*
+ getFuncFromExpr -
+*/
+
+static decl_node getFuncFromExpr (decl_node n);
+
+/*
+ doFuncExprC -
+*/
+
+static void doFuncExprC (mcPretty_pretty p, decl_node n);
+
+/*
+ doFuncCallC -
+*/
+
+static void doFuncCallC (mcPretty_pretty p, decl_node n);
+
+/*
+ doCaseStatementC -
+*/
+
+static void doCaseStatementC (mcPretty_pretty p, decl_node n, unsigned int needBreak);
+
+/*
+ doExceptionC -
+*/
+
+static void doExceptionC (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n);
+
+/*
+ doExceptionCP -
+*/
+
+static void doExceptionCP (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n);
+
+/*
+ doException -
+*/
+
+static void doException (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n);
+
+/*
+ doRangeListC -
+*/
+
+static void doRangeListC (mcPretty_pretty p, decl_node c);
+
+/*
+ doRangeIfListC -
+*/
+
+static void doRangeIfListC (mcPretty_pretty p, decl_node e, decl_node c);
+
+/*
+ doCaseLabels -
+*/
+
+static void doCaseLabels (mcPretty_pretty p, decl_node n, unsigned int needBreak);
+
+/*
+ doCaseLabelListC -
+*/
+
+static void doCaseLabelListC (mcPretty_pretty p, decl_node n, unsigned int haveElse);
+
+/*
+ doCaseIfLabels -
+*/
+
+static void doCaseIfLabels (mcPretty_pretty p, decl_node e, decl_node n, unsigned int i, unsigned int h);
+
+/*
+ doCaseIfLabelListC -
+*/
+
+static void doCaseIfLabelListC (mcPretty_pretty p, decl_node n);
+
+/*
+ doCaseElseC -
+*/
+
+static void doCaseElseC (mcPretty_pretty p, decl_node n);
+
+/*
+ doCaseIfElseC -
+*/
+
+static void doCaseIfElseC (mcPretty_pretty p, decl_node n);
+
+/*
+ canUseSwitchCaseLabels - returns TRUE if all the case labels are
+ single values and not ranges.
+*/
+
+static unsigned int canUseSwitchCaseLabels (decl_node n);
+
+/*
+ canUseSwitch - returns TRUE if the case statement can be implement
+ by a switch statement. This will be TRUE if all case
+ selectors are single values rather than ranges.
+*/
+
+static unsigned int canUseSwitch (decl_node n);
+
+/*
+ doCaseC -
+*/
+
+static void doCaseC (mcPretty_pretty p, decl_node n);
+
+/*
+ doLoopC -
+*/
+
+static void doLoopC (mcPretty_pretty p, decl_node s);
+
+/*
+ doExitC -
+*/
+
+static void doExitC (mcPretty_pretty p, decl_node s);
+
+/*
+ doStatementsC -
+*/
+
+static void doStatementsC (mcPretty_pretty p, decl_node s);
+static void stop (void);
+
+/*
+ doLocalVarC -
+*/
+
+static void doLocalVarC (mcPretty_pretty p, decl_scopeT s);
+
+/*
+ doLocalConstTypesC -
+*/
+
+static void doLocalConstTypesC (mcPretty_pretty p, decl_scopeT s);
+
+/*
+ addParamDone -
+*/
+
+static void addParamDone (decl_node n);
+
+/*
+ includeParameters -
+*/
+
+static void includeParameters (decl_node n);
+
+/*
+ isHalt -
+*/
+
+static unsigned int isHalt (decl_node n);
+
+/*
+ isReturnOrHalt -
+*/
+
+static unsigned int isReturnOrHalt (decl_node n);
+
+/*
+ isLastStatementReturn -
+*/
+
+static unsigned int isLastStatementReturn (decl_node n);
+
+/*
+ isLastStatementSequence -
+*/
+
+static unsigned int isLastStatementSequence (decl_node n, decl_isNodeF q);
+
+/*
+ isLastStatementIf -
+*/
+
+static unsigned int isLastStatementIf (decl_node n, decl_isNodeF q);
+
+/*
+ isLastStatementElsif -
+*/
+
+static unsigned int isLastStatementElsif (decl_node n, decl_isNodeF q);
+
+/*
+ isLastStatementCase -
+*/
+
+static unsigned int isLastStatementCase (decl_node n, decl_isNodeF q);
+
+/*
+ isLastStatement - returns TRUE if the last statement in, n, is, q.
+*/
+
+static unsigned int isLastStatement (decl_node n, decl_isNodeF q);
+
+/*
+ doProcedureC -
+*/
+
+static void doProcedureC (decl_node n);
+
+/*
+ outProceduresC -
+*/
+
+static void outProceduresC (mcPretty_pretty p, decl_scopeT s);
+
+/*
+ output -
+*/
+
+static void output (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v);
+
+/*
+ allDependants -
+*/
+
+static decl_dependentState allDependants (decl_node n);
+
+/*
+ walkDependants -
+*/
+
+static decl_dependentState walkDependants (alists_alist l, decl_node n);
+
+/*
+ walkType -
+*/
+
+static decl_dependentState walkType (alists_alist l, decl_node n);
+
+/*
+ db -
+*/
+
+static void db (const char *a_, unsigned int _a_high, decl_node n);
+
+/*
+ dbt -
+*/
+
+static void dbt (const char *a_, unsigned int _a_high);
+
+/*
+ dbs -
+*/
+
+static void dbs (decl_dependentState s, decl_node n);
+
+/*
+ dbq -
+*/
+
+static void dbq (decl_node n);
+
+/*
+ walkRecord -
+*/
+
+static decl_dependentState walkRecord (alists_alist l, decl_node n);
+
+/*
+ walkVarient -
+*/
+
+static decl_dependentState walkVarient (alists_alist l, decl_node n);
+
+/*
+ queueBlocked -
+*/
+
+static void queueBlocked (decl_node n);
+
+/*
+ walkVar -
+*/
+
+static decl_dependentState walkVar (alists_alist l, decl_node n);
+
+/*
+ walkEnumeration -
+*/
+
+static decl_dependentState walkEnumeration (alists_alist l, decl_node n);
+
+/*
+ walkSubrange -
+*/
+
+static decl_dependentState walkSubrange (alists_alist l, decl_node n);
+
+/*
+ walkSubscript -
+*/
+
+static decl_dependentState walkSubscript (alists_alist l, decl_node n);
+
+/*
+ walkPointer -
+*/
+
+static decl_dependentState walkPointer (alists_alist l, decl_node n);
+
+/*
+ walkArray -
+*/
+
+static decl_dependentState walkArray (alists_alist l, decl_node n);
+
+/*
+ walkConst -
+*/
+
+static decl_dependentState walkConst (alists_alist l, decl_node n);
+
+/*
+ walkVarParam -
+*/
+
+static decl_dependentState walkVarParam (alists_alist l, decl_node n);
+
+/*
+ walkParam -
+*/
+
+static decl_dependentState walkParam (alists_alist l, decl_node n);
+
+/*
+ walkOptarg -
+*/
+
+static decl_dependentState walkOptarg (alists_alist l, decl_node n);
+
+/*
+ walkRecordField -
+*/
+
+static decl_dependentState walkRecordField (alists_alist l, decl_node n);
+
+/*
+ walkVarientField -
+*/
+
+static decl_dependentState walkVarientField (alists_alist l, decl_node n);
+
+/*
+ walkEnumerationField -
+*/
+
+static decl_dependentState walkEnumerationField (alists_alist l, decl_node n);
+
+/*
+ walkSet -
+*/
+
+static decl_dependentState walkSet (alists_alist l, decl_node n);
+
+/*
+ walkProcType -
+*/
+
+static decl_dependentState walkProcType (alists_alist l, decl_node n);
+
+/*
+ walkProcedure -
+*/
+
+static decl_dependentState walkProcedure (alists_alist l, decl_node n);
+
+/*
+ walkParameters -
+*/
+
+static decl_dependentState walkParameters (alists_alist l, Indexing_Index p);
+
+/*
+ walkFuncCall -
+*/
+
+static decl_dependentState walkFuncCall (alists_alist l, decl_node n);
+
+/*
+ walkUnary -
+*/
+
+static decl_dependentState walkUnary (alists_alist l, decl_node n);
+
+/*
+ walkBinary -
+*/
+
+static decl_dependentState walkBinary (alists_alist l, decl_node n);
+
+/*
+ walkComponentRef -
+*/
+
+static decl_dependentState walkComponentRef (alists_alist l, decl_node n);
+
+/*
+ walkPointerRef -
+*/
+
+static decl_dependentState walkPointerRef (alists_alist l, decl_node n);
+
+/*
+ walkSetValue -
+*/
+
+static decl_dependentState walkSetValue (alists_alist l, decl_node n);
+
+/*
+ doDependants - return the dependentState depending upon whether
+ all dependants have been declared.
+*/
+
+static decl_dependentState doDependants (alists_alist l, decl_node n);
+
+/*
+ tryComplete - returns TRUE if node, n, can be and was completed.
+*/
+
+static unsigned int tryComplete (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v);
+
+/*
+ tryCompleteFromPartial -
+*/
+
+static unsigned int tryCompleteFromPartial (decl_node n, decl_nodeProcedure t);
+
+/*
+ visitIntrinsicFunction -
+*/
+
+static void visitIntrinsicFunction (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitUnary -
+*/
+
+static void visitUnary (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitBinary -
+*/
+
+static void visitBinary (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitBoolean -
+*/
+
+static void visitBoolean (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitScope -
+*/
+
+static void visitScope (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitType -
+*/
+
+static void visitType (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitIndex -
+*/
+
+static void visitIndex (alists_alist v, Indexing_Index i, decl_nodeProcedure p);
+
+/*
+ visitRecord -
+*/
+
+static void visitRecord (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitVarient -
+*/
+
+static void visitVarient (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitVar -
+*/
+
+static void visitVar (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitEnumeration -
+*/
+
+static void visitEnumeration (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitSubrange -
+*/
+
+static void visitSubrange (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitPointer -
+*/
+
+static void visitPointer (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitArray -
+*/
+
+static void visitArray (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitConst -
+*/
+
+static void visitConst (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitVarParam -
+*/
+
+static void visitVarParam (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitParam -
+*/
+
+static void visitParam (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitOptarg -
+*/
+
+static void visitOptarg (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitRecordField -
+*/
+
+static void visitRecordField (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitVarientField -
+*/
+
+static void visitVarientField (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitEnumerationField -
+*/
+
+static void visitEnumerationField (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitSet -
+*/
+
+static void visitSet (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitProcType -
+*/
+
+static void visitProcType (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitSubscript -
+*/
+
+static void visitSubscript (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitDecls -
+*/
+
+static void visitDecls (alists_alist v, decl_scopeT s, decl_nodeProcedure p);
+
+/*
+ visitProcedure -
+*/
+
+static void visitProcedure (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitDef -
+*/
+
+static void visitDef (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitImp -
+*/
+
+static void visitImp (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitModule -
+*/
+
+static void visitModule (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitLoop -
+*/
+
+static void visitLoop (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitWhile -
+*/
+
+static void visitWhile (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitRepeat -
+*/
+
+static void visitRepeat (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitCase -
+*/
+
+static void visitCase (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitCaseLabelList -
+*/
+
+static void visitCaseLabelList (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitCaseList -
+*/
+
+static void visitCaseList (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitRange -
+*/
+
+static void visitRange (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitIf -
+*/
+
+static void visitIf (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitElsif -
+*/
+
+static void visitElsif (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitFor -
+*/
+
+static void visitFor (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitAssignment -
+*/
+
+static void visitAssignment (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitComponentRef -
+*/
+
+static void visitComponentRef (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitPointerRef -
+*/
+
+static void visitPointerRef (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitArrayRef -
+*/
+
+static void visitArrayRef (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitFunccall -
+*/
+
+static void visitFunccall (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitVarDecl -
+*/
+
+static void visitVarDecl (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitExplist -
+*/
+
+static void visitExplist (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitExit -
+*/
+
+static void visitExit (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitReturn -
+*/
+
+static void visitReturn (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitStmtSeq -
+*/
+
+static void visitStmtSeq (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitVarargs -
+*/
+
+static void visitVarargs (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitSetValue -
+*/
+
+static void visitSetValue (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitIntrinsic -
+*/
+
+static void visitIntrinsic (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitDependants - helper procedure function called from visitNode.
+ node n has just been visited, this procedure will
+ visit node, n, dependants.
+*/
+
+static void visitDependants (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ visitNode - visits node, n, if it is not already in the alist, v.
+ It calls p(n) if the node is unvisited.
+*/
+
+static void visitNode (alists_alist v, decl_node n, decl_nodeProcedure p);
+
+/*
+ genKind - returns a string depending upon the kind of node, n.
+*/
+
+static DynamicStrings_String genKind (decl_node n);
+
+/*
+ gen - generate a small string describing node, n.
+*/
+
+static DynamicStrings_String gen (decl_node n);
+
+/*
+ dumpQ -
+*/
+
+static void dumpQ (const char *q_, unsigned int _q_high, alists_alist l);
+
+/*
+ dumpLists -
+*/
+
+static void dumpLists (void);
+
+/*
+ outputHidden -
+*/
+
+static void outputHidden (decl_node n);
+
+/*
+ outputHiddenComplete -
+*/
+
+static void outputHiddenComplete (decl_node n);
+
+/*
+ tryPartial -
+*/
+
+static unsigned int tryPartial (decl_node n, decl_nodeProcedure pt);
+
+/*
+ outputPartialRecordArrayProcType -
+*/
+
+static void outputPartialRecordArrayProcType (decl_node n, decl_node q, unsigned int indirection);
+
+/*
+ outputPartial -
+*/
+
+static void outputPartial (decl_node n);
+
+/*
+ tryOutputTodo -
+*/
+
+static void tryOutputTodo (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure pt);
+
+/*
+ tryOutputPartial -
+*/
+
+static void tryOutputPartial (decl_nodeProcedure t);
+
+/*
+ debugList -
+*/
+
+static void debugList (const char *a_, unsigned int _a_high, alists_alist l);
+
+/*
+ debugLists -
+*/
+
+static void debugLists (void);
+
+/*
+ addEnumConst -
+*/
+
+static void addEnumConst (decl_node n);
+
+/*
+ populateTodo -
+*/
+
+static void populateTodo (decl_nodeProcedure p);
+
+/*
+ topologicallyOut -
+*/
+
+static void topologicallyOut (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure tp, decl_nodeProcedure pc, decl_nodeProcedure pt, decl_nodeProcedure pv);
+
+/*
+ scaffoldStatic -
+*/
+
+static void scaffoldStatic (mcPretty_pretty p, decl_node n);
+
+/*
+ emitCtor -
+*/
+
+static void emitCtor (mcPretty_pretty p, decl_node n);
+
+/*
+ scaffoldDynamic -
+*/
+
+static void scaffoldDynamic (mcPretty_pretty p, decl_node n);
+
+/*
+ scaffoldMain -
+*/
+
+static void scaffoldMain (mcPretty_pretty p, decl_node n);
+
+/*
+ outImpInitC - emit the init/fini functions and main function if required.
+*/
+
+static void outImpInitC (mcPretty_pretty p, decl_node n);
+
+/*
+ runSimplifyTypes -
+*/
+
+static void runSimplifyTypes (decl_node n);
+
+/*
+ outDefC -
+*/
+
+static void outDefC (mcPretty_pretty p, decl_node n);
+
+/*
+ runPrototypeExported -
+*/
+
+static void runPrototypeExported (decl_node n);
+
+/*
+ runPrototypeDefC -
+*/
+
+static void runPrototypeDefC (decl_node n);
+
+/*
+ outImpC -
+*/
+
+static void outImpC (mcPretty_pretty p, decl_node n);
+
+/*
+ outDeclsModuleC -
+*/
+
+static void outDeclsModuleC (mcPretty_pretty p, decl_scopeT s);
+
+/*
+ outModuleInitC -
+*/
+
+static void outModuleInitC (mcPretty_pretty p, decl_node n);
+
+/*
+ outModuleC -
+*/
+
+static void outModuleC (mcPretty_pretty p, decl_node n);
+
+/*
+ outC -
+*/
+
+static void outC (mcPretty_pretty p, decl_node n);
+
+/*
+ doIncludeM2 - include modules in module, n.
+*/
+
+static void doIncludeM2 (decl_node n);
+
+/*
+ doConstM2 -
+*/
+
+static void doConstM2 (decl_node n);
+
+/*
+ doProcTypeM2 -
+*/
+
+static void doProcTypeM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doRecordFieldM2 -
+*/
+
+static void doRecordFieldM2 (mcPretty_pretty p, decl_node f);
+
+/*
+ doVarientFieldM2 -
+*/
+
+static void doVarientFieldM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doVarientM2 -
+*/
+
+static void doVarientM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doRecordM2 -
+*/
+
+static void doRecordM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doPointerM2 -
+*/
+
+static void doPointerM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doTypeAliasM2 -
+*/
+
+static void doTypeAliasM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doEnumerationM2 -
+*/
+
+static void doEnumerationM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doBaseM2 -
+*/
+
+static void doBaseM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doSystemM2 -
+*/
+
+static void doSystemM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doTypeM2 -
+*/
+
+static void doTypeM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doTypesM2 -
+*/
+
+static void doTypesM2 (decl_node n);
+
+/*
+ doVarM2 -
+*/
+
+static void doVarM2 (decl_node n);
+
+/*
+ doVarsM2 -
+*/
+
+static void doVarsM2 (decl_node n);
+
+/*
+ doTypeNameM2 -
+*/
+
+static void doTypeNameM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doParamM2 -
+*/
+
+static void doParamM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doVarParamM2 -
+*/
+
+static void doVarParamM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doParameterM2 -
+*/
+
+static void doParameterM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ doPrototypeM2 -
+*/
+
+static void doPrototypeM2 (decl_node n);
+
+/*
+ outputPartialM2 - just writes out record, array, and proctypes.
+ No need for forward declarations in Modula-2
+ but we need to keep topological sort happy.
+ So when asked to output partial we emit the
+ full type for these types and then do nothing
+ when trying to complete partial to full.
+*/
+
+static void outputPartialM2 (decl_node n);
+
+/*
+ outDeclsDefM2 -
+*/
+
+static void outDeclsDefM2 (mcPretty_pretty p, decl_scopeT s);
+
+/*
+ outDefM2 -
+*/
+
+static void outDefM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ outDeclsImpM2 -
+*/
+
+static void outDeclsImpM2 (mcPretty_pretty p, decl_scopeT s);
+
+/*
+ outImpM2 -
+*/
+
+static void outImpM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ outModuleM2 -
+*/
+
+static void outModuleM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ outM2 -
+*/
+
+static void outM2 (mcPretty_pretty p, decl_node n);
+
+/*
+ addDone - adds node, n, to the doneQ.
+*/
+
+static void addDone (decl_node n);
+
+/*
+ addDoneDef - adds node, n, to the doneQ providing
+ it is not an opaque of the main module we are compiling.
+*/
+
+static void addDoneDef (decl_node n);
+
+/*
+ dbgAdd -
+*/
+
+static decl_node dbgAdd (alists_alist l, decl_node n);
+
+/*
+ dbgType -
+*/
+
+static void dbgType (alists_alist l, decl_node n);
+
+/*
+ dbgPointer -
+*/
+
+static void dbgPointer (alists_alist l, decl_node n);
+
+/*
+ dbgRecord -
+*/
+
+static void dbgRecord (alists_alist l, decl_node n);
+
+/*
+ dbgVarient -
+*/
+
+static void dbgVarient (alists_alist l, decl_node n);
+
+/*
+ dbgEnumeration -
+*/
+
+static void dbgEnumeration (alists_alist l, decl_node n);
+
+/*
+ dbgVar -
+*/
+
+static void dbgVar (alists_alist l, decl_node n);
+
+/*
+ dbgSubrange -
+*/
+
+static void dbgSubrange (alists_alist l, decl_node n);
+
+/*
+ dbgArray -
+*/
+
+static void dbgArray (alists_alist l, decl_node n);
+
+/*
+ doDbg -
+*/
+
+static void doDbg (alists_alist l, decl_node n);
+
+/*
+ dbg -
+*/
+
+static void dbg (decl_node n);
+
+/*
+ addGenericBody - adds comment node to funccall, return, assignment
+ nodes.
+*/
+
+static void addGenericBody (decl_node n, decl_node c);
+
+/*
+ addGenericAfter - adds comment node to funccall, return, assignment
+ nodes.
+*/
+
+static void addGenericAfter (decl_node n, decl_node c);
+
+/*
+ isAssignment -
+*/
+
+static unsigned int isAssignment (decl_node n);
+
+/*
+ isComment - returns TRUE if node, n, is a comment.
+*/
+
+static unsigned int isComment (decl_node n);
+
+/*
+ initPair - initialise the commentPair, c.
+*/
+
+static void initPair (decl_commentPair *c);
+
+/*
+ dupExplist -
+*/
+
+static decl_node dupExplist (decl_node n);
+
+/*
+ dupArrayref -
+*/
+
+static decl_node dupArrayref (decl_node n);
+
+/*
+ dupPointerref -
+*/
+
+static decl_node dupPointerref (decl_node n);
+
+/*
+ dupComponentref -
+*/
+
+static decl_node dupComponentref (decl_node n);
+
+/*
+ dupBinary -
+*/
+
+static decl_node dupBinary (decl_node n);
+
+/*
+ dupUnary -
+*/
+
+static decl_node dupUnary (decl_node n);
+
+/*
+ dupFunccall -
+*/
+
+static decl_node dupFunccall (decl_node n);
+
+/*
+ dupSetValue -
+*/
+
+static decl_node dupSetValue (decl_node n);
+
+/*
+ doDupExpr -
+*/
+
+static decl_node doDupExpr (decl_node n);
+
+/*
+ makeSystem -
+*/
+
+static void makeSystem (void);
+
+/*
+ makeM2rts -
+*/
+
+static void makeM2rts (void);
+
+/*
+ makeBitnum -
+*/
+
+static decl_node makeBitnum (void);
+
+/*
+ makeBaseSymbols -
+*/
+
+static void makeBaseSymbols (void);
+
+/*
+ makeBuiltins -
+*/
+
+static void makeBuiltins (void);
+
+/*
+ init -
+*/
+
+static void init (void);
+
+
+/*
+ newNode - create and return a new node of kind k.
+*/
+
+static decl_node newNode (decl_nodeT k)
+{
+ decl_node d;
+
+ Storage_ALLOCATE ((void **) &d, sizeof (decl_nodeRec));
+ if (enableMemsetOnAllocation)
+ {
+ d = static_cast<decl_node> (libc_memset (reinterpret_cast<void *> (d), 0, static_cast<size_t> (sizeof ((*d)))));
+ }
+ if (d == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ d->kind = k;
+ d->at.defDeclared = 0;
+ d->at.modDeclared = 0;
+ d->at.firstUsed = 0;
+ return d;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ disposeNode - dispose node, n.
+*/
+
+static void disposeNode (decl_node *n)
+{
+ Storage_DEALLOCATE ((void **) &(*n), sizeof (decl_nodeRec));
+ (*n) = NULL;
+}
+
+
+/*
+ isLocal - returns TRUE if symbol, n, is locally declared in a procedure.
+*/
+
+static unsigned int isLocal (decl_node n)
+{
+ decl_node s;
+
+ s = decl_getScope (n);
+ if (s != NULL)
+ {
+ return decl_isProcedure (s);
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ importEnumFields - if, n, is an enumeration type import the all fields into module, m.
+*/
+
+static void importEnumFields (decl_node m, decl_node n)
+{
+ decl_node r;
+ decl_node e;
+ unsigned int i;
+ unsigned int h;
+
+ mcDebug_assert (((decl_isDef (m)) || (decl_isModule (m))) || (decl_isImp (m)));
+ n = decl_skipType (n);
+ if ((n != NULL) && (decl_isEnumeration (n)))
+ {
+ i = Indexing_LowIndice (n->enumerationF.listOfSons);
+ h = Indexing_HighIndice (n->enumerationF.listOfSons);
+ while (i <= h)
+ {
+ e = static_cast<decl_node> (Indexing_GetIndice (n->enumerationF.listOfSons, i));
+ r = decl_import (m, e);
+ if (e != r)
+ {
+ mcMetaError_metaError2 ((const char *) "enumeration field {%1ad} cannot be imported implicitly into {%2d} due to a name clash", 85, (const unsigned char *) &e, (sizeof (e)-1), (const unsigned char *) &m, (sizeof (m)-1));
+ }
+ i += 1;
+ }
+ }
+}
+
+
+/*
+ isComplex - returns TRUE if, n, is the complex type.
+*/
+
+static unsigned int isComplex (decl_node n)
+{
+ return n == complexN;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isLongComplex - returns TRUE if, n, is the longcomplex type.
+*/
+
+static unsigned int isLongComplex (decl_node n)
+{
+ return n == longcomplexN;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isShortComplex - returns TRUE if, n, is the shortcomplex type.
+*/
+
+static unsigned int isShortComplex (decl_node n)
+{
+ return n == shortcomplexN;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isAProcType - returns TRUE if, n, is a proctype or proc node.
+*/
+
+static unsigned int isAProcType (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return (decl_isProcType (n)) || (n == procN);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ initFixupInfo - initialize the fixupInfo record.
+*/
+
+static decl_fixupInfo initFixupInfo (void)
+{
+ decl_fixupInfo f;
+
+ f.count = 0;
+ f.info = Indexing_InitIndex (1);
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeDef - returns a definition module node named, n.
+*/
+
+static decl_node makeDef (nameKey_Name n)
+{
+ decl_node d;
+
+ d = newNode (decl_def);
+ d->defF.name = n;
+ d->defF.source = nameKey_NulName;
+ d->defF.hasHidden = FALSE;
+ d->defF.forC = FALSE;
+ d->defF.exported = Indexing_InitIndex (1);
+ d->defF.importedModules = Indexing_InitIndex (1);
+ d->defF.constFixup = initFixupInfo ();
+ d->defF.enumFixup = initFixupInfo ();
+ initDecls (&d->defF.decls);
+ d->defF.enumsComplete = FALSE;
+ d->defF.constsComplete = FALSE;
+ d->defF.visited = FALSE;
+ initPair (&d->defF.com);
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeImp - returns an implementation module node named, n.
+*/
+
+static decl_node makeImp (nameKey_Name n)
+{
+ decl_node d;
+
+ d = newNode (decl_imp);
+ d->impF.name = n;
+ d->impF.source = nameKey_NulName;
+ d->impF.importedModules = Indexing_InitIndex (1);
+ d->impF.constFixup = initFixupInfo ();
+ d->impF.enumFixup = initFixupInfo ();
+ initDecls (&d->impF.decls);
+ d->impF.beginStatements = NULL;
+ d->impF.finallyStatements = NULL;
+ d->impF.definitionModule = NULL;
+ d->impF.enumsComplete = FALSE;
+ d->impF.constsComplete = FALSE;
+ d->impF.visited = FALSE;
+ initPair (&d->impF.com);
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeModule - returns a module node named, n.
+*/
+
+static decl_node makeModule (nameKey_Name n)
+{
+ decl_node d;
+
+ d = newNode (decl_module);
+ d->moduleF.name = n;
+ d->moduleF.source = nameKey_NulName;
+ d->moduleF.importedModules = Indexing_InitIndex (1);
+ d->moduleF.constFixup = initFixupInfo ();
+ d->moduleF.enumFixup = initFixupInfo ();
+ initDecls (&d->moduleF.decls);
+ d->moduleF.beginStatements = NULL;
+ d->moduleF.finallyStatements = NULL;
+ d->moduleF.enumsComplete = FALSE;
+ d->moduleF.constsComplete = FALSE;
+ d->moduleF.visited = FALSE;
+ initPair (&d->moduleF.com);
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isDefForC - returns TRUE if the definition module was defined FOR "C".
+*/
+
+static unsigned int isDefForC (decl_node n)
+{
+ return (decl_isDef (n)) && n->defF.forC;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ initDecls - initialize the decls, scopeT.
+*/
+
+static void initDecls (decl_scopeT *decls)
+{
+ (*decls).symbols = symbolKey_initTree ();
+ (*decls).constants = Indexing_InitIndex (1);
+ (*decls).types = Indexing_InitIndex (1);
+ (*decls).procedures = Indexing_InitIndex (1);
+ (*decls).variables = Indexing_InitIndex (1);
+}
+
+
+/*
+ addTo - adds node, d, to scope decls and returns, d.
+ It stores, d, in the symbols tree associated with decls.
+*/
+
+static decl_node addTo (decl_scopeT *decls, decl_node d)
+{
+ nameKey_Name n;
+
+ n = decl_getSymName (d);
+ if (n != nameKey_NulName)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((symbolKey_getSymKey ((*decls).symbols, n)) == NULL)
+ {
+ symbolKey_putSymKey ((*decls).symbols, n, reinterpret_cast<void *> (d));
+ }
+ else
+ {
+ mcMetaError_metaError1 ((const char *) "{%1DMad} was declared", 21, (const unsigned char *) &d, (sizeof (d)-1));
+ mcMetaError_metaError1 ((const char *) "{%1k} and is being declared again", 33, (const unsigned char *) &n, (sizeof (n)-1));
+ }
+ }
+ if (decl_isConst (d))
+ {
+ Indexing_IncludeIndiceIntoIndex ((*decls).constants, reinterpret_cast<void *> (d));
+ }
+ else if (decl_isVar (d))
+ {
+ /* avoid dangling else. */
+ Indexing_IncludeIndiceIntoIndex ((*decls).variables, reinterpret_cast<void *> (d));
+ }
+ else if (decl_isType (d))
+ {
+ /* avoid dangling else. */
+ Indexing_IncludeIndiceIntoIndex ((*decls).types, reinterpret_cast<void *> (d));
+ }
+ else if (decl_isProcedure (d))
+ {
+ /* avoid dangling else. */
+ Indexing_IncludeIndiceIntoIndex ((*decls).procedures, reinterpret_cast<void *> (d));
+ if (debugDecl)
+ {
+ libc_printf ((const char *) "%d procedures on the dynamic array\\n", 36, Indexing_HighIndice ((*decls).procedures));
+ }
+ }
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ export - export node, n, from definition module, d.
+*/
+
+static void export_ (decl_node d, decl_node n)
+{
+ mcDebug_assert (decl_isDef (d));
+ Indexing_IncludeIndiceIntoIndex (d->defF.exported, reinterpret_cast<void *> (n));
+}
+
+
+/*
+ addToScope - adds node, n, to the current scope and returns, n.
+*/
+
+static decl_node addToScope (decl_node n)
+{
+ decl_node s;
+ unsigned int i;
+
+ i = Indexing_HighIndice (scopeStack);
+ s = static_cast<decl_node> (Indexing_GetIndice (scopeStack, i));
+ if (decl_isProcedure (s))
+ {
+ if (debugDecl)
+ {
+ outText (doP, (const char *) "adding ", 7);
+ doNameC (doP, n);
+ outText (doP, (const char *) " to procedure\\n", 15);
+ }
+ return addTo (&s->procedureF.decls, n);
+ }
+ else if (decl_isModule (s))
+ {
+ /* avoid dangling else. */
+ if (debugDecl)
+ {
+ outText (doP, (const char *) "adding ", 7);
+ doNameC (doP, n);
+ outText (doP, (const char *) " to module\\n", 12);
+ }
+ return addTo (&s->moduleF.decls, n);
+ }
+ else if (decl_isDef (s))
+ {
+ /* avoid dangling else. */
+ if (debugDecl)
+ {
+ outText (doP, (const char *) "adding ", 7);
+ doNameC (doP, n);
+ outText (doP, (const char *) " to definition module\\n", 23);
+ }
+ export_ (s, n);
+ return addTo (&s->defF.decls, n);
+ }
+ else if (decl_isImp (s))
+ {
+ /* avoid dangling else. */
+ if (debugDecl)
+ {
+ outText (doP, (const char *) "adding ", 7);
+ doNameC (doP, n);
+ outText (doP, (const char *) " to implementation module\\n", 27);
+ }
+ return addTo (&s->impF.decls, n);
+ }
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ addModuleToScope - adds module, i, to module, m, scope.
+*/
+
+static void addModuleToScope (decl_node m, decl_node i)
+{
+ mcDebug_assert ((decl_getDeclScope ()) == m);
+ if ((decl_lookupSym (decl_getSymName (i))) == NULL)
+ {
+ i = addToScope (i);
+ }
+}
+
+
+/*
+ completedEnum - assign boolean enumsComplete to TRUE if a definition,
+ implementation or module symbol.
+*/
+
+static void completedEnum (decl_node n)
+{
+ mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n)));
+ if (decl_isDef (n))
+ {
+ n->defF.enumsComplete = TRUE;
+ }
+ else if (decl_isImp (n))
+ {
+ /* avoid dangling else. */
+ n->impF.enumsComplete = TRUE;
+ }
+ else if (decl_isModule (n))
+ {
+ /* avoid dangling else. */
+ n->moduleF.enumsComplete = TRUE;
+ }
+}
+
+
+/*
+ setUnary - sets a unary node to contain, arg, a, and type, t.
+*/
+
+static void setUnary (decl_node u, decl_nodeT k, decl_node a, decl_node t)
+{
+ switch (k)
+ {
+ case decl_constexp:
+ case decl_deref:
+ case decl_chr:
+ case decl_cap:
+ case decl_abs:
+ case decl_float:
+ case decl_trunc:
+ case decl_ord:
+ case decl_high:
+ case decl_throw:
+ case decl_re:
+ case decl_im:
+ case decl_not:
+ case decl_neg:
+ case decl_adr:
+ case decl_size:
+ case decl_tsize:
+ case decl_min:
+ case decl_max:
+ u->kind = k;
+ u->unaryF.arg = a;
+ u->unaryF.resultType = t;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ putVarBool - assigns the four booleans associated with a variable.
+*/
+
+static void putVarBool (decl_node v, unsigned int init, unsigned int param, unsigned int isvar, unsigned int isused)
+{
+ mcDebug_assert (decl_isVar (v));
+ v->varF.isInitialised = init;
+ v->varF.isParameter = param;
+ v->varF.isVarParameter = isvar;
+ v->varF.isUsed = isused;
+}
+
+
+/*
+ checkPtr - in C++ we need to create a typedef for a pointer
+ in case we need to use reinterpret_cast.
+*/
+
+static decl_node checkPtr (decl_node n)
+{
+ DynamicStrings_String s;
+ decl_node p;
+
+ if (lang == decl_ansiCP)
+ {
+ if (decl_isPointer (n))
+ {
+ s = tempName ();
+ p = decl_makeType (nameKey_makekey (DynamicStrings_string (s)));
+ decl_putType (p, n);
+ s = DynamicStrings_KillString (s);
+ return p;
+ }
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isVarDecl - returns TRUE if, n, is a vardecl node.
+*/
+
+static unsigned int isVarDecl (decl_node n)
+{
+ return n->kind == decl_vardecl;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeVariablesFromParameters - creates variables which are really parameters.
+*/
+
+static void makeVariablesFromParameters (decl_node proc, decl_node id, decl_node type, unsigned int isvar, unsigned int isused)
+{
+ decl_node v;
+ unsigned int i;
+ unsigned int n;
+ nameKey_Name m;
+ DynamicStrings_String s;
+
+ mcDebug_assert (decl_isProcedure (proc));
+ mcDebug_assert (isIdentList (id));
+ i = 1;
+ n = wlists_noOfItemsInList (id->identlistF.names);
+ while (i <= n)
+ {
+ m = static_cast<nameKey_Name> (wlists_getItemFromList (id->identlistF.names, i));
+ v = decl_makeVar (m);
+ decl_putVar (v, type, NULL);
+ putVarBool (v, TRUE, TRUE, isvar, isused);
+ if (debugScopes)
+ {
+ libc_printf ((const char *) "adding parameter variable into top scope\\n", 42);
+ dumpScopes ();
+ libc_printf ((const char *) " variable name is: ", 19);
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (m));
+ if ((DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, s))) == NULL)
+ {} /* empty. */
+ libc_printf ((const char *) "\\n", 2);
+ }
+ i += 1;
+ }
+}
+
+
+/*
+ addProcedureToScope - add a procedure name n and node d to the
+ current scope.
+*/
+
+static decl_node addProcedureToScope (decl_node d, nameKey_Name n)
+{
+ decl_node m;
+ unsigned int i;
+
+ i = Indexing_HighIndice (scopeStack);
+ m = static_cast<decl_node> (Indexing_GetIndice (scopeStack, i));
+ if (((decl_isDef (m)) && ((decl_getSymName (m)) == (nameKey_makeKey ((const char *) "M2RTS", 5)))) && ((decl_getSymName (d)) == (nameKey_makeKey ((const char *) "HALT", 4))))
+ {
+ haltN = d;
+ symbolKey_putSymKey (baseSymbols, n, reinterpret_cast<void *> (haltN));
+ }
+ return addToScope (d);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putProcTypeReturn - sets the return type of, proc, to, type.
+*/
+
+static void putProcTypeReturn (decl_node proc, decl_node type)
+{
+ mcDebug_assert (decl_isProcType (proc));
+ proc->proctypeF.returnType = type;
+}
+
+
+/*
+ putProcTypeOptReturn - sets, proc, to have an optional return type.
+*/
+
+static void putProcTypeOptReturn (decl_node proc)
+{
+ mcDebug_assert (decl_isProcType (proc));
+ proc->proctypeF.returnopt = TRUE;
+}
+
+
+/*
+ makeOptParameter - creates and returns an optarg.
+*/
+
+static decl_node makeOptParameter (decl_node l, decl_node type, decl_node init)
+{
+ decl_node n;
+
+ n = newNode (decl_optarg);
+ n->optargF.namelist = l;
+ n->optargF.type = type;
+ n->optargF.init = init;
+ n->optargF.scope = NULL;
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ setwatch - assign the globalNode to n.
+*/
+
+static unsigned int setwatch (decl_node n)
+{
+ globalNode = n;
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ runwatch - set the globalNode to an identlist.
+*/
+
+static unsigned int runwatch (void)
+{
+ return globalNode->kind == decl_identlist;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isIdentList - returns TRUE if, n, is an identlist.
+*/
+
+static unsigned int isIdentList (decl_node n)
+{
+ return n->kind == decl_identlist;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ identListLen - returns the length of identlist.
+*/
+
+static unsigned int identListLen (decl_node n)
+{
+ if (n == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ mcDebug_assert (isIdentList (n));
+ return wlists_noOfItemsInList (n->identlistF.names);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ checkParameters - placeholder for future parameter checking.
+*/
+
+static void checkParameters (decl_node p, decl_node i, decl_node type, unsigned int isvar, unsigned int isused)
+{
+ /* do check. */
+ disposeNode (&i);
+}
+
+
+/*
+ checkMakeVariables - create shadow local variables for parameters providing that
+ procedure n has not already been built and we are compiling
+ a module or an implementation module.
+*/
+
+static void checkMakeVariables (decl_node n, decl_node i, decl_node type, unsigned int isvar, unsigned int isused)
+{
+ if (((decl_isImp (currentModule)) || (decl_isModule (currentModule))) && ! n->procedureF.built)
+ {
+ makeVariablesFromParameters (n, i, type, isvar, isused);
+ }
+}
+
+
+/*
+ makeVarientField - create a varient field within varient, v,
+ The new varient field is returned.
+*/
+
+static decl_node makeVarientField (decl_node v, decl_node p)
+{
+ decl_node n;
+
+ n = newNode (decl_varientfield);
+ n->varientfieldF.name = nameKey_NulName;
+ n->varientfieldF.parent = p;
+ n->varientfieldF.varient = v;
+ n->varientfieldF.simple = FALSE;
+ n->varientfieldF.listOfSons = Indexing_InitIndex (1);
+ n->varientfieldF.scope = decl_getDeclScope ();
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putFieldVarient - places the field varient, f, as a brother to, the
+ varient symbol, v, and also tells, f, that its varient
+ parent is, v.
+*/
+
+static void putFieldVarient (decl_node f, decl_node v)
+{
+ mcDebug_assert (decl_isVarient (v));
+ mcDebug_assert (decl_isVarientField (f));
+ switch (v->kind)
+ {
+ case decl_varient:
+ Indexing_IncludeIndiceIntoIndex (v->varientF.listOfSons, reinterpret_cast<void *> (f));
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ switch (f->kind)
+ {
+ case decl_varientfield:
+ f->varientfieldF.varient = v;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ putFieldRecord - create a new recordfield and place it into record r.
+ The new field has a tagname and type and can have a
+ variant field v.
+*/
+
+static decl_node putFieldRecord (decl_node r, nameKey_Name tag, decl_node type, decl_node v)
+{
+ decl_node f;
+ decl_node n;
+ decl_node p;
+
+ n = newNode (decl_recordfield);
+ switch (r->kind)
+ {
+ case decl_record:
+ Indexing_IncludeIndiceIntoIndex (r->recordF.listOfSons, reinterpret_cast<void *> (n));
+ /* ensure that field, n, is in the parents Local Symbols. */
+ if (tag != nameKey_NulName)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((symbolKey_getSymKey (r->recordF.localSymbols, tag)) == symbolKey_NulKey)
+ {
+ symbolKey_putSymKey (r->recordF.localSymbols, tag, reinterpret_cast<void *> (n));
+ }
+ else
+ {
+ f = static_cast<decl_node> (symbolKey_getSymKey (r->recordF.localSymbols, tag));
+ mcMetaError_metaErrors1 ((const char *) "field record {%1Dad} has already been declared", 46, (const char *) "field record duplicate", 22, (const unsigned char *) &f, (sizeof (f)-1));
+ }
+ }
+ break;
+
+ case decl_varientfield:
+ Indexing_IncludeIndiceIntoIndex (r->varientfieldF.listOfSons, reinterpret_cast<void *> (n));
+ p = getParent (r);
+ mcDebug_assert (p->kind == decl_record);
+ if (tag != nameKey_NulName)
+ {
+ symbolKey_putSymKey (p->recordF.localSymbols, tag, reinterpret_cast<void *> (n));
+ }
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ /* fill in, n. */
+ n->recordfieldF.type = type;
+ n->recordfieldF.name = tag;
+ n->recordfieldF.parent = r;
+ n->recordfieldF.varient = v;
+ n->recordfieldF.tag = FALSE;
+ n->recordfieldF.scope = NULL;
+ initCname (&n->recordfieldF.cname);
+ /*
+ IF r^.kind=record
+ THEN
+ doRecordM2 (doP, r)
+ END ;
+ */
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ensureOrder - ensures that, a, and, b, exist in, i, and also
+ ensure that, a, is before, b.
+*/
+
+static void ensureOrder (Indexing_Index i, decl_node a, decl_node b)
+{
+ mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast<void *> (a)));
+ mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast<void *> (b)));
+ Indexing_RemoveIndiceFromIndex (i, reinterpret_cast<void *> (a));
+ Indexing_RemoveIndiceFromIndex (i, reinterpret_cast<void *> (b));
+ Indexing_IncludeIndiceIntoIndex (i, reinterpret_cast<void *> (a));
+ Indexing_IncludeIndiceIntoIndex (i, reinterpret_cast<void *> (b));
+ mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast<void *> (a)));
+ mcDebug_assert (Indexing_IsIndiceInIndex (i, reinterpret_cast<void *> (b)));
+}
+
+
+/*
+ putVarientTag - places tag into variant v.
+*/
+
+static void putVarientTag (decl_node v, decl_node tag)
+{
+ decl_node p;
+
+ mcDebug_assert (decl_isVarient (v));
+ switch (v->kind)
+ {
+ case decl_varient:
+ v->varientF.tag = tag;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ getParent - returns the parent field of recordfield or varientfield symbol, n.
+*/
+
+static decl_node getParent (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_recordfield:
+ return n->recordfieldF.parent;
+ break;
+
+ case decl_varientfield:
+ return n->varientfieldF.parent;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getRecord - returns the record associated with node, n.
+ (Parental record).
+*/
+
+static decl_node getRecord (decl_node n)
+{
+ mcDebug_assert (n->kind != decl_varient); /* if this fails then we need to add parent field to varient. */
+ switch (n->kind)
+ {
+ case decl_record:
+ return n; /* if this fails then we need to add parent field to varient. */
+ break;
+
+ case decl_varientfield:
+ return getRecord (getParent (n));
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isConstExp - return TRUE if the node kind is a constexp.
+*/
+
+static unsigned int isConstExp (decl_node c)
+{
+ mcDebug_assert (c != NULL);
+ return c->kind == decl_constexp;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addEnumToModule - adds enumeration type, e, into the list of enums
+ in module, m.
+*/
+
+static void addEnumToModule (decl_node m, decl_node e)
+{
+ mcDebug_assert ((decl_isEnumeration (e)) || (decl_isEnumerationField (e)));
+ mcDebug_assert (((decl_isModule (m)) || (decl_isDef (m))) || (decl_isImp (m)));
+ if (decl_isModule (m))
+ {
+ Indexing_IncludeIndiceIntoIndex (m->moduleF.enumFixup.info, reinterpret_cast<void *> (e));
+ }
+ else if (decl_isDef (m))
+ {
+ /* avoid dangling else. */
+ Indexing_IncludeIndiceIntoIndex (m->defF.enumFixup.info, reinterpret_cast<void *> (e));
+ }
+ else if (decl_isImp (m))
+ {
+ /* avoid dangling else. */
+ Indexing_IncludeIndiceIntoIndex (m->impF.enumFixup.info, reinterpret_cast<void *> (e));
+ }
+}
+
+
+/*
+ getNextFixup - return the next fixup from from f.
+*/
+
+static decl_node getNextFixup (decl_fixupInfo *f)
+{
+ (*f).count += 1;
+ return static_cast<decl_node> (Indexing_GetIndice ((*f).info, (*f).count));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doMakeEnum - create an enumeration type and add it to the current module.
+*/
+
+static decl_node doMakeEnum (void)
+{
+ decl_node e;
+
+ e = newNode (decl_enumeration);
+ e->enumerationF.noOfElements = 0;
+ e->enumerationF.localSymbols = symbolKey_initTree ();
+ e->enumerationF.scope = decl_getDeclScope ();
+ e->enumerationF.listOfSons = Indexing_InitIndex (1);
+ e->enumerationF.low = NULL;
+ e->enumerationF.high = NULL;
+ addEnumToModule (currentModule, e);
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doMakeEnumField - create an enumeration field name and add it to enumeration e.
+ Return the new field.
+*/
+
+static decl_node doMakeEnumField (decl_node e, nameKey_Name n)
+{
+ decl_node f;
+
+ mcDebug_assert (decl_isEnumeration (e));
+ f = decl_lookupSym (n);
+ if (f == NULL)
+ {
+ f = newNode (decl_enumerationfield);
+ symbolKey_putSymKey (e->enumerationF.localSymbols, n, reinterpret_cast<void *> (f));
+ Indexing_IncludeIndiceIntoIndex (e->enumerationF.listOfSons, reinterpret_cast<void *> (f));
+ f->enumerationfieldF.name = n;
+ f->enumerationfieldF.type = e;
+ f->enumerationfieldF.scope = decl_getDeclScope ();
+ f->enumerationfieldF.value = e->enumerationF.noOfElements;
+ initCname (&f->enumerationfieldF.cname);
+ e->enumerationF.noOfElements += 1;
+ mcDebug_assert ((Indexing_GetIndice (e->enumerationF.listOfSons, e->enumerationF.noOfElements)) == f);
+ addEnumToModule (currentModule, f);
+ if (e->enumerationF.low == NULL)
+ {
+ e->enumerationF.low = f;
+ }
+ e->enumerationF.high = f;
+ return addToScope (f);
+ }
+ else
+ {
+ mcMetaError_metaErrors2 ((const char *) "cannot create enumeration field {%1k} as the name is already in use", 67, (const char *) "{%2DMad} was declared elsewhere", 31, (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &f, (sizeof (f)-1));
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getExpList - returns the, n, th argument in an explist.
+*/
+
+static decl_node getExpList (decl_node p, unsigned int n)
+{
+ mcDebug_assert (p != NULL);
+ mcDebug_assert (decl_isExpList (p));
+ mcDebug_assert (n <= (Indexing_HighIndice (p->explistF.exp)));
+ return static_cast<decl_node> (Indexing_GetIndice (p->explistF.exp, n));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ expListLen - returns the length of explist, p.
+*/
+
+static unsigned int expListLen (decl_node p)
+{
+ if (p == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ mcDebug_assert (decl_isExpList (p));
+ return Indexing_HighIndice (p->explistF.exp);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getConstExpComplete - gets the field from the def or imp or module, n.
+*/
+
+static unsigned int getConstExpComplete (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_def:
+ return n->defF.constsComplete;
+ break;
+
+ case decl_imp:
+ return n->impF.constsComplete;
+ break;
+
+ case decl_module:
+ return n->moduleF.constsComplete;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addConstToModule - adds const exp, e, into the list of constant
+ expressions in module, m.
+*/
+
+static void addConstToModule (decl_node m, decl_node e)
+{
+ mcDebug_assert (((decl_isModule (m)) || (decl_isDef (m))) || (decl_isImp (m)));
+ if (decl_isModule (m))
+ {
+ Indexing_IncludeIndiceIntoIndex (m->moduleF.constFixup.info, reinterpret_cast<void *> (e));
+ }
+ else if (decl_isDef (m))
+ {
+ /* avoid dangling else. */
+ Indexing_IncludeIndiceIntoIndex (m->defF.constFixup.info, reinterpret_cast<void *> (e));
+ }
+ else if (decl_isImp (m))
+ {
+ /* avoid dangling else. */
+ Indexing_IncludeIndiceIntoIndex (m->impF.constFixup.info, reinterpret_cast<void *> (e));
+ }
+}
+
+
+/*
+ doMakeConstExp - create a constexp node and add it to the current module.
+*/
+
+static decl_node doMakeConstExp (void)
+{
+ decl_node c;
+
+ c = makeUnary (decl_constexp, NULL, NULL);
+ addConstToModule (currentModule, c);
+ return c;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isAnyType - return TRUE if node n is any type kind.
+*/
+
+static unsigned int isAnyType (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ switch (n->kind)
+ {
+ case decl_address:
+ case decl_loc:
+ case decl_byte:
+ case decl_word:
+ case decl_char:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_complex:
+ case decl_longcomplex:
+ case decl_shortcomplex:
+ case decl_bitset:
+ case decl_boolean:
+ case decl_proc:
+ case decl_type:
+ return TRUE;
+ break;
+
+
+ default:
+ return FALSE;
+ break;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeVal - creates a VAL (type, expression) node.
+*/
+
+static decl_node makeVal (decl_node params)
+{
+ mcDebug_assert (decl_isExpList (params));
+ if ((expListLen (params)) == 2)
+ {
+ return makeBinary (decl_val, getExpList (params, 1), getExpList (params, 2), getExpList (params, 1));
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeCast - creates a cast node TYPENAME (expr).
+*/
+
+static decl_node makeCast (decl_node c, decl_node p)
+{
+ mcDebug_assert (decl_isExpList (p));
+ if ((expListLen (p)) == 1)
+ {
+ return makeBinary (decl_cast, c, getExpList (p, 1), c);
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+static decl_node makeIntrinsicProc (decl_nodeT k, unsigned int noArgs, decl_node p)
+{
+ decl_node f;
+
+ /*
+ makeIntrisicProc - create an intrinsic node.
+ */
+ f = newNode (k);
+ f->intrinsicF.args = p;
+ f->intrinsicF.noArgs = noArgs;
+ f->intrinsicF.type = NULL;
+ f->intrinsicF.postUnreachable = k == decl_halt;
+ initPair (&f->intrinsicF.intrinsicComment);
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeIntrinsicUnaryType - create an intrisic unary type.
+*/
+
+static decl_node makeIntrinsicUnaryType (decl_nodeT k, decl_node paramList, decl_node returnType)
+{
+ return makeUnary (k, getExpList (paramList, 1), returnType);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeIntrinsicBinaryType - create an intrisic binary type.
+*/
+
+static decl_node makeIntrinsicBinaryType (decl_nodeT k, decl_node paramList, decl_node returnType)
+{
+ return makeBinary (k, getExpList (paramList, 1), getExpList (paramList, 2), returnType);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ checkIntrinsic - checks to see if the function call to, c, with
+ parameter list, n, is really an intrinic. If it
+ is an intrinic then an intrinic node is created
+ and returned. Otherwise NIL is returned.
+*/
+
+static decl_node checkIntrinsic (decl_node c, decl_node n)
+{
+ if (isAnyType (c))
+ {
+ return makeCast (c, n);
+ }
+ else if (c == maxN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_max, n, NULL);
+ }
+ else if (c == minN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_min, n, NULL);
+ }
+ else if (c == haltN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicProc (decl_halt, expListLen (n), n);
+ }
+ else if (c == valN)
+ {
+ /* avoid dangling else. */
+ return makeVal (n);
+ }
+ else if (c == adrN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_adr, n, addressN);
+ }
+ else if (c == sizeN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_size, n, cardinalN);
+ }
+ else if (c == tsizeN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_tsize, n, cardinalN);
+ }
+ else if (c == floatN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_float, n, realN);
+ }
+ else if (c == truncN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_trunc, n, integerN);
+ }
+ else if (c == ordN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_ord, n, cardinalN);
+ }
+ else if (c == chrN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_chr, n, charN);
+ }
+ else if (c == capN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_cap, n, charN);
+ }
+ else if (c == absN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_abs, n, NULL);
+ }
+ else if (c == imN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_im, n, NULL);
+ }
+ else if (c == reN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_re, n, NULL);
+ }
+ else if (c == cmplxN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicBinaryType (decl_cmplx, n, NULL);
+ }
+ else if (c == highN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_high, n, cardinalN);
+ }
+ else if (c == incN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicProc (decl_inc, expListLen (n), n);
+ }
+ else if (c == decN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicProc (decl_dec, expListLen (n), n);
+ }
+ else if (c == inclN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicProc (decl_incl, expListLen (n), n);
+ }
+ else if (c == exclN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicProc (decl_excl, expListLen (n), n);
+ }
+ else if (c == newN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicProc (decl_new, 1, n);
+ }
+ else if (c == disposeN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicProc (decl_dispose, 1, n);
+ }
+ else if (c == lengthN)
+ {
+ /* avoid dangling else. */
+ return makeIntrinsicUnaryType (decl_length, n, cardinalN);
+ }
+ else if (c == throwN)
+ {
+ /* avoid dangling else. */
+ keyc_useThrow ();
+ return makeIntrinsicProc (decl_throw, 1, n);
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ checkCHeaders - check to see if the function is a C system function and
+ requires a header file included.
+*/
+
+static void checkCHeaders (decl_node c)
+{
+ nameKey_Name name;
+ decl_node s;
+
+ if (decl_isProcedure (c))
+ {
+ s = decl_getScope (c);
+ if ((decl_getSymName (s)) == (nameKey_makeKey ((const char *) "libc", 4)))
+ {
+ name = decl_getSymName (c);
+ if ((((name == (nameKey_makeKey ((const char *) "read", 4))) || (name == (nameKey_makeKey ((const char *) "write", 5)))) || (name == (nameKey_makeKey ((const char *) "open", 4)))) || (name == (nameKey_makeKey ((const char *) "close", 5))))
+ {
+ keyc_useUnistd ();
+ }
+ }
+ }
+}
+
+
+/*
+ isFuncCall - returns TRUE if, n, is a function/procedure call.
+*/
+
+static unsigned int isFuncCall (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_funccall;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putTypeInternal - marks type, des, as being an internally generated type.
+*/
+
+static void putTypeInternal (decl_node des)
+{
+ mcDebug_assert (des != NULL);
+ mcDebug_assert (decl_isType (des));
+ des->typeF.isInternal = TRUE;
+}
+
+
+/*
+ isTypeInternal - returns TRUE if type, n, is internal.
+*/
+
+static unsigned int isTypeInternal (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ mcDebug_assert (decl_isType (n));
+ return n->typeF.isInternal;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ lookupBase - return node named n from the base symbol scope.
+*/
+
+static decl_node lookupBase (nameKey_Name n)
+{
+ decl_node m;
+
+ m = static_cast<decl_node> (symbolKey_getSymKey (baseSymbols, n));
+ if (m == procN)
+ {
+ keyc_useProc ();
+ }
+ else if (((m == complexN) || (m == longcomplexN)) || (m == shortcomplexN))
+ {
+ /* avoid dangling else. */
+ keyc_useComplex ();
+ }
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dumpScopes - display the names of all the scopes stacked.
+*/
+
+static void dumpScopes (void)
+{
+ unsigned int h;
+ decl_node s;
+
+ h = Indexing_HighIndice (scopeStack);
+ libc_printf ((const char *) "total scopes stacked %d\\n", 25, h);
+ while (h >= 1)
+ {
+ s = static_cast<decl_node> (Indexing_GetIndice (scopeStack, h));
+ out2 ((const char *) " scope [%d] is %s\\n", 19, h, s);
+ h -= 1;
+ }
+}
+
+
+/*
+ out0 - write string a to StdOut.
+*/
+
+static void out0 (const char *a_, unsigned int _a_high)
+{
+ DynamicStrings_String m;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) a, _a_high));
+ m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
+}
+
+
+/*
+ out1 - write string a to StdOut using format specifier a.
+*/
+
+static void out1 (const char *a_, unsigned int _a_high, decl_node s)
+{
+ DynamicStrings_String m;
+ unsigned int d;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ m = getFQstring (s);
+ if (DynamicStrings_EqualArray (m, (const char *) "", 0))
+ {
+ d = (unsigned int ) ((long unsigned int ) (s));
+ m = DynamicStrings_KillString (m);
+ m = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "[%d]", 4), (const unsigned char *) &d, (sizeof (d)-1));
+ }
+ m = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) a, _a_high), (const unsigned char *) &m, (sizeof (m)-1));
+ m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
+}
+
+
+/*
+ out2 - write string a to StdOut using format specifier a.
+*/
+
+static void out2 (const char *a_, unsigned int _a_high, unsigned int c, decl_node s)
+{
+ DynamicStrings_String m;
+ DynamicStrings_String m1;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ m1 = getString (s);
+ m = FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) a, _a_high), (const unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) &m1, (sizeof (m1)-1));
+ m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
+ m1 = DynamicStrings_KillString (m1);
+}
+
+
+/*
+ out3 - write string a to StdOut using format specifier a.
+*/
+
+static void out3 (const char *a_, unsigned int _a_high, unsigned int l, nameKey_Name n, decl_node s)
+{
+ DynamicStrings_String m;
+ DynamicStrings_String m1;
+ DynamicStrings_String m2;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ m1 = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n));
+ m2 = getString (s);
+ m = FormatStrings_Sprintf3 (DynamicStrings_InitString ((const char *) a, _a_high), (const unsigned char *) &l, (sizeof (l)-1), (const unsigned char *) &m1, (sizeof (m1)-1), (const unsigned char *) &m2, (sizeof (m2)-1));
+ m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
+ m1 = DynamicStrings_KillString (m1);
+ m2 = DynamicStrings_KillString (m2);
+}
+
+
+/*
+ isUnary - returns TRUE if, n, is an unary node.
+*/
+
+static unsigned int isUnary (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ switch (n->kind)
+ {
+ case decl_length:
+ case decl_re:
+ case decl_im:
+ case decl_deref:
+ case decl_high:
+ case decl_chr:
+ case decl_cap:
+ case decl_abs:
+ case decl_ord:
+ case decl_float:
+ case decl_trunc:
+ case decl_constexp:
+ case decl_not:
+ case decl_neg:
+ case decl_adr:
+ case decl_size:
+ case decl_tsize:
+ case decl_min:
+ case decl_max:
+ return TRUE;
+ break;
+
+
+ default:
+ return FALSE;
+ break;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isBinary - returns TRUE if, n, is an binary node.
+*/
+
+static unsigned int isBinary (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ switch (n->kind)
+ {
+ case decl_cmplx:
+ case decl_and:
+ case decl_or:
+ case decl_equal:
+ case decl_notequal:
+ case decl_less:
+ case decl_greater:
+ case decl_greequal:
+ case decl_lessequal:
+ case decl_val:
+ case decl_cast:
+ case decl_plus:
+ case decl_sub:
+ case decl_div:
+ case decl_mod:
+ case decl_mult:
+ case decl_divide:
+ case decl_in:
+ return TRUE;
+ break;
+
+
+ default:
+ return FALSE;
+ break;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeUnary - create a unary expression node with, e, as the argument
+ and res as the return type.
+*/
+
+static decl_node makeUnary (decl_nodeT k, decl_node e, decl_node res)
+{
+ decl_node n;
+
+ if (k == decl_plus)
+ {
+ return e;
+ }
+ else
+ {
+ n = newNode (k);
+ switch (n->kind)
+ {
+ case decl_min:
+ case decl_max:
+ case decl_throw:
+ case decl_re:
+ case decl_im:
+ case decl_deref:
+ case decl_high:
+ case decl_chr:
+ case decl_cap:
+ case decl_abs:
+ case decl_ord:
+ case decl_float:
+ case decl_trunc:
+ case decl_length:
+ case decl_constexp:
+ case decl_not:
+ case decl_neg:
+ case decl_adr:
+ case decl_size:
+ case decl_tsize:
+ n->unaryF.arg = e;
+ n->unaryF.resultType = res;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isLeafString - returns TRUE if n is a leaf node which is a string constant.
+*/
+
+static unsigned int isLeafString (decl_node n)
+{
+ return ((isString (n)) || ((decl_isLiteral (n)) && ((decl_getType (n)) == charN))) || ((decl_isConst (n)) && ((getExprType (n)) == charN));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getLiteralStringContents - return the contents of a literal node as a string.
+*/
+
+static DynamicStrings_String getLiteralStringContents (decl_node n)
+{
+ DynamicStrings_String number;
+ DynamicStrings_String content;
+ DynamicStrings_String s;
+
+ mcDebug_assert (n->kind == decl_literal);
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n->literalF.name));
+ content = NULL;
+ if (n->literalF.type == charN)
+ {
+ if ((DynamicStrings_char (s, -1)) == 'C')
+ {
+ if ((DynamicStrings_Length (s)) > 1)
+ {
+ number = DynamicStrings_Slice (s, 0, -1);
+ content = DynamicStrings_InitStringChar ((char ) (StringConvert_ostoc (number)));
+ number = DynamicStrings_KillString (number);
+ }
+ else
+ {
+ content = DynamicStrings_InitStringChar ('C');
+ }
+ }
+ else
+ {
+ content = DynamicStrings_Dup (s);
+ }
+ }
+ else
+ {
+ mcMetaError_metaError1 ((const char *) "cannot obtain string contents from {%1k}", 40, (const unsigned char *) &n->literalF.name, (sizeof (n->literalF.name)-1));
+ }
+ s = DynamicStrings_KillString (s);
+ return content;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getStringContents - return the string contents of a constant, literal,
+ string or a constexp node.
+*/
+
+static DynamicStrings_String getStringContents (decl_node n)
+{
+ if (decl_isConst (n))
+ {
+ return getStringContents (n->constF.value);
+ }
+ else if (decl_isLiteral (n))
+ {
+ /* avoid dangling else. */
+ return getLiteralStringContents (n);
+ }
+ else if (isString (n))
+ {
+ /* avoid dangling else. */
+ return getString (n);
+ }
+ else if (isConstExp (n))
+ {
+ /* avoid dangling else. */
+ return getStringContents (n->unaryF.arg);
+ }
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ addNames -
+*/
+
+static nameKey_Name addNames (decl_node a, decl_node b)
+{
+ DynamicStrings_String sa;
+ DynamicStrings_String sb;
+ nameKey_Name n;
+
+ sa = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (a)));
+ sb = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (b)));
+ sa = DynamicStrings_ConCat (sa, sb);
+ n = nameKey_makekey (DynamicStrings_string (sa));
+ sa = DynamicStrings_KillString (sa);
+ sb = DynamicStrings_KillString (sb);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ resolveString -
+*/
+
+static decl_node resolveString (decl_node n)
+{
+ while ((decl_isConst (n)) || (isConstExp (n)))
+ {
+ if (decl_isConst (n))
+ {
+ n = n->constF.value;
+ }
+ else
+ {
+ n = n->unaryF.arg;
+ }
+ }
+ if (n->kind == decl_plus)
+ {
+ n = decl_makeString (addNames (resolveString (n->binaryF.left), resolveString (n->binaryF.right)));
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ foldBinary -
+*/
+
+static decl_node foldBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res)
+{
+ decl_node n;
+ DynamicStrings_String ls;
+ DynamicStrings_String rs;
+
+ n = NULL;
+ if (((k == decl_plus) && (isLeafString (l))) && (isLeafString (r)))
+ {
+ ls = getStringContents (l);
+ rs = getStringContents (r);
+ ls = DynamicStrings_Add (ls, rs);
+ n = decl_makeString (nameKey_makekey (DynamicStrings_string (ls)));
+ ls = DynamicStrings_KillString (ls);
+ rs = DynamicStrings_KillString (rs);
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeBinary - create a binary node with left/right/result type: l, r and resultType.
+*/
+
+static decl_node makeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node resultType)
+{
+ decl_node n;
+
+ n = foldBinary (k, l, r, resultType);
+ if (n == NULL)
+ {
+ n = doMakeBinary (k, l, r, resultType);
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doMakeBinary - returns a binary node containing left/right/result values
+ l, r, res, with a node operator, k.
+*/
+
+static decl_node doMakeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node res)
+{
+ decl_node n;
+
+ n = newNode (k);
+ switch (n->kind)
+ {
+ case decl_cmplx:
+ case decl_equal:
+ case decl_notequal:
+ case decl_less:
+ case decl_greater:
+ case decl_greequal:
+ case decl_lessequal:
+ case decl_and:
+ case decl_or:
+ case decl_cast:
+ case decl_val:
+ case decl_plus:
+ case decl_sub:
+ case decl_div:
+ case decl_mod:
+ case decl_mult:
+ case decl_divide:
+ case decl_in:
+ n->binaryF.left = l;
+ n->binaryF.right = r;
+ n->binaryF.resultType = res;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doMakeComponentRef -
+*/
+
+static decl_node doMakeComponentRef (decl_node rec, decl_node field)
+{
+ decl_node n;
+
+ n = newNode (decl_componentref);
+ n->componentrefF.rec = rec;
+ n->componentrefF.field = field;
+ n->componentrefF.resultType = decl_getType (field);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isComponentRef -
+*/
+
+static unsigned int isComponentRef (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_componentref;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isArrayRef - returns TRUE if the node was an arrayref.
+*/
+
+static unsigned int isArrayRef (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_arrayref;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isDeref - returns TRUE if, n, is a deref node.
+*/
+
+static unsigned int isDeref (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_deref;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeBase - create a base type or constant.
+ It only supports the base types and constants
+ enumerated below.
+*/
+
+static decl_node makeBase (decl_nodeT k)
+{
+ decl_node n;
+
+ n = newNode (k);
+ switch (k)
+ {
+ case decl_new:
+ case decl_dispose:
+ case decl_length:
+ case decl_inc:
+ case decl_dec:
+ case decl_incl:
+ case decl_excl:
+ case decl_nil:
+ case decl_true:
+ case decl_false:
+ case decl_address:
+ case decl_loc:
+ case decl_byte:
+ case decl_word:
+ case decl_csizet:
+ case decl_cssizet:
+ case decl_char:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_real:
+ case decl_longreal:
+ case decl_shortreal:
+ case decl_bitset:
+ case decl_boolean:
+ case decl_proc:
+ case decl_ztype:
+ case decl_rtype:
+ case decl_complex:
+ case decl_longcomplex:
+ case decl_shortcomplex:
+ case decl_adr:
+ case decl_chr:
+ case decl_cap:
+ case decl_abs:
+ case decl_float:
+ case decl_trunc:
+ case decl_ord:
+ case decl_high:
+ case decl_throw:
+ case decl_re:
+ case decl_im:
+ case decl_cmplx:
+ case decl_size:
+ case decl_tsize:
+ case decl_val:
+ case decl_min:
+ case decl_max:
+ break;
+
+
+ default:
+ M2RTS_HALT (-1); /* legal kind. */
+ __builtin_unreachable ();
+ break;
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isOrdinal - returns TRUE if, n, is an ordinal type.
+*/
+
+static unsigned int isOrdinal (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_address:
+ case decl_loc:
+ case decl_byte:
+ case decl_word:
+ case decl_csizet:
+ case decl_cssizet:
+ case decl_char:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_bitset:
+ return TRUE;
+ break;
+
+
+ default:
+ return FALSE;
+ break;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ mixTypes -
+*/
+
+static decl_node mixTypes (decl_node a, decl_node b)
+{
+ if ((a == addressN) || (b == addressN))
+ {
+ return addressN;
+ }
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doSetExprType -
+*/
+
+static decl_node doSetExprType (decl_node *t, decl_node n)
+{
+ if ((*t) == NULL)
+ {
+ (*t) = n;
+ }
+ return (*t);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getMaxMinType -
+*/
+
+static decl_node getMaxMinType (decl_node n)
+{
+ if ((decl_isVar (n)) || (decl_isConst (n)))
+ {
+ return decl_getType (n);
+ }
+ else if (isConstExp (n))
+ {
+ /* avoid dangling else. */
+ n = getExprType (n->unaryF.arg);
+ if (n == bitsetN)
+ {
+ return ztypeN;
+ }
+ else
+ {
+ return n;
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return n;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doGetFuncType -
+*/
+
+static decl_node doGetFuncType (decl_node n)
+{
+ mcDebug_assert (isFuncCall (n));
+ return doSetExprType (&n->funccallF.type, decl_getType (n->funccallF.function));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doGetExprType - works out the type which is associated with node, n.
+*/
+
+static decl_node doGetExprType (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_max:
+ case decl_min:
+ return getMaxMinType (n->unaryF.arg);
+ break;
+
+ case decl_cast:
+ case decl_val:
+ return doSetExprType (&n->binaryF.resultType, n->binaryF.left);
+ break;
+
+ case decl_halt:
+ case decl_new:
+ case decl_dispose:
+ return NULL;
+ break;
+
+ case decl_inc:
+ case decl_dec:
+ case decl_incl:
+ case decl_excl:
+ return NULL;
+ break;
+
+ case decl_nil:
+ return addressN;
+ break;
+
+ case decl_true:
+ case decl_false:
+ return booleanN;
+ break;
+
+ case decl_address:
+ return n;
+ break;
+
+ case decl_loc:
+ return n;
+ break;
+
+ case decl_byte:
+ return n;
+ break;
+
+ case decl_word:
+ return n;
+ break;
+
+ case decl_csizet:
+ return n;
+ break;
+
+ case decl_cssizet:
+ return n;
+ break;
+
+ case decl_boolean:
+ /* base types. */
+ return n;
+ break;
+
+ case decl_proc:
+ return n;
+ break;
+
+ case decl_char:
+ return n;
+ break;
+
+ case decl_cardinal:
+ return n;
+ break;
+
+ case decl_longcard:
+ return n;
+ break;
+
+ case decl_shortcard:
+ return n;
+ break;
+
+ case decl_integer:
+ return n;
+ break;
+
+ case decl_longint:
+ return n;
+ break;
+
+ case decl_shortint:
+ return n;
+ break;
+
+ case decl_real:
+ return n;
+ break;
+
+ case decl_longreal:
+ return n;
+ break;
+
+ case decl_shortreal:
+ return n;
+ break;
+
+ case decl_bitset:
+ return n;
+ break;
+
+ case decl_ztype:
+ return n;
+ break;
+
+ case decl_rtype:
+ return n;
+ break;
+
+ case decl_complex:
+ return n;
+ break;
+
+ case decl_longcomplex:
+ return n;
+ break;
+
+ case decl_shortcomplex:
+ return n;
+ break;
+
+ case decl_type:
+ /* language features and compound type attributes. */
+ return n->typeF.type;
+ break;
+
+ case decl_record:
+ return n;
+ break;
+
+ case decl_varient:
+ return n;
+ break;
+
+ case decl_var:
+ return n->varF.type;
+ break;
+
+ case decl_enumeration:
+ return n;
+ break;
+
+ case decl_subrange:
+ return n->subrangeF.type;
+ break;
+
+ case decl_array:
+ return n->arrayF.type;
+ break;
+
+ case decl_string:
+ return charN;
+ break;
+
+ case decl_const:
+ return doSetExprType (&n->constF.type, getExprType (n->constF.value));
+ break;
+
+ case decl_literal:
+ return n->literalF.type;
+ break;
+
+ case decl_varparam:
+ return n->varparamF.type;
+ break;
+
+ case decl_param:
+ return n->paramF.type;
+ break;
+
+ case decl_optarg:
+ return n->optargF.type;
+ break;
+
+ case decl_pointer:
+ return n->pointerF.type;
+ break;
+
+ case decl_recordfield:
+ return n->recordfieldF.type;
+ break;
+
+ case decl_varientfield:
+ return n;
+ break;
+
+ case decl_enumerationfield:
+ return n->enumerationfieldF.type;
+ break;
+
+ case decl_set:
+ return n->setF.type;
+ break;
+
+ case decl_proctype:
+ return n->proctypeF.returnType;
+ break;
+
+ case decl_subscript:
+ return n->subscriptF.type;
+ break;
+
+ case decl_procedure:
+ /* blocks. */
+ return n->procedureF.returnType;
+ break;
+
+ case decl_throw:
+ return NULL;
+ break;
+
+ case decl_unreachable:
+ return NULL;
+ break;
+
+ case decl_def:
+ case decl_imp:
+ case decl_module:
+ case decl_loop:
+ case decl_while:
+ case decl_for:
+ case decl_repeat:
+ case decl_if:
+ case decl_elsif:
+ case decl_assignment:
+ /* statements. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ break;
+
+ case decl_plus:
+ case decl_sub:
+ case decl_div:
+ case decl_mod:
+ case decl_mult:
+ case decl_divide:
+ /* expressions. */
+ return doSetExprType (&n->binaryF.resultType, mixTypes (getExprType (n->binaryF.left), getExprType (n->binaryF.right)));
+ break;
+
+ case decl_in:
+ case decl_and:
+ case decl_or:
+ case decl_equal:
+ case decl_notequal:
+ case decl_less:
+ case decl_greater:
+ case decl_greequal:
+ case decl_lessequal:
+ return doSetExprType (&n->binaryF.resultType, booleanN);
+ break;
+
+ case decl_cmplx:
+ return doSetExprType (&n->binaryF.resultType, complexN);
+ break;
+
+ case decl_abs:
+ case decl_constexp:
+ case decl_deref:
+ case decl_neg:
+ return doSetExprType (&n->unaryF.resultType, getExprType (n->unaryF.arg));
+ break;
+
+ case decl_adr:
+ return doSetExprType (&n->unaryF.resultType, addressN);
+ break;
+
+ case decl_size:
+ case decl_tsize:
+ return doSetExprType (&n->unaryF.resultType, cardinalN);
+ break;
+
+ case decl_high:
+ case decl_ord:
+ return doSetExprType (&n->unaryF.resultType, cardinalN);
+ break;
+
+ case decl_float:
+ return doSetExprType (&n->unaryF.resultType, realN);
+ break;
+
+ case decl_trunc:
+ return doSetExprType (&n->unaryF.resultType, integerN);
+ break;
+
+ case decl_chr:
+ return doSetExprType (&n->unaryF.resultType, charN);
+ break;
+
+ case decl_cap:
+ return doSetExprType (&n->unaryF.resultType, charN);
+ break;
+
+ case decl_not:
+ return doSetExprType (&n->unaryF.resultType, booleanN);
+ break;
+
+ case decl_re:
+ return doSetExprType (&n->unaryF.resultType, realN);
+ break;
+
+ case decl_im:
+ return doSetExprType (&n->unaryF.resultType, realN);
+ break;
+
+ case decl_arrayref:
+ return n->arrayrefF.resultType;
+ break;
+
+ case decl_componentref:
+ return n->componentrefF.resultType;
+ break;
+
+ case decl_pointerref:
+ return n->pointerrefF.resultType;
+ break;
+
+ case decl_funccall:
+ return doSetExprType (&n->funccallF.type, doGetFuncType (n));
+ break;
+
+ case decl_setvalue:
+ return n->setvalueF.type;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ getExprType - return the expression type.
+*/
+
+static decl_node getExprType (decl_node n)
+{
+ decl_node t;
+
+ if (((isFuncCall (n)) && ((decl_getType (n)) != NULL)) && (decl_isProcType (decl_skipType (decl_getType (n)))))
+ {
+ return decl_getType (decl_skipType (decl_getType (n)));
+ }
+ t = decl_getType (n);
+ if (t == NULL)
+ {
+ t = doGetExprType (n);
+ }
+ return t;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openOutput -
+*/
+
+static void openOutput (void)
+{
+ DynamicStrings_String s;
+
+ s = mcOptions_getOutputFile ();
+ if (DynamicStrings_EqualArray (s, (const char *) "-", 1))
+ {
+ outputFile = FIO_StdOut;
+ }
+ else
+ {
+ outputFile = SFIO_OpenToWrite (s);
+ }
+ mcStream_setDest (outputFile);
+}
+
+
+/*
+ closeOutput -
+*/
+
+static void closeOutput (void)
+{
+ DynamicStrings_String s;
+
+ s = mcOptions_getOutputFile ();
+ outputFile = mcStream_combine ();
+ if (! (DynamicStrings_EqualArray (s, (const char *) "-", 1)))
+ {
+ FIO_Close (outputFile);
+ }
+}
+
+
+/*
+ write - outputs a single char, ch.
+*/
+
+static void write_ (char ch)
+{
+ FIO_WriteChar (outputFile, ch);
+ FIO_FlushBuffer (outputFile);
+}
+
+
+/*
+ writeln -
+*/
+
+static void writeln (void)
+{
+ FIO_WriteLine (outputFile);
+ FIO_FlushBuffer (outputFile);
+}
+
+
+/*
+ doIncludeC - include header file for definition module, n.
+*/
+
+static void doIncludeC (decl_node n)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ if (mcOptions_getExtendedOpaque ())
+ {} /* empty. */
+ /* no include in this case. */
+ else if (decl_isDef (n))
+ {
+ /* avoid dangling else. */
+ mcPretty_print (doP, (const char *) "# include \"", 13);
+ mcPretty_prints (doP, mcOptions_getHPrefix ());
+ mcPretty_prints (doP, s);
+ mcPretty_print (doP, (const char *) ".h\"\\n", 5);
+ symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDoneDef});
+ }
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ getSymScope - returns the scope where node, n, was declared.
+*/
+
+static decl_node getSymScope (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_const:
+ return n->constF.scope;
+ break;
+
+ case decl_type:
+ return n->typeF.scope;
+ break;
+
+ case decl_var:
+ return n->varF.scope;
+ break;
+
+ case decl_procedure:
+ return n->procedureF.scope;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ isQualifiedForced - should the node be written with a module prefix?
+*/
+
+static unsigned int isQualifiedForced (decl_node n)
+{
+ return forceQualified && (((((decl_isType (n)) || (decl_isRecord (n))) || (decl_isArray (n))) || (decl_isEnumeration (n))) || (decl_isEnumerationField (n)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getFQstring -
+*/
+
+static DynamicStrings_String getFQstring (decl_node n)
+{
+ DynamicStrings_String i;
+ DynamicStrings_String s;
+
+ if ((decl_getScope (n)) == NULL)
+ {
+ return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ }
+ else if (isQualifiedForced (n))
+ {
+ /* avoid dangling else. */
+ i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n))));
+ return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1));
+ }
+ else if ((! (decl_isExported (n))) || (mcOptions_getIgnoreFQ ()))
+ {
+ /* avoid dangling else. */
+ return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n))));
+ return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getFQDstring -
+*/
+
+static DynamicStrings_String getFQDstring (decl_node n, unsigned int scopes)
+{
+ DynamicStrings_String i;
+ DynamicStrings_String s;
+
+ if ((decl_getScope (n)) == NULL)
+ {
+ return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (getDName (n, scopes)));
+ }
+ else if (isQualifiedForced (n))
+ {
+ /* avoid dangling else. */
+ /* we assume a qualified name will never conflict. */
+ i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n))));
+ return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1));
+ }
+ else if ((! (decl_isExported (n))) || (mcOptions_getIgnoreFQ ()))
+ {
+ /* avoid dangling else. */
+ return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (getDName (n, scopes)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ /* we assume a qualified name will never conflict. */
+ i = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (decl_getScope (n))));
+ return FormatStrings_Sprintf2 (DynamicStrings_InitString ((const char *) "%s_%s", 5), (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &i, (sizeof (i)-1));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getString - returns the name as a string.
+*/
+
+static DynamicStrings_String getString (decl_node n)
+{
+ if ((decl_getSymName (n)) == nameKey_NulName)
+ {
+ return DynamicStrings_InitString ((const char *) "", 0);
+ }
+ else
+ {
+ return DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doNone - call HALT.
+*/
+
+static void doNone (decl_node n)
+{
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ doNothing - does nothing!
+*/
+
+static void doNothing (decl_node n)
+{
+}
+
+
+/*
+ doConstC -
+*/
+
+static void doConstC (decl_node n)
+{
+ if (! (alists_isItemInList (doneQ, reinterpret_cast<void *> (n))))
+ {
+ mcPretty_print (doP, (const char *) "# define ", 11);
+ doFQNameC (doP, n);
+ mcPretty_setNeedSpace (doP);
+ doExprC (doP, n->constF.value);
+ mcPretty_print (doP, (const char *) "\\n", 2);
+ alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (n));
+ }
+}
+
+
+/*
+ needsParen - returns TRUE if expression, n, needs to be enclosed in ().
+*/
+
+static unsigned int needsParen (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ switch (n->kind)
+ {
+ case decl_nil:
+ case decl_true:
+ case decl_false:
+ return FALSE;
+ break;
+
+ case decl_constexp:
+ return needsParen (n->unaryF.arg);
+ break;
+
+ case decl_neg:
+ return needsParen (n->unaryF.arg);
+ break;
+
+ case decl_not:
+ return needsParen (n->unaryF.arg);
+ break;
+
+ case decl_adr:
+ case decl_size:
+ case decl_tsize:
+ case decl_ord:
+ case decl_float:
+ case decl_trunc:
+ case decl_chr:
+ case decl_cap:
+ case decl_high:
+ return FALSE;
+ break;
+
+ case decl_deref:
+ return FALSE;
+ break;
+
+ case decl_equal:
+ case decl_notequal:
+ case decl_less:
+ case decl_greater:
+ case decl_greequal:
+ case decl_lessequal:
+ return TRUE;
+ break;
+
+ case decl_componentref:
+ return FALSE;
+ break;
+
+ case decl_pointerref:
+ return FALSE;
+ break;
+
+ case decl_cast:
+ return TRUE;
+ break;
+
+ case decl_val:
+ return TRUE;
+ break;
+
+ case decl_abs:
+ return FALSE;
+ break;
+
+ case decl_plus:
+ case decl_sub:
+ case decl_div:
+ case decl_mod:
+ case decl_mult:
+ case decl_divide:
+ case decl_in:
+ return TRUE;
+ break;
+
+ case decl_literal:
+ case decl_const:
+ case decl_enumerationfield:
+ case decl_string:
+ return FALSE;
+ break;
+
+ case decl_max:
+ return TRUE;
+ break;
+
+ case decl_min:
+ return TRUE;
+ break;
+
+ case decl_var:
+ return FALSE;
+ break;
+
+ case decl_arrayref:
+ return FALSE;
+ break;
+
+ case decl_and:
+ case decl_or:
+ return TRUE;
+ break;
+
+ case decl_funccall:
+ return TRUE;
+ break;
+
+ case decl_recordfield:
+ return FALSE;
+ break;
+
+ case decl_loc:
+ case decl_byte:
+ case decl_word:
+ case decl_type:
+ case decl_char:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_real:
+ case decl_longreal:
+ case decl_shortreal:
+ case decl_complex:
+ case decl_longcomplex:
+ case decl_shortcomplex:
+ case decl_bitset:
+ case decl_boolean:
+ case decl_proc:
+ return FALSE;
+ break;
+
+ case decl_setvalue:
+ return FALSE;
+ break;
+
+ case decl_address:
+ return TRUE;
+ break;
+
+ case decl_procedure:
+ return FALSE;
+ break;
+
+ case decl_length:
+ case decl_cmplx:
+ case decl_re:
+ case decl_im:
+ return TRUE;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doUnary -
+*/
+
+static void doUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr, decl_node type, unsigned int l, unsigned int r)
+{
+ char op[_op_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (op, op_, _op_high+1);
+
+ if (l)
+ {
+ mcPretty_setNeedSpace (p);
+ }
+ mcPretty_print (p, (const char *) op, _op_high);
+ if (r)
+ {
+ mcPretty_setNeedSpace (p);
+ }
+ if (needsParen (expr))
+ {
+ outText (p, (const char *) "(", 1);
+ doExprC (p, expr);
+ outText (p, (const char *) ")", 1);
+ }
+ else
+ {
+ doExprC (p, expr);
+ }
+}
+
+
+/*
+ doSetSub - perform l & (~ r)
+*/
+
+static void doSetSub (mcPretty_pretty p, decl_node left, decl_node right)
+{
+ if (needsParen (left))
+ {
+ outText (p, (const char *) "(", 1);
+ doExprC (p, left);
+ outText (p, (const char *) ")", 1);
+ }
+ else
+ {
+ doExprC (p, left);
+ }
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "&", 1);
+ mcPretty_setNeedSpace (p);
+ if (needsParen (right))
+ {
+ outText (p, (const char *) "(~(", 3);
+ doExprC (p, right);
+ outText (p, (const char *) "))", 2);
+ }
+ else
+ {
+ outText (p, (const char *) "(~", 2);
+ doExprC (p, right);
+ outText (p, (const char *) ")", 1);
+ }
+}
+
+
+/*
+ doPolyBinary -
+*/
+
+static void doPolyBinary (mcPretty_pretty p, decl_nodeT op, decl_node left, decl_node right, unsigned int l, unsigned int r)
+{
+ decl_node lt;
+ decl_node rt;
+
+ lt = decl_skipType (getExprType (left));
+ rt = decl_skipType (getExprType (right));
+ if (((lt != NULL) && ((decl_isSet (lt)) || (isBitset (lt)))) || ((rt != NULL) && ((decl_isSet (rt)) || (isBitset (rt)))))
+ {
+ switch (op)
+ {
+ case decl_plus:
+ doBinary (p, (const char *) "|", 1, left, right, l, r, FALSE);
+ break;
+
+ case decl_sub:
+ doSetSub (p, left, right);
+ break;
+
+ case decl_mult:
+ doBinary (p, (const char *) "&", 1, left, right, l, r, FALSE);
+ break;
+
+ case decl_divide:
+ doBinary (p, (const char *) "^", 1, left, right, l, r, FALSE);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ }
+ else
+ {
+ switch (op)
+ {
+ case decl_plus:
+ doBinary (p, (const char *) "+", 1, left, right, l, r, FALSE);
+ break;
+
+ case decl_sub:
+ doBinary (p, (const char *) "-", 1, left, right, l, r, FALSE);
+ break;
+
+ case decl_mult:
+ doBinary (p, (const char *) "*", 1, left, right, l, r, FALSE);
+ break;
+
+ case decl_divide:
+ doBinary (p, (const char *) "/", 1, left, right, l, r, FALSE);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ }
+}
+
+
+/*
+ doBinary -
+*/
+
+static void doBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r, unsigned int unpackProc)
+{
+ char op[_op_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (op, op_, _op_high+1);
+
+ if (needsParen (left))
+ {
+ outText (p, (const char *) "(", 1);
+ doExprCup (p, left, unpackProc);
+ outText (p, (const char *) ")", 1);
+ }
+ else
+ {
+ doExprCup (p, left, unpackProc);
+ }
+ if (l)
+ {
+ mcPretty_setNeedSpace (p);
+ }
+ outText (p, (const char *) op, _op_high);
+ if (r)
+ {
+ mcPretty_setNeedSpace (p);
+ }
+ if (needsParen (right))
+ {
+ outText (p, (const char *) "(", 1);
+ doExprCup (p, right, unpackProc);
+ outText (p, (const char *) ")", 1);
+ }
+ else
+ {
+ doExprCup (p, right, unpackProc);
+ }
+}
+
+
+/*
+ doPostUnary -
+*/
+
+static void doPostUnary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node expr)
+{
+ char op[_op_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (op, op_, _op_high+1);
+
+ doExprC (p, expr);
+ outText (p, (const char *) op, _op_high);
+}
+
+
+/*
+ doDeRefC -
+*/
+
+static void doDeRefC (mcPretty_pretty p, decl_node expr)
+{
+ outText (p, (const char *) "(*", 2);
+ doExprC (p, expr);
+ outText (p, (const char *) ")", 1);
+}
+
+
+/*
+ doGetLastOp - returns, a, if b is a terminal otherwise walk right.
+*/
+
+static decl_node doGetLastOp (decl_node a, decl_node b)
+{
+ switch (b->kind)
+ {
+ case decl_nil:
+ return a;
+ break;
+
+ case decl_true:
+ return a;
+ break;
+
+ case decl_false:
+ return a;
+ break;
+
+ case decl_constexp:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_neg:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_not:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_adr:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_size:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_tsize:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_ord:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_float:
+ case decl_trunc:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_chr:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_cap:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_high:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_deref:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_re:
+ case decl_im:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_equal:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_notequal:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_less:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_greater:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_greequal:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_lessequal:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_componentref:
+ return doGetLastOp (b, b->componentrefF.field);
+ break;
+
+ case decl_pointerref:
+ return doGetLastOp (b, b->pointerrefF.field);
+ break;
+
+ case decl_cast:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_val:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_plus:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_sub:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_div:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_mod:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_mult:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_divide:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_in:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_and:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_or:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_cmplx:
+ return doGetLastOp (b, b->binaryF.right);
+ break;
+
+ case decl_literal:
+ return a;
+ break;
+
+ case decl_const:
+ return a;
+ break;
+
+ case decl_enumerationfield:
+ return a;
+ break;
+
+ case decl_string:
+ return a;
+ break;
+
+ case decl_max:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_min:
+ return doGetLastOp (b, b->unaryF.arg);
+ break;
+
+ case decl_var:
+ return a;
+ break;
+
+ case decl_arrayref:
+ return a;
+ break;
+
+ case decl_funccall:
+ return a;
+ break;
+
+ case decl_procedure:
+ return a;
+ break;
+
+ case decl_recordfield:
+ return a;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doComponentRefC -
+*/
+
+static void doComponentRefC (mcPretty_pretty p, decl_node l, decl_node r)
+{
+ doExprC (p, l);
+ outText (p, (const char *) ".", 1);
+ doExprC (p, r);
+}
+
+
+/*
+ doPointerRefC -
+*/
+
+static void doPointerRefC (mcPretty_pretty p, decl_node l, decl_node r)
+{
+ doExprC (p, l);
+ outText (p, (const char *) "->", 2);
+ doExprC (p, r);
+}
+
+
+/*
+ doPreBinary -
+*/
+
+static void doPreBinary (mcPretty_pretty p, const char *op_, unsigned int _op_high, decl_node left, decl_node right, unsigned int l, unsigned int r)
+{
+ char op[_op_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (op, op_, _op_high+1);
+
+ if (l)
+ {
+ mcPretty_setNeedSpace (p);
+ }
+ outText (p, (const char *) op, _op_high);
+ if (r)
+ {
+ mcPretty_setNeedSpace (p);
+ }
+ outText (p, (const char *) "(", 1);
+ doExprC (p, left);
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ doExprC (p, right);
+ outText (p, (const char *) ")", 1);
+}
+
+
+/*
+ doConstExpr -
+*/
+
+static void doConstExpr (mcPretty_pretty p, decl_node n)
+{
+ doFQNameC (p, n);
+}
+
+
+/*
+ doEnumerationField -
+*/
+
+static void doEnumerationField (mcPretty_pretty p, decl_node n)
+{
+ doFQDNameC (p, n, FALSE);
+}
+
+
+/*
+ isZero - returns TRUE if node, n, is zero.
+*/
+
+static unsigned int isZero (decl_node n)
+{
+ if (isConstExp (n))
+ {
+ return isZero (n->unaryF.arg);
+ }
+ return (decl_getSymName (n)) == (nameKey_makeKey ((const char *) "0", 1));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doArrayRef -
+*/
+
+static void doArrayRef (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+ unsigned int i;
+ unsigned int c;
+
+ mcDebug_assert (n != NULL);
+ mcDebug_assert (isArrayRef (n));
+ t = decl_skipType (decl_getType (n->arrayrefF.array));
+ if (decl_isUnbounded (t))
+ {
+ outTextN (p, decl_getSymName (n->arrayrefF.array));
+ }
+ else
+ {
+ doExprC (p, n->arrayrefF.array);
+ mcDebug_assert (decl_isArray (t));
+ outText (p, (const char *) ".array", 6);
+ }
+ outText (p, (const char *) "[", 1);
+ i = 1;
+ c = expListLen (n->arrayrefF.index);
+ while (i <= c)
+ {
+ doExprC (p, getExpList (n->arrayrefF.index, i));
+ if (decl_isUnbounded (t))
+ {
+ mcDebug_assert (c == 1);
+ }
+ else
+ {
+ doSubtractC (p, getMin (t->arrayF.subr));
+ if (i < c)
+ {
+ mcDebug_assert (decl_isArray (t));
+ outText (p, (const char *) "].array[", 8);
+ t = decl_skipType (decl_getType (t));
+ }
+ }
+ i += 1;
+ }
+ outText (p, (const char *) "]", 1);
+}
+
+
+/*
+ doProcedure -
+*/
+
+static void doProcedure (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (decl_isProcedure (n));
+ doFQDNameC (p, n, TRUE);
+}
+
+
+/*
+ doRecordfield -
+*/
+
+static void doRecordfield (mcPretty_pretty p, decl_node n)
+{
+ doDNameC (p, n, FALSE);
+}
+
+
+/*
+ doCastC -
+*/
+
+static void doCastC (mcPretty_pretty p, decl_node t, decl_node e)
+{
+ decl_node et;
+
+ outText (p, (const char *) "(", 1);
+ doTypeNameC (p, t);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ et = decl_skipType (decl_getType (e));
+ if (((et != NULL) && (isAProcType (et))) && (isAProcType (decl_skipType (t))))
+ {
+ outText (p, (const char *) "{(", 2);
+ doFQNameC (p, t);
+ outText (p, (const char *) "_t)", 3);
+ mcPretty_setNeedSpace (p);
+ doExprC (p, e);
+ outText (p, (const char *) ".proc}", 6);
+ }
+ else
+ {
+ outText (p, (const char *) "(", 1);
+ doExprC (p, e);
+ outText (p, (const char *) ")", 1);
+ }
+}
+
+
+/*
+ doSetValueC -
+*/
+
+static void doSetValueC (mcPretty_pretty p, decl_node n)
+{
+ decl_node lo;
+ unsigned int i;
+ unsigned int h;
+
+ mcDebug_assert (decl_isSetValue (n));
+ lo = getSetLow (n);
+ if (n->setvalueF.type != NULL)
+ {
+ outText (p, (const char *) "(", 1);
+ doTypeNameC (p, n->setvalueF.type);
+ mcPretty_noSpace (p);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ if ((Indexing_HighIndice (n->setvalueF.values)) == 0)
+ {
+ outText (p, (const char *) "0", 1);
+ }
+ else
+ {
+ i = Indexing_LowIndice (n->setvalueF.values);
+ h = Indexing_HighIndice (n->setvalueF.values);
+ outText (p, (const char *) "(", 1);
+ while (i <= h)
+ {
+ outText (p, (const char *) "(1", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "<<", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, reinterpret_cast<decl_node> (Indexing_GetIndice (n->setvalueF.values, i)));
+ doSubtractC (p, lo);
+ outText (p, (const char *) ")", 1);
+ outText (p, (const char *) ")", 1);
+ if (i < h)
+ {
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "|", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ i += 1;
+ }
+ outText (p, (const char *) ")", 1);
+ }
+}
+
+
+/*
+ getSetLow - returns the low value of the set type from
+ expression, n.
+*/
+
+static decl_node getSetLow (decl_node n)
+{
+ decl_node type;
+
+ if ((decl_getType (n)) == NULL)
+ {
+ return decl_makeLiteralInt (nameKey_makeKey ((const char *) "0", 1));
+ }
+ else
+ {
+ type = decl_skipType (decl_getType (n));
+ if (decl_isSet (type))
+ {
+ return getMin (decl_skipType (decl_getType (type)));
+ }
+ else
+ {
+ return decl_makeLiteralInt (nameKey_makeKey ((const char *) "0", 1));
+ }
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doInC - performs (((1 << (l)) & (r)) != 0)
+*/
+
+static void doInC (mcPretty_pretty p, decl_node l, decl_node r)
+{
+ decl_node lo;
+
+ lo = getSetLow (r);
+ outText (p, (const char *) "(((1", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "<<", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, l);
+ doSubtractC (p, lo);
+ outText (p, (const char *) "))", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "&", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, r);
+ outText (p, (const char *) "))", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "!=", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "0)", 2);
+}
+
+
+/*
+ doThrowC -
+*/
+
+static void doThrowC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (isIntrinsic (n));
+ outText (p, (const char *) "throw", 5);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ if ((expListLen (n->intrinsicF.args)) == 1)
+ {
+ doExprC (p, getExpList (n->intrinsicF.args, 1));
+ }
+ outText (p, (const char *) ")", 1);
+}
+
+
+/*
+ doUnreachableC -
+*/
+
+static void doUnreachableC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (isIntrinsic (n));
+ outText (p, (const char *) "__builtin_unreachable", 21);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ mcDebug_assert ((expListLen (n->intrinsicF.args)) == 0);
+ outText (p, (const char *) ")", 1);
+}
+
+
+/*
+ outNull -
+*/
+
+static void outNull (mcPretty_pretty p)
+{
+ keyc_useNull ();
+ outText (p, (const char *) "NULL", 4);
+}
+
+
+/*
+ outTrue -
+*/
+
+static void outTrue (mcPretty_pretty p)
+{
+ keyc_useTrue ();
+ outText (p, (const char *) "TRUE", 4);
+}
+
+
+/*
+ outFalse -
+*/
+
+static void outFalse (mcPretty_pretty p)
+{
+ keyc_useFalse ();
+ outText (p, (const char *) "FALSE", 5);
+}
+
+
+/*
+ doExprC -
+*/
+
+static void doExprC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+
+ mcDebug_assert (n != NULL);
+ t = getExprType (n);
+ switch (n->kind)
+ {
+ case decl_nil:
+ outNull (p);
+ break;
+
+ case decl_true:
+ outTrue (p);
+ break;
+
+ case decl_false:
+ outFalse (p);
+ break;
+
+ case decl_constexp:
+ doUnary (p, (const char *) "", 0, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE);
+ break;
+
+ case decl_neg:
+ doUnary (p, (const char *) "-", 1, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE);
+ break;
+
+ case decl_not:
+ doUnary (p, (const char *) "!", 1, n->unaryF.arg, n->unaryF.resultType, FALSE, TRUE);
+ break;
+
+ case decl_val:
+ doValC (p, n);
+ break;
+
+ case decl_adr:
+ doAdrC (p, n);
+ break;
+
+ case decl_size:
+ case decl_tsize:
+ doSizeC (p, n);
+ break;
+
+ case decl_float:
+ doConvertC (p, n, (const char *) "(double)", 8);
+ break;
+
+ case decl_trunc:
+ doConvertC (p, n, (const char *) "(int)", 5);
+ break;
+
+ case decl_ord:
+ doConvertC (p, n, (const char *) "(unsigned int)", 14);
+ break;
+
+ case decl_chr:
+ doConvertC (p, n, (const char *) "(char)", 6);
+ break;
+
+ case decl_cap:
+ doCapC (p, n);
+ break;
+
+ case decl_abs:
+ doAbsC (p, n);
+ break;
+
+ case decl_high:
+ doFuncHighC (p, n->unaryF.arg);
+ break;
+
+ case decl_length:
+ doLengthC (p, n);
+ break;
+
+ case decl_min:
+ doMinC (p, n);
+ break;
+
+ case decl_max:
+ doMaxC (p, n);
+ break;
+
+ case decl_throw:
+ doThrowC (p, n);
+ break;
+
+ case decl_unreachable:
+ doUnreachableC (p, n);
+ break;
+
+ case decl_re:
+ doReC (p, n);
+ break;
+
+ case decl_im:
+ doImC (p, n);
+ break;
+
+ case decl_cmplx:
+ doCmplx (p, n);
+ break;
+
+ case decl_deref:
+ doDeRefC (p, n->unaryF.arg);
+ break;
+
+ case decl_equal:
+ doBinary (p, (const char *) "==", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, TRUE);
+ break;
+
+ case decl_notequal:
+ doBinary (p, (const char *) "!=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, TRUE);
+ break;
+
+ case decl_less:
+ doBinary (p, (const char *) "<", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_greater:
+ doBinary (p, (const char *) ">", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_greequal:
+ doBinary (p, (const char *) ">=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_lessequal:
+ doBinary (p, (const char *) "<=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_componentref:
+ doComponentRefC (p, n->componentrefF.rec, n->componentrefF.field);
+ break;
+
+ case decl_pointerref:
+ doPointerRefC (p, n->pointerrefF.ptr, n->pointerrefF.field);
+ break;
+
+ case decl_cast:
+ doCastC (p, n->binaryF.left, n->binaryF.right);
+ break;
+
+ case decl_plus:
+ doPolyBinary (p, decl_plus, n->binaryF.left, n->binaryF.right, FALSE, FALSE);
+ break;
+
+ case decl_sub:
+ doPolyBinary (p, decl_sub, n->binaryF.left, n->binaryF.right, FALSE, FALSE);
+ break;
+
+ case decl_div:
+ doBinary (p, (const char *) "/", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_mod:
+ doBinary (p, (const char *) "%", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_mult:
+ doPolyBinary (p, decl_mult, n->binaryF.left, n->binaryF.right, FALSE, FALSE);
+ break;
+
+ case decl_divide:
+ doPolyBinary (p, decl_divide, n->binaryF.left, n->binaryF.right, FALSE, FALSE);
+ break;
+
+ case decl_in:
+ doInC (p, n->binaryF.left, n->binaryF.right);
+ break;
+
+ case decl_and:
+ doBinary (p, (const char *) "&&", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_or:
+ doBinary (p, (const char *) "||", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_literal:
+ doLiteralC (p, n);
+ break;
+
+ case decl_const:
+ doConstExpr (p, n);
+ break;
+
+ case decl_enumerationfield:
+ doEnumerationField (p, n);
+ break;
+
+ case decl_string:
+ doStringC (p, n);
+ break;
+
+ case decl_var:
+ doVar (p, n);
+ break;
+
+ case decl_arrayref:
+ doArrayRef (p, n);
+ break;
+
+ case decl_funccall:
+ doFuncExprC (p, n);
+ break;
+
+ case decl_procedure:
+ doProcedure (p, n);
+ break;
+
+ case decl_recordfield:
+ doRecordfield (p, n);
+ break;
+
+ case decl_setvalue:
+ doSetValueC (p, n);
+ break;
+
+ case decl_char:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_complex:
+ case decl_longcomplex:
+ case decl_shortcomplex:
+ case decl_real:
+ case decl_longreal:
+ case decl_shortreal:
+ case decl_bitset:
+ case decl_boolean:
+ case decl_proc:
+ doBaseC (p, n);
+ break;
+
+ case decl_address:
+ case decl_loc:
+ case decl_byte:
+ case decl_word:
+ case decl_csizet:
+ case decl_cssizet:
+ doSystemC (p, n);
+ break;
+
+ case decl_type:
+ doTypeNameC (p, n);
+ break;
+
+ case decl_pointer:
+ doTypeNameC (p, n);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ doExprCup -
+*/
+
+static void doExprCup (mcPretty_pretty p, decl_node n, unsigned int unpackProc)
+{
+ decl_node t;
+
+ doExprC (p, n);
+ if (unpackProc)
+ {
+ t = decl_skipType (getExprType (n));
+ if ((t != NULL) && (isAProcType (t)))
+ {
+ outText (p, (const char *) ".proc", 5);
+ }
+ }
+}
+
+
+/*
+ doExprM2 -
+*/
+
+static void doExprM2 (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ switch (n->kind)
+ {
+ case decl_nil:
+ outText (p, (const char *) "NIL", 3);
+ break;
+
+ case decl_true:
+ outText (p, (const char *) "TRUE", 4);
+ break;
+
+ case decl_false:
+ outText (p, (const char *) "FALSE", 5);
+ break;
+
+ case decl_constexp:
+ doUnary (p, (const char *) "", 0, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE);
+ break;
+
+ case decl_neg:
+ doUnary (p, (const char *) "-", 1, n->unaryF.arg, n->unaryF.resultType, FALSE, FALSE);
+ break;
+
+ case decl_not:
+ doUnary (p, (const char *) "NOT", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_adr:
+ doUnary (p, (const char *) "ADR", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_size:
+ doUnary (p, (const char *) "SIZE", 4, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_tsize:
+ doUnary (p, (const char *) "TSIZE", 5, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_float:
+ doUnary (p, (const char *) "FLOAT", 5, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_trunc:
+ doUnary (p, (const char *) "TRUNC", 5, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_ord:
+ doUnary (p, (const char *) "ORD", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_chr:
+ doUnary (p, (const char *) "CHR", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_cap:
+ doUnary (p, (const char *) "CAP", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_high:
+ doUnary (p, (const char *) "HIGH", 4, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_re:
+ doUnary (p, (const char *) "RE", 2, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_im:
+ doUnary (p, (const char *) "IM", 2, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_deref:
+ doPostUnary (p, (const char *) "^", 1, n->unaryF.arg);
+ break;
+
+ case decl_equal:
+ doBinary (p, (const char *) "=", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_notequal:
+ doBinary (p, (const char *) "#", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_less:
+ doBinary (p, (const char *) "<", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_greater:
+ doBinary (p, (const char *) ">", 1, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_greequal:
+ doBinary (p, (const char *) ">=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_lessequal:
+ doBinary (p, (const char *) "<=", 2, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_componentref:
+ doBinary (p, (const char *) ".", 1, n->componentrefF.rec, n->componentrefF.field, FALSE, FALSE, FALSE);
+ break;
+
+ case decl_pointerref:
+ doBinary (p, (const char *) "^.", 2, n->pointerrefF.ptr, n->pointerrefF.field, FALSE, FALSE, FALSE);
+ break;
+
+ case decl_cast:
+ doPreBinary (p, (const char *) "CAST", 4, n->binaryF.left, n->binaryF.right, TRUE, TRUE);
+ break;
+
+ case decl_val:
+ doPreBinary (p, (const char *) "VAL", 3, n->binaryF.left, n->binaryF.right, TRUE, TRUE);
+ break;
+
+ case decl_cmplx:
+ doPreBinary (p, (const char *) "CMPLX", 5, n->binaryF.left, n->binaryF.right, TRUE, TRUE);
+ break;
+
+ case decl_plus:
+ doBinary (p, (const char *) "+", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE);
+ break;
+
+ case decl_sub:
+ doBinary (p, (const char *) "-", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE);
+ break;
+
+ case decl_div:
+ doBinary (p, (const char *) "DIV", 3, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_mod:
+ doBinary (p, (const char *) "MOD", 3, n->binaryF.left, n->binaryF.right, TRUE, TRUE, FALSE);
+ break;
+
+ case decl_mult:
+ doBinary (p, (const char *) "*", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE);
+ break;
+
+ case decl_divide:
+ doBinary (p, (const char *) "/", 1, n->binaryF.left, n->binaryF.right, FALSE, FALSE, FALSE);
+ break;
+
+ case decl_literal:
+ doLiteral (p, n);
+ break;
+
+ case decl_const:
+ doConstExpr (p, n);
+ break;
+
+ case decl_enumerationfield:
+ doEnumerationField (p, n);
+ break;
+
+ case decl_string:
+ doString (p, n);
+ break;
+
+ case decl_max:
+ doUnary (p, (const char *) "MAX", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_min:
+ doUnary (p, (const char *) "MIN", 3, n->unaryF.arg, n->unaryF.resultType, TRUE, TRUE);
+ break;
+
+ case decl_var:
+ doVar (p, n);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ doVar -
+*/
+
+static void doVar (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (decl_isVar (n));
+ if (n->varF.isVarParameter)
+ {
+ outText (p, (const char *) "(*", 2);
+ doFQDNameC (p, n, TRUE);
+ outText (p, (const char *) ")", 1);
+ }
+ else
+ {
+ doFQDNameC (p, n, TRUE);
+ }
+}
+
+
+/*
+ doLiteralC -
+*/
+
+static void doLiteralC (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ mcDebug_assert (decl_isLiteral (n));
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ if (n->literalF.type == charN)
+ {
+ if ((DynamicStrings_char (s, -1)) == 'C')
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
+ if ((DynamicStrings_char (s, 0)) != '0')
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0", 1), DynamicStrings_Mark (s));
+ }
+ }
+ outText (p, (const char *) "(char)", 6);
+ mcPretty_setNeedSpace (p);
+ }
+ else if ((DynamicStrings_char (s, -1)) == 'H')
+ {
+ /* avoid dangling else. */
+ outText (p, (const char *) "0x", 2);
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
+ }
+ else if ((DynamicStrings_char (s, -1)) == 'B')
+ {
+ /* avoid dangling else. */
+ outText (p, (const char *) "0", 1);
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
+ }
+ outTextS (p, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ doLiteral -
+*/
+
+static void doLiteral (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ mcDebug_assert (decl_isLiteral (n));
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ if (n->literalF.type == charN)
+ {
+ if ((DynamicStrings_char (s, -1)) == 'C')
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
+ if ((DynamicStrings_char (s, 0)) != '0')
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0", 1), DynamicStrings_Mark (s));
+ }
+ }
+ outText (p, (const char *) "(char)", 6);
+ mcPretty_setNeedSpace (p);
+ }
+ outTextS (p, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ isString - returns TRUE if node, n, is a string.
+*/
+
+static unsigned int isString (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_string;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doString -
+*/
+
+static void doString (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ mcDebug_assert (isString (n));
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ outTextS (p, s);
+ s = DynamicStrings_KillString (s);
+ /*
+ IF DynamicStrings.Index (s, '"', 0)=-1
+ THEN
+ outText (p, '"') ;
+ outTextS (p, s) ;
+ outText (p, '"')
+ ELSIF DynamicStrings.Index (s, "'", 0)=-1
+ THEN
+ outText (p, '"') ;
+ outTextS (p, s) ;
+ outText (p, '"')
+ ELSE
+ metaError1 ('illegal string {%1k}', n)
+ END
+ */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ replaceChar - replace every occurance of, ch, by, a and return modified string, s.
+*/
+
+static DynamicStrings_String replaceChar (DynamicStrings_String s, char ch, const char *a_, unsigned int _a_high)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = 0;
+ for (;;)
+ {
+ i = DynamicStrings_Index (s, ch, static_cast<unsigned int> (i));
+ if (i == 0)
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) a, _a_high), DynamicStrings_Slice (s, 1, 0));
+ i = StrLib_StrLen ((const char *) a, _a_high);
+ }
+ else if (i > 0)
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_Slice (s, 0, i), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high))), DynamicStrings_Slice (s, i+1, 0));
+ i += StrLib_StrLen ((const char *) a, _a_high);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return s;
+ }
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ toCstring - translates string, n, into a C string
+ and returns the new String.
+*/
+
+static DynamicStrings_String toCstring (nameKey_Name n)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_Slice (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)), 1, -1);
+ return replaceChar (replaceChar (s, '\\', (const char *) "\\\\", 2), '"', (const char *) "\\\"", 2);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ toCchar -
+*/
+
+static DynamicStrings_String toCchar (nameKey_Name n)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_Slice (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)), 1, -1);
+ return replaceChar (replaceChar (s, '\\', (const char *) "\\\\", 2), '\'', (const char *) "\\'", 2);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ countChar -
+*/
+
+static unsigned int countChar (DynamicStrings_String s, char ch)
+{
+ int i;
+ unsigned int c;
+
+ c = 0;
+ i = 0;
+ for (;;)
+ {
+ i = DynamicStrings_Index (s, ch, static_cast<unsigned int> (i));
+ if (i >= 0)
+ {
+ i += 1;
+ c += 1;
+ }
+ else
+ {
+ return c;
+ }
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ lenCstring -
+*/
+
+static unsigned int lenCstring (DynamicStrings_String s)
+{
+ return (DynamicStrings_Length (s))-(countChar (s, '\\'));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ outCstring -
+*/
+
+static void outCstring (mcPretty_pretty p, decl_node s, unsigned int aString)
+{
+ if (aString)
+ {
+ outText (p, (const char *) "\"", 1);
+ outRawS (p, s->stringF.cstring);
+ outText (p, (const char *) "\"", 1);
+ }
+ else
+ {
+ outText (p, (const char *) "'", 1);
+ outRawS (p, s->stringF.cchar);
+ outText (p, (const char *) "'", 1);
+ }
+}
+
+
+/*
+ doStringC -
+*/
+
+static void doStringC (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ mcDebug_assert (isString (n));
+ /*
+ s := InitStringCharStar (keyToCharStar (getSymName (n))) ;
+ IF DynamicStrings.Length (s)>3
+ THEN
+ IF DynamicStrings.Index (s, '"', 0)=-1
+ THEN
+ s := DynamicStrings.Slice (s, 1, -1) ;
+ outText (p, '"') ;
+ outCstring (p, s) ;
+ outText (p, '"')
+ ELSIF DynamicStrings.Index (s, "'", 0)=-1
+ THEN
+ s := DynamicStrings.Slice (s, 1, -1) ;
+ outText (p, '"') ;
+ outCstring (p, s) ;
+ outText (p, '"')
+ ELSE
+ metaError1 ('illegal string {%1k}', n)
+ END
+ ELSIF DynamicStrings.Length (s) = 3
+ THEN
+ s := DynamicStrings.Slice (s, 1, -1) ;
+ outText (p, "'") ;
+ IF DynamicStrings.char (s, 0) = "'"
+ THEN
+ outText (p, "\'")
+ ELSIF DynamicStrings.char (s, 0) = "\"
+ THEN
+ outText (p, "\\")
+ ELSE
+ outTextS (p, s)
+ END ;
+ outText (p, "'")
+ ELSE
+ outText (p, "'\0'")
+ END ;
+ s := KillString (s)
+ */
+ outCstring (p, n, ! n->stringF.isCharCompatible);
+}
+
+
+/*
+ isPunct -
+*/
+
+static unsigned int isPunct (char ch)
+{
+ return (((((((((ch == '.') || (ch == '(')) || (ch == ')')) || (ch == '^')) || (ch == ':')) || (ch == ';')) || (ch == '{')) || (ch == '}')) || (ch == ',')) || (ch == '*');
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isWhite -
+*/
+
+static unsigned int isWhite (char ch)
+{
+ return ((ch == ' ') || (ch == ASCII_tab)) || (ch == ASCII_lf);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ outText -
+*/
+
+static void outText (mcPretty_pretty p, const char *a_, unsigned int _a_high)
+{
+ DynamicStrings_String s;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ s = DynamicStrings_InitString ((const char *) a, _a_high);
+ outTextS (p, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ outRawS -
+*/
+
+static void outRawS (mcPretty_pretty p, DynamicStrings_String s)
+{
+ mcPretty_raw (p, s);
+}
+
+
+/*
+ outKm2 -
+*/
+
+static mcPretty_pretty outKm2 (mcPretty_pretty p, const char *a_, unsigned int _a_high)
+{
+ unsigned int i;
+ DynamicStrings_String s;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ if (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "RECORD", 6))
+ {
+ p = mcPretty_pushPretty (p);
+ i = mcPretty_getcurpos (p);
+ mcPretty_setindent (p, i);
+ outText (p, (const char *) a, _a_high);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, i+indentation);
+ }
+ else if (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "END", 3))
+ {
+ /* avoid dangling else. */
+ p = mcPretty_popPretty (p);
+ outText (p, (const char *) a, _a_high);
+ p = mcPretty_popPretty (p);
+ }
+ return p;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ outKc -
+*/
+
+static mcPretty_pretty outKc (mcPretty_pretty p, const char *a_, unsigned int _a_high)
+{
+ int i;
+ unsigned int c;
+ DynamicStrings_String s;
+ DynamicStrings_String t;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ s = DynamicStrings_InitString ((const char *) a, _a_high);
+ i = DynamicStrings_Index (s, '\\', 0);
+ if (i == -1)
+ {
+ t = NULL;
+ }
+ else
+ {
+ t = DynamicStrings_Slice (s, i, 0);
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i);
+ }
+ if ((DynamicStrings_char (s, 0)) == '{')
+ {
+ p = mcPretty_pushPretty (p);
+ c = mcPretty_getcurpos (p);
+ mcPretty_setindent (p, c);
+ outTextS (p, s);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, c+indentationC);
+ }
+ else if ((DynamicStrings_char (s, 0)) == '}')
+ {
+ /* avoid dangling else. */
+ p = mcPretty_popPretty (p);
+ outTextS (p, s);
+ p = mcPretty_popPretty (p);
+ }
+ outTextS (p, t);
+ t = DynamicStrings_KillString (t);
+ s = DynamicStrings_KillString (s);
+ return p;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ outTextS -
+*/
+
+static void outTextS (mcPretty_pretty p, DynamicStrings_String s)
+{
+ if (s != NULL)
+ {
+ mcPretty_prints (p, s);
+ }
+}
+
+
+/*
+ outCard -
+*/
+
+static void outCard (mcPretty_pretty p, unsigned int c)
+{
+ DynamicStrings_String s;
+
+ s = StringConvert_CardinalToString (c, 0, ' ', 10, FALSE);
+ outTextS (p, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ outTextN -
+*/
+
+static void outTextN (mcPretty_pretty p, nameKey_Name n)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n));
+ mcPretty_prints (p, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ doTypeAliasC -
+*/
+
+static void doTypeAliasC (mcPretty_pretty p, decl_node n, decl_node *m)
+{
+ mcPretty_print (p, (const char *) "typedef", 7);
+ mcPretty_setNeedSpace (p);
+ if ((decl_isTypeHidden (n)) && ((decl_isDef (decl_getMainModule ())) || ((decl_getScope (n)) != (decl_getMainModule ()))))
+ {
+ outText (p, (const char *) "void *", 6);
+ }
+ else
+ {
+ doTypeC (p, decl_getType (n), m);
+ }
+ if ((*m) != NULL)
+ {
+ doFQNameC (p, (*m));
+ }
+ mcPretty_print (p, (const char *) ";\\n\\n", 5);
+}
+
+
+/*
+ doEnumerationC -
+*/
+
+static void doEnumerationC (mcPretty_pretty p, decl_node n)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node s;
+ DynamicStrings_String t;
+
+ outText (p, (const char *) "enum {", 6);
+ i = Indexing_LowIndice (n->enumerationF.listOfSons);
+ h = Indexing_HighIndice (n->enumerationF.listOfSons);
+ while (i <= h)
+ {
+ s = static_cast<decl_node> (Indexing_GetIndice (n->enumerationF.listOfSons, i));
+ doFQDNameC (p, s, FALSE);
+ if (i < h)
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ i += 1;
+ }
+ outText (p, (const char *) "}", 1);
+}
+
+
+/*
+ doNamesC -
+*/
+
+static void doNamesC (mcPretty_pretty p, nameKey_Name n)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n));
+ outTextS (p, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ doNameC -
+*/
+
+static void doNameC (mcPretty_pretty p, decl_node n)
+{
+ if ((n != NULL) && ((decl_getSymName (n)) != nameKey_NulName))
+ {
+ doNamesC (p, decl_getSymName (n));
+ }
+}
+
+
+/*
+ initCname -
+*/
+
+static void initCname (decl_cnameT *c)
+{
+ (*c).init = FALSE;
+}
+
+
+/*
+ doCname -
+*/
+
+static nameKey_Name doCname (nameKey_Name n, decl_cnameT *c, unsigned int scopes)
+{
+ DynamicStrings_String s;
+
+ if ((*c).init)
+ {
+ return (*c).name;
+ }
+ else
+ {
+ (*c).init = TRUE;
+ s = keyc_cname (n, scopes);
+ if (s == NULL)
+ {
+ (*c).name = n;
+ }
+ else
+ {
+ (*c).name = nameKey_makekey (DynamicStrings_string (s));
+ s = DynamicStrings_KillString (s);
+ }
+ return (*c).name;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getDName -
+*/
+
+static nameKey_Name getDName (decl_node n, unsigned int scopes)
+{
+ nameKey_Name m;
+
+ m = decl_getSymName (n);
+ switch (n->kind)
+ {
+ case decl_procedure:
+ return doCname (m, &n->procedureF.cname, scopes);
+ break;
+
+ case decl_var:
+ return doCname (m, &n->varF.cname, scopes);
+ break;
+
+ case decl_recordfield:
+ return doCname (m, &n->recordfieldF.cname, scopes);
+ break;
+
+ case decl_enumerationfield:
+ return doCname (m, &n->enumerationfieldF.cname, scopes);
+ break;
+
+
+ default:
+ break;
+ }
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doDNameC -
+*/
+
+static void doDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes)
+{
+ if ((n != NULL) && ((decl_getSymName (n)) != nameKey_NulName))
+ {
+ doNamesC (p, getDName (n, scopes));
+ }
+}
+
+
+/*
+ doFQDNameC -
+*/
+
+static void doFQDNameC (mcPretty_pretty p, decl_node n, unsigned int scopes)
+{
+ DynamicStrings_String s;
+
+ s = getFQDstring (n, scopes);
+ outTextS (p, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ doFQNameC -
+*/
+
+static void doFQNameC (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ s = getFQstring (n);
+ outTextS (p, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ doNameM2 -
+*/
+
+static void doNameM2 (mcPretty_pretty p, decl_node n)
+{
+ doNameC (p, n);
+}
+
+
+/*
+ doUsed -
+*/
+
+static void doUsed (mcPretty_pretty p, unsigned int used)
+{
+ if (! used)
+ {
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "__attribute__((unused))", 23);
+ }
+}
+
+
+/*
+ doHighC -
+*/
+
+static void doHighC (mcPretty_pretty p, decl_node a, nameKey_Name n, unsigned int isused)
+{
+ if ((decl_isArray (a)) && (decl_isUnbounded (a)))
+ {
+ /* need to display high. */
+ mcPretty_print (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ doTypeNameC (p, cardinalN);
+ mcPretty_setNeedSpace (p);
+ mcPretty_print (p, (const char *) "_", 1);
+ outTextN (p, n);
+ mcPretty_print (p, (const char *) "_high", 5);
+ doUsed (p, isused);
+ }
+}
+
+
+/*
+ doParamConstCast -
+*/
+
+static void doParamConstCast (mcPretty_pretty p, decl_node n)
+{
+ decl_node ptype;
+
+ ptype = decl_getType (n);
+ if (((decl_isArray (ptype)) && (decl_isUnbounded (ptype))) && (lang == decl_ansiCP))
+ {
+ outText (p, (const char *) "const", 5);
+ mcPretty_setNeedSpace (p);
+ }
+}
+
+
+/*
+ getParameterVariable - returns the variable which shadows the parameter
+ named, m, in parameter block, n.
+*/
+
+static decl_node getParameterVariable (decl_node n, nameKey_Name m)
+{
+ decl_node p;
+
+ mcDebug_assert ((decl_isParam (n)) || (decl_isVarParam (n)));
+ if (decl_isParam (n))
+ {
+ p = n->paramF.scope;
+ }
+ else
+ {
+ p = n->varparamF.scope;
+ }
+ mcDebug_assert (decl_isProcedure (p));
+ return decl_lookupInScope (p, m);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doParamTypeEmit - emit parameter type for C/C++. It checks to see if the
+ parameter type is a procedure type and if it were declared
+ in a definition module for "C" and if so it uses the "C"
+ definition for a procedure type, rather than the mc
+ C++ version.
+*/
+
+static void doParamTypeEmit (mcPretty_pretty p, decl_node paramnode, decl_node paramtype)
+{
+ mcDebug_assert ((decl_isParam (paramnode)) || (decl_isVarParam (paramnode)));
+ if ((isForC (paramnode)) && (decl_isProcType (decl_skipType (paramtype))))
+ {
+ doFQNameC (p, paramtype);
+ outText (p, (const char *) "_C", 2);
+ }
+ else
+ {
+ doTypeNameC (p, paramtype);
+ }
+}
+
+
+/*
+ doParamC - emit parameter for C/C++.
+*/
+
+static void doParamC (mcPretty_pretty p, decl_node n)
+{
+ decl_node v;
+ decl_node ptype;
+ nameKey_Name i;
+ unsigned int c;
+ unsigned int t;
+ wlists_wlist l;
+
+ mcDebug_assert (decl_isParam (n));
+ ptype = decl_getType (n);
+ if (n->paramF.namelist == NULL)
+ {
+ /* avoid dangling else. */
+ doParamConstCast (p, n);
+ doTypeNameC (p, ptype);
+ doUsed (p, n->paramF.isUsed);
+ if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "unsigned int", 12);
+ }
+ }
+ else
+ {
+ mcDebug_assert (isIdentList (n->paramF.namelist));
+ l = n->paramF.namelist->identlistF.names;
+ if (l == NULL)
+ {
+ /* avoid dangling else. */
+ doParamConstCast (p, n);
+ doParamTypeEmit (p, n, ptype);
+ if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
+ {
+ doUsed (p, n->paramF.isUsed);
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "unsigned int", 12);
+ }
+ }
+ else
+ {
+ t = wlists_noOfItemsInList (l);
+ c = 1;
+ while (c <= t)
+ {
+ doParamConstCast (p, n);
+ doParamTypeEmit (p, n, ptype);
+ i = static_cast<nameKey_Name> (wlists_getItemFromList (l, c));
+ if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
+ {
+ mcPretty_noSpace (p);
+ }
+ else
+ {
+ mcPretty_setNeedSpace (p);
+ }
+ v = getParameterVariable (n, i);
+ if (v == NULL)
+ {
+ doNamesC (p, keyc_cnamen (i, TRUE));
+ }
+ else
+ {
+ doFQDNameC (p, v, TRUE);
+ }
+ if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
+ {
+ outText (p, (const char *) "_", 1);
+ }
+ doUsed (p, n->paramF.isUsed);
+ doHighC (p, ptype, i, n->paramF.isUsed);
+ if (c < t)
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ c += 1;
+ }
+ }
+ }
+}
+
+
+/*
+ doVarParamC - emit a VAR parameter for C/C++.
+*/
+
+static void doVarParamC (mcPretty_pretty p, decl_node n)
+{
+ decl_node v;
+ decl_node ptype;
+ nameKey_Name i;
+ unsigned int c;
+ unsigned int t;
+ wlists_wlist l;
+
+ mcDebug_assert (decl_isVarParam (n));
+ ptype = decl_getType (n);
+ if (n->varparamF.namelist == NULL)
+ {
+ /* avoid dangling else. */
+ doTypeNameC (p, ptype);
+ /* doTypeC (p, ptype, n) ; */
+ if (! (decl_isArray (ptype)))
+ {
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "*", 1);
+ }
+ doUsed (p, n->varparamF.isUsed);
+ if ((decl_isArray (ptype)) && (decl_isUnbounded (ptype)))
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "unsigned int", 12);
+ }
+ }
+ else
+ {
+ mcDebug_assert (isIdentList (n->varparamF.namelist));
+ l = n->varparamF.namelist->identlistF.names;
+ if (l == NULL)
+ {
+ doParamTypeEmit (p, n, ptype);
+ doUsed (p, n->varparamF.isUsed);
+ }
+ else
+ {
+ t = wlists_noOfItemsInList (l);
+ c = 1;
+ while (c <= t)
+ {
+ doParamTypeEmit (p, n, ptype);
+ if (! (decl_isArray (ptype)))
+ {
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "*", 1);
+ }
+ i = static_cast<nameKey_Name> (wlists_getItemFromList (l, c));
+ v = getParameterVariable (n, i);
+ if (v == NULL)
+ {
+ doNamesC (p, keyc_cnamen (i, TRUE));
+ }
+ else
+ {
+ doFQDNameC (p, v, TRUE);
+ }
+ doUsed (p, n->varparamF.isUsed);
+ doHighC (p, ptype, i, n->varparamF.isUsed);
+ if (c < t)
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ c += 1;
+ }
+ }
+ }
+}
+
+
+/*
+ doOptargC -
+*/
+
+static void doOptargC (mcPretty_pretty p, decl_node n)
+{
+ decl_node ptype;
+ nameKey_Name i;
+ unsigned int t;
+ wlists_wlist l;
+
+ mcDebug_assert (decl_isOptarg (n));
+ ptype = decl_getType (n);
+ mcDebug_assert (n->optargF.namelist != NULL);
+ mcDebug_assert (isIdentList (n->paramF.namelist));
+ l = n->paramF.namelist->identlistF.names;
+ mcDebug_assert (l != NULL);
+ t = wlists_noOfItemsInList (l);
+ mcDebug_assert (t == 1);
+ doTypeNameC (p, ptype);
+ i = static_cast<nameKey_Name> (wlists_getItemFromList (l, 1));
+ mcPretty_setNeedSpace (p);
+ doNamesC (p, i);
+}
+
+
+/*
+ doParameterC -
+*/
+
+static void doParameterC (mcPretty_pretty p, decl_node n)
+{
+ if (decl_isParam (n))
+ {
+ doParamC (p, n);
+ }
+ else if (decl_isVarParam (n))
+ {
+ /* avoid dangling else. */
+ doVarParamC (p, n);
+ }
+ else if (decl_isVarargs (n))
+ {
+ /* avoid dangling else. */
+ mcPretty_print (p, (const char *) "...", 3);
+ }
+ else if (decl_isOptarg (n))
+ {
+ /* avoid dangling else. */
+ doOptargC (p, n);
+ }
+}
+
+
+/*
+ doProcTypeC -
+*/
+
+static void doProcTypeC (mcPretty_pretty p, decl_node t, decl_node n)
+{
+ mcDebug_assert (decl_isType (t));
+ outputPartial (t);
+ doCompletePartialProcType (p, t, n);
+}
+
+
+/*
+ doTypesC -
+*/
+
+static void doTypesC (decl_node n)
+{
+ decl_node m;
+
+ if (decl_isType (n))
+ {
+ m = decl_getType (n);
+ if (decl_isProcType (m))
+ {
+ doProcTypeC (doP, n, m);
+ }
+ else if ((decl_isType (m)) || (decl_isPointer (m)))
+ {
+ /* avoid dangling else. */
+ outText (doP, (const char *) "typedef", 7);
+ mcPretty_setNeedSpace (doP);
+ doTypeC (doP, m, &m);
+ if (decl_isType (m))
+ {
+ mcPretty_setNeedSpace (doP);
+ }
+ doTypeNameC (doP, n);
+ outText (doP, (const char *) ";\\n\\n", 5);
+ }
+ else if (decl_isEnumeration (m))
+ {
+ /* avoid dangling else. */
+ outText (doP, (const char *) "typedef", 7);
+ mcPretty_setNeedSpace (doP);
+ doTypeC (doP, m, &m);
+ mcPretty_setNeedSpace (doP);
+ doTypeNameC (doP, n);
+ outText (doP, (const char *) ";\\n\\n", 5);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ outText (doP, (const char *) "typedef", 7);
+ mcPretty_setNeedSpace (doP);
+ doTypeC (doP, m, &m);
+ if (decl_isType (m))
+ {
+ mcPretty_setNeedSpace (doP);
+ }
+ doTypeNameC (doP, n);
+ outText (doP, (const char *) ";\\n\\n", 5);
+ }
+ }
+}
+
+
+/*
+ doCompletePartialC -
+*/
+
+static void doCompletePartialC (decl_node n)
+{
+ decl_node m;
+
+ if (decl_isType (n))
+ {
+ m = decl_getType (n);
+ if (decl_isRecord (m))
+ {
+ doCompletePartialRecord (doP, n, m);
+ }
+ else if (decl_isArray (m))
+ {
+ /* avoid dangling else. */
+ doCompletePartialArray (doP, n, m);
+ }
+ else if (decl_isProcType (m))
+ {
+ /* avoid dangling else. */
+ doCompletePartialProcType (doP, n, m);
+ }
+ }
+}
+
+
+/*
+ doCompletePartialRecord -
+*/
+
+static void doCompletePartialRecord (mcPretty_pretty p, decl_node t, decl_node r)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node f;
+
+ mcDebug_assert (decl_isRecord (r));
+ mcDebug_assert (decl_isType (t));
+ outText (p, (const char *) "struct", 6);
+ mcPretty_setNeedSpace (p);
+ doFQNameC (p, t);
+ outText (p, (const char *) "_r", 2);
+ mcPretty_setNeedSpace (p);
+ p = outKc (p, (const char *) "{\\n", 3);
+ i = Indexing_LowIndice (r->recordF.listOfSons);
+ h = Indexing_HighIndice (r->recordF.listOfSons);
+ while (i <= h)
+ {
+ f = static_cast<decl_node> (Indexing_GetIndice (r->recordF.listOfSons, i));
+ if (decl_isRecordField (f))
+ {
+ /* avoid dangling else. */
+ if (! f->recordfieldF.tag)
+ {
+ mcPretty_setNeedSpace (p);
+ doRecordFieldC (p, f);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ }
+ else if (decl_isVarient (f))
+ {
+ /* avoid dangling else. */
+ doVarientC (p, f);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ else if (decl_isVarientField (f))
+ {
+ /* avoid dangling else. */
+ doVarientFieldC (p, f);
+ }
+ i += 1;
+ }
+ p = outKc (p, (const char *) "};\\n\\n", 6);
+}
+
+
+/*
+ doCompletePartialArray -
+*/
+
+static void doCompletePartialArray (mcPretty_pretty p, decl_node t, decl_node r)
+{
+ decl_node type;
+ decl_node s;
+
+ mcDebug_assert (decl_isArray (r));
+ type = r->arrayF.type;
+ s = NULL;
+ outText (p, (const char *) "struct", 6);
+ mcPretty_setNeedSpace (p);
+ doFQNameC (p, t);
+ outText (p, (const char *) "_a {", 4);
+ mcPretty_setNeedSpace (p);
+ doTypeC (p, type, &s);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "array[", 6);
+ doSubrC (p, r->arrayF.subr);
+ outText (p, (const char *) "];", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "};\\n", 4);
+}
+
+
+/*
+ lookupConst -
+*/
+
+static decl_node lookupConst (decl_node type, nameKey_Name n)
+{
+ return decl_makeLiteralInt (n);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doMin -
+*/
+
+static decl_node doMin (decl_node n)
+{
+ if (n == booleanN)
+ {
+ return falseN;
+ }
+ else if (n == integerN)
+ {
+ /* avoid dangling else. */
+ keyc_useIntMin ();
+ return lookupConst (integerN, nameKey_makeKey ((const char *) "INT_MIN", 7));
+ }
+ else if (n == cardinalN)
+ {
+ /* avoid dangling else. */
+ keyc_useUIntMin ();
+ return lookupConst (cardinalN, nameKey_makeKey ((const char *) "UINT_MIN", 8));
+ }
+ else if (n == longintN)
+ {
+ /* avoid dangling else. */
+ keyc_useLongMin ();
+ return lookupConst (longintN, nameKey_makeKey ((const char *) "LONG_MIN", 8));
+ }
+ else if (n == longcardN)
+ {
+ /* avoid dangling else. */
+ keyc_useULongMin ();
+ return lookupConst (longcardN, nameKey_makeKey ((const char *) "LONG_MIN", 8));
+ }
+ else if (n == charN)
+ {
+ /* avoid dangling else. */
+ keyc_useCharMin ();
+ return lookupConst (charN, nameKey_makeKey ((const char *) "CHAR_MIN", 8));
+ }
+ else if (n == bitsetN)
+ {
+ /* avoid dangling else. */
+ mcDebug_assert (decl_isSubrange (bitnumN));
+ return bitnumN->subrangeF.low;
+ }
+ else if (n == locN)
+ {
+ /* avoid dangling else. */
+ keyc_useUCharMin ();
+ return lookupConst (locN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9));
+ }
+ else if (n == byteN)
+ {
+ /* avoid dangling else. */
+ keyc_useUCharMin ();
+ return lookupConst (byteN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9));
+ }
+ else if (n == wordN)
+ {
+ /* avoid dangling else. */
+ keyc_useUIntMin ();
+ return lookupConst (wordN, nameKey_makeKey ((const char *) "UCHAR_MIN", 9));
+ }
+ else if (n == addressN)
+ {
+ /* avoid dangling else. */
+ return lookupConst (addressN, nameKey_makeKey ((const char *) "((void *) 0)", 12));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1); /* finish the cacading elsif statement. */
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ doMax -
+*/
+
+static decl_node doMax (decl_node n)
+{
+ if (n == booleanN)
+ {
+ return trueN;
+ }
+ else if (n == integerN)
+ {
+ /* avoid dangling else. */
+ keyc_useIntMax ();
+ return lookupConst (integerN, nameKey_makeKey ((const char *) "INT_MAX", 7));
+ }
+ else if (n == cardinalN)
+ {
+ /* avoid dangling else. */
+ keyc_useUIntMax ();
+ return lookupConst (cardinalN, nameKey_makeKey ((const char *) "UINT_MAX", 8));
+ }
+ else if (n == longintN)
+ {
+ /* avoid dangling else. */
+ keyc_useLongMax ();
+ return lookupConst (longintN, nameKey_makeKey ((const char *) "LONG_MAX", 8));
+ }
+ else if (n == longcardN)
+ {
+ /* avoid dangling else. */
+ keyc_useULongMax ();
+ return lookupConst (longcardN, nameKey_makeKey ((const char *) "ULONG_MAX", 9));
+ }
+ else if (n == charN)
+ {
+ /* avoid dangling else. */
+ keyc_useCharMax ();
+ return lookupConst (charN, nameKey_makeKey ((const char *) "CHAR_MAX", 8));
+ }
+ else if (n == bitsetN)
+ {
+ /* avoid dangling else. */
+ mcDebug_assert (decl_isSubrange (bitnumN));
+ return bitnumN->subrangeF.high;
+ }
+ else if (n == locN)
+ {
+ /* avoid dangling else. */
+ keyc_useUCharMax ();
+ return lookupConst (locN, nameKey_makeKey ((const char *) "UCHAR_MAX", 9));
+ }
+ else if (n == byteN)
+ {
+ /* avoid dangling else. */
+ keyc_useUCharMax ();
+ return lookupConst (byteN, nameKey_makeKey ((const char *) "UCHAR_MAX", 9));
+ }
+ else if (n == wordN)
+ {
+ /* avoid dangling else. */
+ keyc_useUIntMax ();
+ return lookupConst (wordN, nameKey_makeKey ((const char *) "UINT_MAX", 8));
+ }
+ else if (n == addressN)
+ {
+ /* avoid dangling else. */
+ mcMetaError_metaError1 ((const char *) "trying to obtain MAX ({%1ad}) is illegal", 40, (const unsigned char *) &n, (sizeof (n)-1));
+ return NULL;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1); /* finish the cacading elsif statement. */
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ getMax -
+*/
+
+static decl_node getMax (decl_node n)
+{
+ n = decl_skipType (n);
+ if (decl_isSubrange (n))
+ {
+ return n->subrangeF.high;
+ }
+ else if (decl_isEnumeration (n))
+ {
+ /* avoid dangling else. */
+ return n->enumerationF.high;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ mcDebug_assert (isOrdinal (n));
+ return doMax (n);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getMin -
+*/
+
+static decl_node getMin (decl_node n)
+{
+ n = decl_skipType (n);
+ if (decl_isSubrange (n))
+ {
+ return n->subrangeF.low;
+ }
+ else if (decl_isEnumeration (n))
+ {
+ /* avoid dangling else. */
+ return n->enumerationF.low;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ mcDebug_assert (isOrdinal (n));
+ return doMin (n);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doSubtractC -
+*/
+
+static void doSubtractC (mcPretty_pretty p, decl_node s)
+{
+ if (! (isZero (s)))
+ {
+ outText (p, (const char *) "-", 1);
+ doExprC (p, s);
+ }
+}
+
+
+/*
+ doSubrC -
+*/
+
+static void doSubrC (mcPretty_pretty p, decl_node s)
+{
+ decl_node low;
+ decl_node high;
+
+ s = decl_skipType (s);
+ if (isOrdinal (s))
+ {
+ low = getMin (s);
+ high = getMax (s);
+ doExprC (p, high);
+ doSubtractC (p, low);
+ outText (p, (const char *) "+1", 2);
+ }
+ else if (decl_isEnumeration (s))
+ {
+ /* avoid dangling else. */
+ low = getMin (s);
+ high = getMax (s);
+ doExprC (p, high);
+ doSubtractC (p, low);
+ outText (p, (const char *) "+1", 2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ mcDebug_assert (decl_isSubrange (s));
+ if ((s->subrangeF.high == NULL) || (s->subrangeF.low == NULL))
+ {
+ doSubrC (p, decl_getType (s));
+ }
+ else
+ {
+ doExprC (p, s->subrangeF.high);
+ doSubtractC (p, s->subrangeF.low);
+ outText (p, (const char *) "+1", 2);
+ }
+ }
+}
+
+
+/*
+ doCompletePartialProcType -
+*/
+
+static void doCompletePartialProcType (mcPretty_pretty p, decl_node t, decl_node n)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node v;
+ decl_node u;
+
+ mcDebug_assert (decl_isProcType (n));
+ u = NULL;
+ outText (p, (const char *) "typedef", 7);
+ mcPretty_setNeedSpace (p);
+ doTypeC (p, n->proctypeF.returnType, &u);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(*", 2);
+ doFQNameC (p, t);
+ outText (p, (const char *) "_t) (", 5);
+ i = Indexing_LowIndice (n->proctypeF.parameters);
+ h = Indexing_HighIndice (n->proctypeF.parameters);
+ while (i <= h)
+ {
+ v = static_cast<decl_node> (Indexing_GetIndice (n->proctypeF.parameters, i));
+ doParameterC (p, v);
+ mcPretty_noSpace (p);
+ if (i < h)
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ i += 1;
+ }
+ if (h == 0)
+ {
+ outText (p, (const char *) "void", 4);
+ }
+ outText (p, (const char *) ");\\n", 4);
+ if (isDefForCNode (n))
+ {
+ /* emit a C named type which differs from the m2 proctype. */
+ outText (p, (const char *) "typedef", 7);
+ mcPretty_setNeedSpace (p);
+ doFQNameC (p, t);
+ outText (p, (const char *) "_t", 2);
+ mcPretty_setNeedSpace (p);
+ doFQNameC (p, t);
+ outText (p, (const char *) "_C;\\n\\n", 7);
+ }
+ outText (p, (const char *) "struct", 6);
+ mcPretty_setNeedSpace (p);
+ doFQNameC (p, t);
+ outText (p, (const char *) "_p {", 4);
+ mcPretty_setNeedSpace (p);
+ doFQNameC (p, t);
+ outText (p, (const char *) "_t proc; };\\n\\n", 15);
+}
+
+
+/*
+ isBase -
+*/
+
+static unsigned int isBase (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_char:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_complex:
+ case decl_longcomplex:
+ case decl_shortcomplex:
+ case decl_real:
+ case decl_longreal:
+ case decl_shortreal:
+ case decl_bitset:
+ case decl_boolean:
+ case decl_proc:
+ return TRUE;
+ break;
+
+
+ default:
+ return FALSE;
+ break;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doBaseC -
+*/
+
+static void doBaseC (mcPretty_pretty p, decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_char:
+ outText (p, (const char *) "char", 4);
+ break;
+
+ case decl_cardinal:
+ outText (p, (const char *) "unsigned int", 12);
+ break;
+
+ case decl_longcard:
+ outText (p, (const char *) "long unsigned int", 17);
+ break;
+
+ case decl_shortcard:
+ outText (p, (const char *) "short unsigned int", 18);
+ break;
+
+ case decl_integer:
+ outText (p, (const char *) "int", 3);
+ break;
+
+ case decl_longint:
+ outText (p, (const char *) "long int", 8);
+ break;
+
+ case decl_shortint:
+ outText (p, (const char *) "short int", 9);
+ break;
+
+ case decl_complex:
+ outText (p, (const char *) "double complex", 14);
+ break;
+
+ case decl_longcomplex:
+ outText (p, (const char *) "long double complex", 19);
+ break;
+
+ case decl_shortcomplex:
+ outText (p, (const char *) "float complex", 13);
+ break;
+
+ case decl_real:
+ outText (p, (const char *) "double", 6);
+ break;
+
+ case decl_longreal:
+ outText (p, (const char *) "long double", 11);
+ break;
+
+ case decl_shortreal:
+ outText (p, (const char *) "float", 5);
+ break;
+
+ case decl_bitset:
+ outText (p, (const char *) "unsigned int", 12);
+ break;
+
+ case decl_boolean:
+ outText (p, (const char *) "unsigned int", 12);
+ break;
+
+ case decl_proc:
+ outText (p, (const char *) "PROC", 4);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ mcPretty_setNeedSpace (p);
+}
+
+
+/*
+ isSystem -
+*/
+
+static unsigned int isSystem (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_address:
+ return TRUE;
+ break;
+
+ case decl_loc:
+ return TRUE;
+ break;
+
+ case decl_byte:
+ return TRUE;
+ break;
+
+ case decl_word:
+ return TRUE;
+ break;
+
+ case decl_csizet:
+ return TRUE;
+ break;
+
+ case decl_cssizet:
+ return TRUE;
+ break;
+
+
+ default:
+ return FALSE;
+ break;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doSystemC -
+*/
+
+static void doSystemC (mcPretty_pretty p, decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_address:
+ outText (p, (const char *) "void *", 6);
+ break;
+
+ case decl_loc:
+ outText (p, (const char *) "unsigned char", 13);
+ mcPretty_setNeedSpace (p);
+ break;
+
+ case decl_byte:
+ outText (p, (const char *) "unsigned char", 13);
+ mcPretty_setNeedSpace (p);
+ break;
+
+ case decl_word:
+ outText (p, (const char *) "unsigned int", 12);
+ mcPretty_setNeedSpace (p);
+ break;
+
+ case decl_csizet:
+ outText (p, (const char *) "size_t", 6);
+ mcPretty_setNeedSpace (p);
+ keyc_useSize_t ();
+ break;
+
+ case decl_cssizet:
+ outText (p, (const char *) "ssize_t", 7);
+ mcPretty_setNeedSpace (p);
+ keyc_useSSize_t ();
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ doArrayC -
+*/
+
+static void doArrayC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+ decl_node s;
+ decl_node u;
+
+ mcDebug_assert (decl_isArray (n));
+ t = n->arrayF.type;
+ s = n->arrayF.subr;
+ u = NULL;
+ if (s == NULL)
+ {
+ doTypeC (p, t, &u);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "*", 1);
+ }
+ else
+ {
+ outText (p, (const char *) "struct", 6);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "{", 1);
+ mcPretty_setNeedSpace (p);
+ doTypeC (p, t, &u);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "array[", 6);
+ if (isZero (getMin (s)))
+ {
+ doExprC (p, getMax (s));
+ }
+ else
+ {
+ doExprC (p, getMax (s));
+ doSubtractC (p, getMin (s));
+ }
+ outText (p, (const char *) "];", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "}", 1);
+ mcPretty_setNeedSpace (p);
+ }
+}
+
+
+/*
+ doPointerC -
+*/
+
+static void doPointerC (mcPretty_pretty p, decl_node n, decl_node *m)
+{
+ decl_node t;
+ decl_node s;
+
+ t = n->pointerF.type;
+ s = NULL;
+ doTypeC (p, t, &s);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "*", 1);
+}
+
+
+/*
+ doRecordFieldC -
+*/
+
+static void doRecordFieldC (mcPretty_pretty p, decl_node f)
+{
+ decl_node m;
+
+ m = NULL;
+ mcPretty_setNeedSpace (p);
+ doTypeC (p, f->recordfieldF.type, &m);
+ doDNameC (p, f, FALSE);
+}
+
+
+/*
+ doVarientFieldC -
+*/
+
+static void doVarientFieldC (mcPretty_pretty p, decl_node n)
+{
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ mcDebug_assert (decl_isVarientField (n));
+ if (! n->varientfieldF.simple)
+ {
+ outText (p, (const char *) "struct", 6);
+ mcPretty_setNeedSpace (p);
+ p = outKc (p, (const char *) "{\\n", 3);
+ }
+ i = Indexing_LowIndice (n->varientfieldF.listOfSons);
+ t = Indexing_HighIndice (n->varientfieldF.listOfSons);
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->varientfieldF.listOfSons, i));
+ if (decl_isRecordField (q))
+ {
+ /* avoid dangling else. */
+ if (! q->recordfieldF.tag)
+ {
+ doRecordFieldC (p, q);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ }
+ else if (decl_isVarient (q))
+ {
+ /* avoid dangling else. */
+ doVarientC (p, q);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ i += 1;
+ }
+ if (! n->varientfieldF.simple)
+ {
+ p = outKc (p, (const char *) "};\\n", 4);
+ }
+}
+
+
+/*
+ doVarientC -
+*/
+
+static void doVarientC (mcPretty_pretty p, decl_node n)
+{
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ mcDebug_assert (decl_isVarient (n));
+ if (n->varientF.tag != NULL)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (decl_isRecordField (n->varientF.tag))
+ {
+ doRecordFieldC (p, n->varientF.tag);
+ outText (p, (const char *) "; /* case tag */\\n", 19);
+ }
+ else if (decl_isVarientField (n->varientF.tag))
+ {
+ /* avoid dangling else. */
+ /* doVarientFieldC (p, n^.varientF.tag) */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ }
+ outText (p, (const char *) "union", 5);
+ mcPretty_setNeedSpace (p);
+ p = outKc (p, (const char *) "{\\n", 3);
+ i = Indexing_LowIndice (n->varientF.listOfSons);
+ t = Indexing_HighIndice (n->varientF.listOfSons);
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->varientF.listOfSons, i));
+ if (decl_isRecordField (q))
+ {
+ /* avoid dangling else. */
+ if (! q->recordfieldF.tag)
+ {
+ doRecordFieldC (p, q);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ }
+ else if (decl_isVarientField (q))
+ {
+ /* avoid dangling else. */
+ doVarientFieldC (p, q);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ i += 1;
+ }
+ p = outKc (p, (const char *) "}", 1);
+}
+
+
+/*
+ doRecordC -
+*/
+
+static void doRecordC (mcPretty_pretty p, decl_node n, decl_node *m)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node f;
+
+ mcDebug_assert (decl_isRecord (n));
+ outText (p, (const char *) "struct", 6);
+ mcPretty_setNeedSpace (p);
+ p = outKc (p, (const char *) "{", 1);
+ i = Indexing_LowIndice (n->recordF.listOfSons);
+ h = Indexing_HighIndice (n->recordF.listOfSons);
+ mcPretty_setindent (p, (mcPretty_getcurpos (p))+indentation);
+ outText (p, (const char *) "\\n", 2);
+ while (i <= h)
+ {
+ f = static_cast<decl_node> (Indexing_GetIndice (n->recordF.listOfSons, i));
+ if (decl_isRecordField (f))
+ {
+ /* avoid dangling else. */
+ if (! f->recordfieldF.tag)
+ {
+ doRecordFieldC (p, f);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ }
+ else if (decl_isVarient (f))
+ {
+ /* avoid dangling else. */
+ doVarientC (p, f);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ else if (decl_isVarientField (f))
+ {
+ /* avoid dangling else. */
+ doVarientFieldC (p, f);
+ }
+ i += 1;
+ }
+ p = outKc (p, (const char *) "}", 1);
+ mcPretty_setNeedSpace (p);
+}
+
+
+/*
+ isBitset -
+*/
+
+static unsigned int isBitset (decl_node n)
+{
+ return n == bitsetN;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isNegative - returns TRUE if expression, n, is negative.
+*/
+
+static unsigned int isNegative (decl_node n)
+{
+ /* --fixme-- needs to be completed. */
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doSubrangeC -
+*/
+
+static void doSubrangeC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (decl_isSubrange (n));
+ if (isNegative (n->subrangeF.low))
+ {
+ outText (p, (const char *) "int", 3);
+ mcPretty_setNeedSpace (p);
+ }
+ else
+ {
+ outText (p, (const char *) "unsigned int", 12);
+ mcPretty_setNeedSpace (p);
+ }
+}
+
+
+/*
+ doSetC - generates a C type which holds the set.
+ Currently we only support sets of size WORD.
+*/
+
+static void doSetC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (decl_isSet (n));
+ outText (p, (const char *) "unsigned int", 12);
+ mcPretty_setNeedSpace (p);
+}
+
+
+/*
+ doTypeC -
+*/
+
+static void doTypeC (mcPretty_pretty p, decl_node n, decl_node *m)
+{
+ if (n == NULL)
+ {
+ outText (p, (const char *) "void", 4);
+ }
+ else if (isBase (n))
+ {
+ /* avoid dangling else. */
+ doBaseC (p, n);
+ }
+ else if (isSystem (n))
+ {
+ /* avoid dangling else. */
+ doSystemC (p, n);
+ }
+ else if (decl_isEnumeration (n))
+ {
+ /* avoid dangling else. */
+ doEnumerationC (p, n);
+ }
+ else if (decl_isType (n))
+ {
+ /* avoid dangling else. */
+ doFQNameC (p, n);
+ /*
+ ELSIF isProcType (n) OR isArray (n) OR isRecord (n)
+ THEN
+ HALT n should have been simplified.
+ */
+ mcPretty_setNeedSpace (p);
+ }
+ else if (decl_isProcType (n))
+ {
+ /* avoid dangling else. */
+ doProcTypeC (p, n, (*m));
+ }
+ else if (decl_isArray (n))
+ {
+ /* avoid dangling else. */
+ doArrayC (p, n);
+ }
+ else if (decl_isRecord (n))
+ {
+ /* avoid dangling else. */
+ doRecordC (p, n, m);
+ }
+ else if (decl_isPointer (n))
+ {
+ /* avoid dangling else. */
+ doPointerC (p, n, m);
+ }
+ else if (decl_isSubrange (n))
+ {
+ /* avoid dangling else. */
+ doSubrangeC (p, n);
+ }
+ else if (decl_isSet (n))
+ {
+ /* avoid dangling else. */
+ doSetC (p, n);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ /* --fixme-- */
+ mcPretty_print (p, (const char *) "to do ... typedef etc etc ", 27);
+ doFQNameC (p, n);
+ mcPretty_print (p, (const char *) ";\\n", 3);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ doArrayNameC - it displays the array declaration (it might be an unbounded).
+*/
+
+static void doArrayNameC (mcPretty_pretty p, decl_node n)
+{
+ doTypeNameC (p, decl_getType (n));
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "*", 1);
+}
+
+
+/*
+ doRecordNameC - emit the C/C++ record name <name of n>"_r".
+*/
+
+static void doRecordNameC (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ s = getFQstring (n);
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_r", 2)));
+ outTextS (p, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ doPointerNameC - emit the C/C++ pointer type <name of n>*.
+*/
+
+static void doPointerNameC (mcPretty_pretty p, decl_node n)
+{
+ doTypeNameC (p, decl_getType (n));
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "*", 1);
+}
+
+
+/*
+ doTypeNameC -
+*/
+
+static void doTypeNameC (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String t;
+
+ if (n == NULL)
+ {
+ outText (p, (const char *) "void", 4);
+ mcPretty_setNeedSpace (p);
+ }
+ else if (isBase (n))
+ {
+ /* avoid dangling else. */
+ doBaseC (p, n);
+ }
+ else if (isSystem (n))
+ {
+ /* avoid dangling else. */
+ doSystemC (p, n);
+ }
+ else if (decl_isEnumeration (n))
+ {
+ /* avoid dangling else. */
+ mcPretty_print (p, (const char *) "is enumeration type name required\\n", 35);
+ }
+ else if (decl_isType (n))
+ {
+ /* avoid dangling else. */
+ doFQNameC (p, n);
+ }
+ else if (decl_isProcType (n))
+ {
+ /* avoid dangling else. */
+ doFQNameC (p, n);
+ outText (p, (const char *) "_t", 2);
+ }
+ else if (decl_isArray (n))
+ {
+ /* avoid dangling else. */
+ doArrayNameC (p, n);
+ }
+ else if (decl_isRecord (n))
+ {
+ /* avoid dangling else. */
+ doRecordNameC (p, n);
+ }
+ else if (decl_isPointer (n))
+ {
+ /* avoid dangling else. */
+ doPointerNameC (p, n);
+ }
+ else if (decl_isSubrange (n))
+ {
+ /* avoid dangling else. */
+ doSubrangeC (p, n);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ mcPretty_print (p, (const char *) "is type unknown required\\n", 26);
+ stop ();
+ }
+}
+
+
+/*
+ isExternal - returns TRUE if symbol, n, was declared in another module.
+*/
+
+static unsigned int isExternal (decl_node n)
+{
+ decl_node s;
+
+ s = decl_getScope (n);
+ return ((s != NULL) && (decl_isDef (s))) && (((decl_isImp (decl_getMainModule ())) && (s != (decl_lookupDef (decl_getSymName (decl_getMainModule ()))))) || (decl_isModule (decl_getMainModule ())));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doVarC -
+*/
+
+static void doVarC (decl_node n)
+{
+ decl_node s;
+
+ if (decl_isDef (decl_getMainModule ()))
+ {
+ mcPretty_print (doP, (const char *) "EXTERN", 6);
+ mcPretty_setNeedSpace (doP);
+ }
+ else if ((! (decl_isExported (n))) && (! (isLocal (n))))
+ {
+ /* avoid dangling else. */
+ mcPretty_print (doP, (const char *) "static", 6);
+ mcPretty_setNeedSpace (doP);
+ }
+ else if (mcOptions_getExtendedOpaque ())
+ {
+ /* avoid dangling else. */
+ if (isExternal (n))
+ {
+ /* different module declared this variable, therefore it is extern. */
+ mcPretty_print (doP, (const char *) "extern", 6);
+ mcPretty_setNeedSpace (doP);
+ }
+ }
+ s = NULL;
+ doTypeC (doP, decl_getType (n), &s);
+ mcPretty_setNeedSpace (doP);
+ doFQDNameC (doP, n, FALSE);
+ mcPretty_print (doP, (const char *) ";\\n", 3);
+}
+
+
+/*
+ doExternCP -
+*/
+
+static void doExternCP (mcPretty_pretty p)
+{
+ if (lang == decl_ansiCP)
+ {
+ outText (p, (const char *) "extern \"C\"", 10);
+ mcPretty_setNeedSpace (p);
+ }
+}
+
+
+/*
+ doProcedureCommentText -
+*/
+
+static void doProcedureCommentText (mcPretty_pretty p, DynamicStrings_String s)
+{
+ /* remove
+ from the start of the comment. */
+ while (((DynamicStrings_Length (s)) > 0) && ((DynamicStrings_char (s, 0)) == ASCII_lf))
+ {
+ s = DynamicStrings_Slice (s, 1, 0);
+ }
+ outTextS (p, s);
+}
+
+
+/*
+ doProcedureComment -
+*/
+
+static void doProcedureComment (mcPretty_pretty p, DynamicStrings_String s)
+{
+ if (s != NULL)
+ {
+ outText (p, (const char *) "\\n/*\\n", 6);
+ doProcedureCommentText (p, s);
+ outText (p, (const char *) "*/\\n\\n", 6);
+ }
+}
+
+
+/*
+ doProcedureHeadingC -
+*/
+
+static void doProcedureHeadingC (decl_node n, unsigned int prototype)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node p;
+ decl_node q;
+
+ mcDebug_assert (decl_isProcedure (n));
+ mcPretty_noSpace (doP);
+ if (decl_isDef (decl_getMainModule ()))
+ {
+ doProcedureComment (doP, mcComment_getContent (n->procedureF.defComment));
+ outText (doP, (const char *) "EXTERN", 6);
+ mcPretty_setNeedSpace (doP);
+ }
+ else if (decl_isExported (n))
+ {
+ /* avoid dangling else. */
+ doProcedureComment (doP, mcComment_getContent (n->procedureF.modComment));
+ doExternCP (doP);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ doProcedureComment (doP, mcComment_getContent (n->procedureF.modComment));
+ outText (doP, (const char *) "static", 6);
+ mcPretty_setNeedSpace (doP);
+ }
+ q = NULL;
+ doTypeC (doP, n->procedureF.returnType, &q);
+ mcPretty_setNeedSpace (doP);
+ doFQDNameC (doP, n, FALSE);
+ mcPretty_setNeedSpace (doP);
+ outText (doP, (const char *) "(", 1);
+ i = Indexing_LowIndice (n->procedureF.parameters);
+ h = Indexing_HighIndice (n->procedureF.parameters);
+ while (i <= h)
+ {
+ p = static_cast<decl_node> (Indexing_GetIndice (n->procedureF.parameters, i));
+ doParameterC (doP, p);
+ mcPretty_noSpace (doP);
+ if (i < h)
+ {
+ mcPretty_print (doP, (const char *) ",", 1);
+ mcPretty_setNeedSpace (doP);
+ }
+ i += 1;
+ }
+ if (h == 0)
+ {
+ outText (doP, (const char *) "void", 4);
+ }
+ mcPretty_print (doP, (const char *) ")", 1);
+ if ((n->procedureF.noreturn && prototype) && (! (mcOptions_getSuppressNoReturn ())))
+ {
+ mcPretty_setNeedSpace (doP);
+ outText (doP, (const char *) "__attribute__ ((noreturn))", 26);
+ }
+}
+
+
+/*
+ checkDeclareUnboundedParamCopyC -
+*/
+
+static unsigned int checkDeclareUnboundedParamCopyC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+ unsigned int i;
+ unsigned int c;
+ wlists_wlist l;
+ unsigned int seen;
+
+ seen = FALSE;
+ t = decl_getType (n);
+ l = n->paramF.namelist->identlistF.names;
+ if (((decl_isArray (t)) && (decl_isUnbounded (t))) && (l != NULL))
+ {
+ t = decl_getType (t);
+ c = wlists_noOfItemsInList (l);
+ i = 1;
+ while (i <= c)
+ {
+ doTypeNameC (p, t);
+ mcPretty_setNeedSpace (p);
+ doNamesC (p, wlists_getItemFromList (l, i));
+ outText (p, (const char *) "[_", 2);
+ doNamesC (p, wlists_getItemFromList (l, i));
+ outText (p, (const char *) "_high+1];\\n", 11);
+ seen = TRUE;
+ i += 1;
+ }
+ }
+ return seen;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ checkUnboundedParamCopyC -
+*/
+
+static void checkUnboundedParamCopyC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+ decl_node s;
+ unsigned int i;
+ unsigned int c;
+ wlists_wlist l;
+
+ t = decl_getType (n);
+ l = n->paramF.namelist->identlistF.names;
+ if (((decl_isArray (t)) && (decl_isUnbounded (t))) && (l != NULL))
+ {
+ c = wlists_noOfItemsInList (l);
+ i = 1;
+ t = decl_getType (t);
+ s = decl_skipType (t);
+ while (i <= c)
+ {
+ keyc_useMemcpy ();
+ outText (p, (const char *) "memcpy (", 8);
+ doNamesC (p, wlists_getItemFromList (l, i));
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ doNamesC (p, wlists_getItemFromList (l, i));
+ outText (p, (const char *) "_, ", 3);
+ if (((s == charN) || (s == byteN)) || (s == locN))
+ {
+ outText (p, (const char *) "_", 1);
+ doNamesC (p, wlists_getItemFromList (l, i));
+ outText (p, (const char *) "_high+1);\\n", 11);
+ }
+ else
+ {
+ outText (p, (const char *) "(_", 2);
+ doNamesC (p, wlists_getItemFromList (l, i));
+ outText (p, (const char *) "_high+1)", 8);
+ mcPretty_setNeedSpace (p);
+ doMultiplyBySize (p, t);
+ outText (p, (const char *) ");\\n", 4);
+ }
+ i += 1;
+ }
+ }
+}
+
+
+/*
+ doUnboundedParamCopyC -
+*/
+
+static void doUnboundedParamCopyC (mcPretty_pretty p, decl_node n)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node q;
+ unsigned int seen;
+
+ mcDebug_assert (decl_isProcedure (n));
+ i = Indexing_LowIndice (n->procedureF.parameters);
+ h = Indexing_HighIndice (n->procedureF.parameters);
+ seen = FALSE;
+ while (i <= h)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->procedureF.parameters, i));
+ if (decl_isParam (q))
+ {
+ seen = (checkDeclareUnboundedParamCopyC (p, q)) || seen;
+ }
+ i += 1;
+ }
+ if (seen)
+ {
+ outText (p, (const char *) "\\n", 2);
+ outText (p, (const char *) "/* make a local copy of each unbounded array. */\\n", 51);
+ i = Indexing_LowIndice (n->procedureF.parameters);
+ while (i <= h)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->procedureF.parameters, i));
+ if (decl_isParam (q))
+ {
+ checkUnboundedParamCopyC (p, q);
+ }
+ i += 1;
+ }
+ }
+}
+
+
+/*
+ doPrototypeC -
+*/
+
+static void doPrototypeC (decl_node n)
+{
+ if (! (decl_isExported (n)))
+ {
+ keyc_enterScope (n);
+ doProcedureHeadingC (n, TRUE);
+ mcPretty_print (doP, (const char *) ";\\n", 3);
+ keyc_leaveScope (n);
+ }
+}
+
+
+/*
+ addTodo - adds, n, to the todo list.
+*/
+
+static void addTodo (decl_node n)
+{
+ if (((n != NULL) && (! (alists_isItemInList (partialQ, reinterpret_cast<void *> (n))))) && (! (alists_isItemInList (doneQ, reinterpret_cast<void *> (n)))))
+ {
+ mcDebug_assert (! (decl_isVarient (n)));
+ mcDebug_assert (! (decl_isVarientField (n)));
+ mcDebug_assert (! (decl_isDef (n)));
+ alists_includeItemIntoList (todoQ, reinterpret_cast<void *> (n));
+ }
+}
+
+
+/*
+ addVariablesTodo -
+*/
+
+static void addVariablesTodo (decl_node n)
+{
+ if (decl_isVar (n))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (n->varF.isParameter || n->varF.isVarParameter)
+ {
+ addDone (n);
+ addTodo (decl_getType (n));
+ }
+ else
+ {
+ addTodo (n);
+ }
+ }
+}
+
+
+/*
+ addTypesTodo -
+*/
+
+static void addTypesTodo (decl_node n)
+{
+ if (decl_isUnbounded (n))
+ {
+ addDone (n);
+ }
+ else
+ {
+ addTodo (n);
+ }
+}
+
+
+/*
+ tempName -
+*/
+
+static DynamicStrings_String tempName (void)
+{
+ tempCount += 1;
+ return FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "_T%d", 4), (const unsigned char *) &tempCount, (sizeof (tempCount)-1));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeIntermediateType -
+*/
+
+static decl_node makeIntermediateType (DynamicStrings_String s, decl_node p)
+{
+ nameKey_Name n;
+ decl_node o;
+
+ n = nameKey_makekey (DynamicStrings_string (s));
+ decl_enterScope (decl_getScope (p));
+ o = p;
+ p = decl_makeType (nameKey_makekey (DynamicStrings_string (s)));
+ decl_putType (p, o);
+ putTypeInternal (p);
+ decl_leaveScope ();
+ return p;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ simplifyType -
+*/
+
+static void simplifyType (alists_alist l, decl_node *p)
+{
+ DynamicStrings_String s;
+
+ if ((((*p) != NULL) && (((decl_isRecord ((*p))) || (decl_isArray ((*p)))) || (decl_isProcType ((*p))))) && (! (decl_isUnbounded ((*p)))))
+ {
+ s = tempName ();
+ (*p) = makeIntermediateType (s, (*p));
+ s = DynamicStrings_KillString (s);
+ simplified = FALSE;
+ }
+ simplifyNode (l, (*p));
+}
+
+
+/*
+ simplifyVar -
+*/
+
+static void simplifyVar (alists_alist l, decl_node n)
+{
+ unsigned int i;
+ unsigned int t;
+ decl_node v;
+ decl_node d;
+ decl_node o;
+
+ mcDebug_assert (decl_isVar (n));
+ o = n->varF.type;
+ simplifyType (l, &n->varF.type);
+ if (o != n->varF.type)
+ {
+ /* simplification has occurred, make sure that all other variables of this type
+ use the new type. */
+ d = n->varF.decl;
+ mcDebug_assert (isVarDecl (d));
+ t = wlists_noOfItemsInList (d->vardeclF.names);
+ i = 1;
+ while (i <= t)
+ {
+ v = decl_lookupInScope (n->varF.scope, wlists_getItemFromList (d->vardeclF.names, i));
+ mcDebug_assert (decl_isVar (v));
+ v->varF.type = n->varF.type;
+ i += 1;
+ }
+ }
+}
+
+
+/*
+ simplifyRecord -
+*/
+
+static void simplifyRecord (alists_alist l, decl_node n)
+{
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ i = Indexing_LowIndice (n->recordF.listOfSons);
+ t = Indexing_HighIndice (n->recordF.listOfSons);
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->recordF.listOfSons, i));
+ simplifyNode (l, q);
+ i += 1;
+ }
+}
+
+
+/*
+ simplifyVarient -
+*/
+
+static void simplifyVarient (alists_alist l, decl_node n)
+{
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ simplifyNode (l, n->varientF.tag);
+ i = Indexing_LowIndice (n->varientF.listOfSons);
+ t = Indexing_HighIndice (n->varientF.listOfSons);
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->varientF.listOfSons, i));
+ simplifyNode (l, q);
+ i += 1;
+ }
+}
+
+
+/*
+ simplifyVarientField -
+*/
+
+static void simplifyVarientField (alists_alist l, decl_node n)
+{
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ i = Indexing_LowIndice (n->varientfieldF.listOfSons);
+ t = Indexing_HighIndice (n->varientfieldF.listOfSons);
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->varientfieldF.listOfSons, i));
+ simplifyNode (l, q);
+ i += 1;
+ }
+}
+
+
+/*
+ doSimplifyNode -
+*/
+
+static void doSimplifyNode (alists_alist l, decl_node n)
+{
+ if (n == NULL)
+ {} /* empty. */
+ else if (decl_isType (n))
+ {
+ /* avoid dangling else. */
+ /* no need to simplify a type. */
+ simplifyNode (l, decl_getType (n));
+ }
+ else if (decl_isVar (n))
+ {
+ /* avoid dangling else. */
+ simplifyVar (l, n);
+ }
+ else if (decl_isRecord (n))
+ {
+ /* avoid dangling else. */
+ simplifyRecord (l, n);
+ }
+ else if (decl_isRecordField (n))
+ {
+ /* avoid dangling else. */
+ simplifyType (l, &n->recordfieldF.type);
+ }
+ else if (decl_isArray (n))
+ {
+ /* avoid dangling else. */
+ simplifyType (l, &n->arrayF.type);
+ }
+ else if (decl_isVarient (n))
+ {
+ /* avoid dangling else. */
+ simplifyVarient (l, n);
+ }
+ else if (decl_isVarientField (n))
+ {
+ /* avoid dangling else. */
+ simplifyVarientField (l, n);
+ }
+ else if (decl_isPointer (n))
+ {
+ /* avoid dangling else. */
+ simplifyType (l, &n->pointerF.type);
+ }
+}
+
+
+/*
+ simplifyNode -
+*/
+
+static void simplifyNode (alists_alist l, decl_node n)
+{
+ if (! (alists_isItemInList (l, reinterpret_cast<void *> (n))))
+ {
+ alists_includeItemIntoList (l, reinterpret_cast<void *> (n));
+ doSimplifyNode (l, n);
+ }
+}
+
+
+/*
+ doSimplify -
+*/
+
+static void doSimplify (decl_node n)
+{
+ alists_alist l;
+
+ l = alists_initList ();
+ simplifyNode (l, n);
+ alists_killList (&l);
+}
+
+
+/*
+ simplifyTypes -
+*/
+
+static void simplifyTypes (decl_scopeT s)
+{
+ do {
+ simplified = TRUE;
+ Indexing_ForeachIndiceInIndexDo (s.types, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doSimplify});
+ Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doSimplify});
+ } while (! (simplified));
+}
+
+
+/*
+ outDeclsDefC -
+*/
+
+static void outDeclsDefC (mcPretty_pretty p, decl_node n)
+{
+ decl_scopeT s;
+
+ s = n->defF.decls;
+ simplifyTypes (s);
+ includeConstType (s);
+ doP = p;
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
+ /* try and output types, constants before variables and procedures. */
+ includeDefVarProcedure (n);
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
+ Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC});
+}
+
+
+/*
+ includeConstType -
+*/
+
+static void includeConstType (decl_scopeT s)
+{
+ Indexing_ForeachIndiceInIndexDo (s.constants, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo});
+ Indexing_ForeachIndiceInIndexDo (s.types, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTypesTodo});
+}
+
+
+/*
+ includeVarProcedure -
+*/
+
+static void includeVarProcedure (decl_scopeT s)
+{
+ Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo});
+ Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addVariablesTodo});
+}
+
+
+/*
+ includeVar -
+*/
+
+static void includeVar (decl_scopeT s)
+{
+ Indexing_ForeachIndiceInIndexDo (s.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addTodo});
+}
+
+
+/*
+ includeExternals -
+*/
+
+static void includeExternals (decl_node n)
+{
+ alists_alist l;
+
+ l = alists_initList ();
+ visitNode (l, n, (decl_nodeProcedure) {(decl_nodeProcedure_t) addExported});
+ alists_killList (&l);
+}
+
+
+/*
+ checkSystemInclude -
+*/
+
+static void checkSystemInclude (decl_node n)
+{
+}
+
+
+/*
+ addExported -
+*/
+
+static void addExported (decl_node n)
+{
+ decl_node s;
+
+ s = decl_getScope (n);
+ if (((s != NULL) && (decl_isDef (s))) && (s != defModule))
+ {
+ if (((decl_isType (n)) || (decl_isVar (n))) || (decl_isConst (n)))
+ {
+ addTodo (n);
+ }
+ }
+}
+
+
+/*
+ addExternal - only adds, n, if this symbol is external to the
+ implementation module and is not a hidden type.
+*/
+
+static void addExternal (decl_node n)
+{
+ if (((((decl_getScope (n)) == defModule) && (decl_isType (n))) && (decl_isTypeHidden (n))) && (! (mcOptions_getExtendedOpaque ())))
+ {} /* empty. */
+ /* do nothing. */
+ else if (! (decl_isDef (n)))
+ {
+ /* avoid dangling else. */
+ addTodo (n);
+ }
+}
+
+
+/*
+ includeDefConstType -
+*/
+
+static void includeDefConstType (decl_node n)
+{
+ decl_node d;
+
+ if (decl_isImp (n))
+ {
+ defModule = decl_lookupDef (decl_getSymName (n));
+ if (defModule != NULL)
+ {
+ simplifyTypes (defModule->defF.decls);
+ includeConstType (defModule->defF.decls);
+ symbolKey_foreachNodeDo (defModule->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addExternal});
+ }
+ }
+}
+
+
+/*
+ runIncludeDefConstType -
+*/
+
+static void runIncludeDefConstType (decl_node n)
+{
+ decl_node d;
+
+ if (decl_isDef (n))
+ {
+ simplifyTypes (n->defF.decls);
+ includeConstType (n->defF.decls);
+ symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addExternal});
+ }
+}
+
+
+/*
+ joinProcedures - copies procedures from definition module,
+ d, into implementation module, i.
+*/
+
+static void joinProcedures (decl_node i, decl_node d)
+{
+ unsigned int h;
+ unsigned int j;
+
+ mcDebug_assert (decl_isDef (d));
+ mcDebug_assert (decl_isImp (i));
+ j = 1;
+ h = Indexing_HighIndice (d->defF.decls.procedures);
+ while (j <= h)
+ {
+ Indexing_IncludeIndiceIntoIndex (i->impF.decls.procedures, Indexing_GetIndice (d->defF.decls.procedures, j));
+ j += 1;
+ }
+}
+
+
+/*
+ includeDefVarProcedure -
+*/
+
+static void includeDefVarProcedure (decl_node n)
+{
+ decl_node d;
+
+ if (decl_isImp (n))
+ {
+ /* avoid dangling else. */
+ defModule = decl_lookupDef (decl_getSymName (n));
+ if (defModule != NULL)
+ {
+ /*
+ includeVar (defModule^.defF.decls) ;
+ simplifyTypes (defModule^.defF.decls) ;
+ */
+ joinProcedures (n, defModule);
+ }
+ }
+ else if (decl_isDef (n))
+ {
+ /* avoid dangling else. */
+ includeVar (n->defF.decls);
+ simplifyTypes (n->defF.decls);
+ }
+}
+
+
+/*
+ foreachModuleDo -
+*/
+
+static void foreachModuleDo (decl_node n, symbolKey_performOperation p)
+{
+ decl_foreachDefModuleDo (p);
+ decl_foreachModModuleDo (p);
+}
+
+
+/*
+ outDeclsImpC -
+*/
+
+static void outDeclsImpC (mcPretty_pretty p, decl_scopeT s)
+{
+ simplifyTypes (s);
+ includeConstType (s);
+ doP = p;
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
+ /* try and output types, constants before variables and procedures. */
+ includeVarProcedure (s);
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
+}
+
+
+/*
+ doStatementSequenceC -
+*/
+
+static void doStatementSequenceC (mcPretty_pretty p, decl_node s)
+{
+ unsigned int i;
+ unsigned int h;
+
+ mcDebug_assert (decl_isStatementSequence (s));
+ h = Indexing_HighIndice (s->stmtF.statements);
+ i = 1;
+ while (i <= h)
+ {
+ doStatementsC (p, reinterpret_cast<decl_node> (Indexing_GetIndice (s->stmtF.statements, i)));
+ i += 1;
+ }
+}
+
+
+/*
+ isStatementSequenceEmpty -
+*/
+
+static unsigned int isStatementSequenceEmpty (decl_node s)
+{
+ mcDebug_assert (decl_isStatementSequence (s));
+ return (Indexing_HighIndice (s->stmtF.statements)) == 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isSingleStatement - returns TRUE if the statement sequence, s, has
+ only one statement.
+*/
+
+static unsigned int isSingleStatement (decl_node s)
+{
+ unsigned int h;
+
+ mcDebug_assert (decl_isStatementSequence (s));
+ h = Indexing_HighIndice (s->stmtF.statements);
+ if ((h == 0) || (h > 1))
+ {
+ return FALSE;
+ }
+ s = static_cast<decl_node> (Indexing_GetIndice (s->stmtF.statements, 1));
+ return (! (decl_isStatementSequence (s))) || (isSingleStatement (s));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doCommentC -
+*/
+
+static void doCommentC (mcPretty_pretty p, decl_node s)
+{
+ DynamicStrings_String c;
+
+ if (s != NULL)
+ {
+ mcDebug_assert (isComment (s));
+ if (! (mcComment_isProcedureComment (s->commentF.content)))
+ {
+ if (mcComment_isAfterComment (s->commentF.content))
+ {
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) " /* ", 4);
+ }
+ else
+ {
+ outText (p, (const char *) "/* ", 3);
+ }
+ c = mcComment_getContent (s->commentF.content);
+ c = DynamicStrings_RemoveWhitePrefix (DynamicStrings_RemoveWhitePostfix (c));
+ outTextS (p, c);
+ outText (p, (const char *) " */\\n", 6);
+ }
+ }
+}
+
+
+/*
+ doAfterCommentC - emit an after comment, c, or a newline if, c, is empty.
+*/
+
+static void doAfterCommentC (mcPretty_pretty p, decl_node c)
+{
+ if (c == NULL)
+ {
+ outText (p, (const char *) "\\n", 2);
+ }
+ else
+ {
+ doCommentC (p, c);
+ }
+}
+
+
+/*
+ doReturnC - issue a return statement and also place in an after comment if one exists.
+*/
+
+static void doReturnC (mcPretty_pretty p, decl_node s)
+{
+ mcDebug_assert (decl_isReturn (s));
+ doCommentC (p, s->returnF.returnComment.body);
+ outText (p, (const char *) "return", 6);
+ if (s->returnF.scope != NULL)
+ {
+ mcPretty_setNeedSpace (p);
+ if ((! (decl_isProcedure (s->returnF.scope))) || ((decl_getType (s->returnF.scope)) == NULL))
+ {
+ mcMetaError_metaError1 ((const char *) "{%1DMad} has no return type", 27, (const unsigned char *) &s->returnF.scope, (sizeof (s->returnF.scope)-1));
+ }
+ else
+ {
+ doExprCastC (p, s->returnF.exp, decl_getType (s->returnF.scope));
+ }
+ }
+ outText (p, (const char *) ";", 1);
+ doAfterCommentC (p, s->returnF.returnComment.after);
+}
+
+
+/*
+ isZtypeEquivalent -
+*/
+
+static unsigned int isZtypeEquivalent (decl_node type)
+{
+ switch (type->kind)
+ {
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_ztype:
+ return TRUE;
+ break;
+
+
+ default:
+ return FALSE;
+ break;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isEquivalentType - returns TRUE if type1 and type2 are equivalent.
+*/
+
+static unsigned int isEquivalentType (decl_node type1, decl_node type2)
+{
+ type1 = decl_skipType (type1);
+ type2 = decl_skipType (type2);
+ return (type1 == type2) || ((isZtypeEquivalent (type1)) && (isZtypeEquivalent (type2)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doExprCastC - build a cast if necessary.
+*/
+
+static void doExprCastC (mcPretty_pretty p, decl_node e, decl_node type)
+{
+ decl_node stype;
+
+ stype = decl_skipType (type);
+ if ((! (isEquivalentType (type, getExprType (e)))) && (! ((e->kind == decl_nil) && ((decl_isPointer (stype)) || (stype->kind == decl_address)))))
+ {
+ if (lang == decl_ansiCP)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* potentially a cast is required. */
+ if ((decl_isPointer (type)) || (type == addressN))
+ {
+ outText (p, (const char *) "reinterpret_cast<", 17);
+ doTypeNameC (p, type);
+ mcPretty_noSpace (p);
+ outText (p, (const char *) "> (", 3);
+ doExprC (p, e);
+ outText (p, (const char *) ")", 1);
+ return ;
+ }
+ else
+ {
+ outText (p, (const char *) "static_cast<", 12);
+ if (decl_isProcType (decl_skipType (type)))
+ {
+ doTypeNameC (p, type);
+ outText (p, (const char *) "_t", 2);
+ }
+ else
+ {
+ doTypeNameC (p, type);
+ }
+ mcPretty_noSpace (p);
+ outText (p, (const char *) "> (", 3);
+ doExprC (p, e);
+ outText (p, (const char *) ")", 1);
+ return ;
+ }
+ }
+ }
+ doExprC (p, e);
+}
+
+
+/*
+ requiresUnpackProc - returns TRUE if either the expr is a procedure or the proctypes differ.
+*/
+
+static unsigned int requiresUnpackProc (decl_node s)
+{
+ mcDebug_assert (isAssignment (s));
+ return (decl_isProcedure (s->assignmentF.expr)) || ((decl_skipType (decl_getType (s->assignmentF.des))) != (decl_skipType (decl_getType (s->assignmentF.expr))));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doAssignmentC -
+*/
+
+static void doAssignmentC (mcPretty_pretty p, decl_node s)
+{
+ mcDebug_assert (isAssignment (s));
+ doCommentC (p, s->assignmentF.assignComment.body);
+ doExprCup (p, s->assignmentF.des, requiresUnpackProc (s));
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "=", 1);
+ mcPretty_setNeedSpace (p);
+ doExprCastC (p, s->assignmentF.expr, decl_getType (s->assignmentF.des));
+ outText (p, (const char *) ";", 1);
+ doAfterCommentC (p, s->assignmentF.assignComment.after);
+}
+
+
+/*
+ containsStatement -
+*/
+
+static unsigned int containsStatement (decl_node s)
+{
+ return ((s != NULL) && (decl_isStatementSequence (s))) && (! (isStatementSequenceEmpty (s)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doCompoundStmt -
+*/
+
+static void doCompoundStmt (mcPretty_pretty p, decl_node s)
+{
+ if ((s == NULL) || ((decl_isStatementSequence (s)) && (isStatementSequenceEmpty (s))))
+ {
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ outText (p, (const char *) "{} /* empty. */\\n", 19);
+ p = mcPretty_popPretty (p);
+ }
+ else if (((decl_isStatementSequence (s)) && (isSingleStatement (s))) && ! forceCompoundStatement)
+ {
+ /* avoid dangling else. */
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ doStatementSequenceC (p, s);
+ p = mcPretty_popPretty (p);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ outText (p, (const char *) "{\\n", 3);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ doStatementSequenceC (p, s);
+ p = mcPretty_popPretty (p);
+ outText (p, (const char *) "}\\n", 3);
+ p = mcPretty_popPretty (p);
+ }
+}
+
+
+/*
+ doElsifC -
+*/
+
+static void doElsifC (mcPretty_pretty p, decl_node s)
+{
+ mcDebug_assert (decl_isElsif (s));
+ outText (p, (const char *) "else if", 7);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, s->elsifF.expr);
+ outText (p, (const char *) ")\\n", 3);
+ mcDebug_assert ((s->elsifF.else_ == NULL) || (s->elsifF.elsif == NULL));
+ if (forceCompoundStatement || ((hasIfAndNoElse (s->elsifF.then)) && ((s->elsifF.else_ != NULL) || (s->elsifF.elsif != NULL))))
+ {
+ /* avoid dangling else. */
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ outText (p, (const char *) "{\\n", 3);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ outText (p, (const char *) "/* avoid dangling else. */\\n", 29);
+ doStatementSequenceC (p, s->elsifF.then);
+ p = mcPretty_popPretty (p);
+ outText (p, (const char *) "}\\n", 3);
+ p = mcPretty_popPretty (p);
+ }
+ else
+ {
+ doCompoundStmt (p, s->elsifF.then);
+ }
+ if (containsStatement (s->elsifF.else_))
+ {
+ outText (p, (const char *) "else\\n", 6);
+ if (forceCompoundStatement)
+ {
+ /* avoid dangling else. */
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ outText (p, (const char *) "{\\n", 3);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ outText (p, (const char *) "/* avoid dangling else. */\\n", 29);
+ doStatementSequenceC (p, s->elsifF.else_);
+ p = mcPretty_popPretty (p);
+ outText (p, (const char *) "}\\n", 3);
+ p = mcPretty_popPretty (p);
+ }
+ else
+ {
+ doCompoundStmt (p, s->elsifF.else_);
+ }
+ }
+ else if ((s->elsifF.elsif != NULL) && (decl_isElsif (s->elsifF.elsif)))
+ {
+ /* avoid dangling else. */
+ doElsifC (p, s->elsifF.elsif);
+ }
+}
+
+
+/*
+ noIfElse -
+*/
+
+static unsigned int noIfElse (decl_node n)
+{
+ return (((n != NULL) && (decl_isIf (n))) && (n->ifF.else_ == NULL)) && (n->ifF.elsif == NULL);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ noIfElseChained - returns TRUE if, n, is an IF statement which
+ has no associated ELSE statement. An IF with an
+ ELSIF is also checked for no ELSE and will result
+ in a return value of TRUE.
+*/
+
+static unsigned int noIfElseChained (decl_node n)
+{
+ decl_node e;
+
+ if (n != NULL)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (decl_isIf (n))
+ {
+ if (n->ifF.else_ != NULL)
+ {
+ /* we do have an else, continue to check this statement. */
+ return hasIfAndNoElse (n->ifF.else_);
+ }
+ else if (n->ifF.elsif == NULL)
+ {
+ /* avoid dangling else. */
+ /* neither else or elsif. */
+ return TRUE;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ /* test elsif for lack of else. */
+ e = n->ifF.elsif;
+ mcDebug_assert (decl_isElsif (e));
+ return noIfElseChained (e);
+ }
+ }
+ else if (decl_isElsif (n))
+ {
+ /* avoid dangling else. */
+ if (n->elsifF.else_ != NULL)
+ {
+ /* we do have an else, continue to check this statement. */
+ return hasIfAndNoElse (n->elsifF.else_);
+ }
+ else if (n->elsifF.elsif == NULL)
+ {
+ /* avoid dangling else. */
+ /* neither else or elsif. */
+ return TRUE;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ /* test elsif for lack of else. */
+ e = n->elsifF.elsif;
+ mcDebug_assert (decl_isElsif (e));
+ return noIfElseChained (e);
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ hasIfElse -
+*/
+
+static unsigned int hasIfElse (decl_node n)
+{
+ if (n != NULL)
+ {
+ if (decl_isStatementSequence (n))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (isStatementSequenceEmpty (n))
+ {
+ return FALSE;
+ }
+ else if (isSingleStatement (n))
+ {
+ /* avoid dangling else. */
+ n = static_cast<decl_node> (Indexing_GetIndice (n->stmtF.statements, 1));
+ return isIfElse (n);
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isIfElse -
+*/
+
+static unsigned int isIfElse (decl_node n)
+{
+ return ((n != NULL) && (decl_isIf (n))) && ((n->ifF.else_ != NULL) || (n->ifF.elsif != NULL));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ hasIfAndNoElse - returns TRUE if statement, n, is a single statement
+ which is an IF and it has no else statement.
+*/
+
+static unsigned int hasIfAndNoElse (decl_node n)
+{
+ if (n != NULL)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (decl_isStatementSequence (n))
+ {
+ if (isStatementSequenceEmpty (n))
+ {
+ return FALSE;
+ }
+ else if (isSingleStatement (n))
+ {
+ /* avoid dangling else. */
+ n = static_cast<decl_node> (Indexing_GetIndice (n->stmtF.statements, 1));
+ return hasIfAndNoElse (n);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ n = static_cast<decl_node> (Indexing_GetIndice (n->stmtF.statements, Indexing_HighIndice (n->stmtF.statements)));
+ return hasIfAndNoElse (n);
+ }
+ }
+ else if ((decl_isElsif (n)) || (decl_isIf (n)))
+ {
+ /* avoid dangling else. */
+ return noIfElseChained (n);
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doIfC - issue an if statement and also place in an after comment if one exists.
+ The if statement might contain an else or elsif which are also handled.
+*/
+
+static void doIfC (mcPretty_pretty p, decl_node s)
+{
+ mcDebug_assert (decl_isIf (s));
+ doCommentC (p, s->ifF.ifComment.body);
+ outText (p, (const char *) "if", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, s->ifF.expr);
+ outText (p, (const char *) ")", 1);
+ doAfterCommentC (p, s->ifF.ifComment.after);
+ if ((hasIfAndNoElse (s->ifF.then)) && ((s->ifF.else_ != NULL) || (s->ifF.elsif != NULL)))
+ {
+ /* avoid dangling else. */
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ outText (p, (const char *) "{\\n", 3);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ outText (p, (const char *) "/* avoid dangling else. */\\n", 29);
+ doStatementSequenceC (p, s->ifF.then);
+ p = mcPretty_popPretty (p);
+ outText (p, (const char *) "}\\n", 3);
+ p = mcPretty_popPretty (p);
+ }
+ else if ((noIfElse (s)) && (hasIfElse (s->ifF.then)))
+ {
+ /* avoid dangling else. */
+ /* gcc does not like legal non dangling else, as it is poor style.
+ So we will avoid getting a warning. */
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ outText (p, (const char *) "{\\n", 3);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ outText (p, (const char *) "/* avoid gcc warning by using compound statement even if not strictly necessary. */\\n", 86);
+ doStatementSequenceC (p, s->ifF.then);
+ p = mcPretty_popPretty (p);
+ outText (p, (const char *) "}\\n", 3);
+ p = mcPretty_popPretty (p);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ doCompoundStmt (p, s->ifF.then);
+ }
+ mcDebug_assert ((s->ifF.else_ == NULL) || (s->ifF.elsif == NULL));
+ if (containsStatement (s->ifF.else_))
+ {
+ doCommentC (p, s->ifF.elseComment.body);
+ outText (p, (const char *) "else", 4);
+ doAfterCommentC (p, s->ifF.elseComment.after);
+ doCompoundStmt (p, s->ifF.else_);
+ }
+ else if ((s->ifF.elsif != NULL) && (decl_isElsif (s->ifF.elsif)))
+ {
+ /* avoid dangling else. */
+ doCommentC (p, s->ifF.elseComment.body);
+ doCommentC (p, s->ifF.elseComment.after);
+ doElsifC (p, s->ifF.elsif);
+ }
+ doCommentC (p, s->ifF.endComment.after);
+ doCommentC (p, s->ifF.endComment.body);
+}
+
+
+/*
+ doForIncCP -
+*/
+
+static void doForIncCP (mcPretty_pretty p, decl_node s)
+{
+ decl_node t;
+
+ mcDebug_assert (decl_isFor (s));
+ t = decl_skipType (decl_getType (s->forF.des));
+ if (decl_isEnumeration (t))
+ {
+ if (s->forF.increment == NULL)
+ {
+ doExprC (p, s->forF.des);
+ outText (p, (const char *) "= static_cast<", 14);
+ doTypeNameC (p, decl_getType (s->forF.des));
+ mcPretty_noSpace (p);
+ outText (p, (const char *) ">(static_cast<int>(", 19);
+ doExprC (p, s->forF.des);
+ outText (p, (const char *) "+1))", 4);
+ }
+ else
+ {
+ doExprC (p, s->forF.des);
+ outText (p, (const char *) "= static_cast<", 14);
+ doTypeNameC (p, decl_getType (s->forF.des));
+ mcPretty_noSpace (p);
+ outText (p, (const char *) ">(static_cast<int>(", 19);
+ doExprC (p, s->forF.des);
+ outText (p, (const char *) "+", 1);
+ doExprC (p, s->forF.increment);
+ outText (p, (const char *) "))", 2);
+ }
+ }
+ else
+ {
+ doForIncC (p, s);
+ }
+}
+
+
+/*
+ doForIncC -
+*/
+
+static void doForIncC (mcPretty_pretty p, decl_node s)
+{
+ if (s->forF.increment == NULL)
+ {
+ doExprC (p, s->forF.des);
+ outText (p, (const char *) "++", 2);
+ }
+ else
+ {
+ doExprC (p, s->forF.des);
+ outText (p, (const char *) "=", 1);
+ doExprC (p, s->forF.des);
+ outText (p, (const char *) "+", 1);
+ doExprC (p, s->forF.increment);
+ }
+}
+
+
+/*
+ doForInc -
+*/
+
+static void doForInc (mcPretty_pretty p, decl_node s)
+{
+ if (lang == decl_ansiCP)
+ {
+ doForIncCP (p, s);
+ }
+ else
+ {
+ doForIncC (p, s);
+ }
+}
+
+
+/*
+ doForC -
+*/
+
+static void doForC (mcPretty_pretty p, decl_node s)
+{
+ mcDebug_assert (decl_isFor (s));
+ outText (p, (const char *) "for (", 5);
+ doExprC (p, s->forF.des);
+ outText (p, (const char *) "=", 1);
+ doExprC (p, s->forF.start);
+ outText (p, (const char *) ";", 1);
+ mcPretty_setNeedSpace (p);
+ doExprC (p, s->forF.des);
+ outText (p, (const char *) "<=", 2);
+ doExprC (p, s->forF.end);
+ outText (p, (const char *) ";", 1);
+ mcPretty_setNeedSpace (p);
+ doForInc (p, s);
+ outText (p, (const char *) ")\\n", 3);
+ doCompoundStmt (p, s->forF.statements);
+}
+
+
+/*
+ doRepeatC -
+*/
+
+static void doRepeatC (mcPretty_pretty p, decl_node s)
+{
+ mcDebug_assert (decl_isRepeat (s));
+ doCommentC (p, s->repeatF.repeatComment.body);
+ outText (p, (const char *) "do {", 4);
+ doAfterCommentC (p, s->repeatF.repeatComment.after);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ doStatementSequenceC (p, s->repeatF.statements);
+ doCommentC (p, s->repeatF.untilComment.body);
+ p = mcPretty_popPretty (p);
+ outText (p, (const char *) "} while (! (", 12);
+ doExprC (p, s->repeatF.expr);
+ outText (p, (const char *) "));", 3);
+ doAfterCommentC (p, s->repeatF.untilComment.after);
+}
+
+
+/*
+ doWhileC -
+*/
+
+static void doWhileC (mcPretty_pretty p, decl_node s)
+{
+ mcDebug_assert (decl_isWhile (s));
+ doCommentC (p, s->whileF.doComment.body);
+ outText (p, (const char *) "while (", 7);
+ doExprC (p, s->whileF.expr);
+ outText (p, (const char *) ")", 1);
+ doAfterCommentC (p, s->whileF.doComment.after);
+ doCompoundStmt (p, s->whileF.statements);
+ doCommentC (p, s->whileF.endComment.body);
+ doCommentC (p, s->whileF.endComment.after);
+}
+
+
+/*
+ doFuncHighC -
+*/
+
+static void doFuncHighC (mcPretty_pretty p, decl_node a)
+{
+ decl_node s;
+ decl_node n;
+
+ if ((decl_isLiteral (a)) && ((decl_getType (a)) == charN))
+ {
+ outCard (p, 0);
+ }
+ else if (isString (a))
+ {
+ /* avoid dangling else. */
+ outCard (p, a->stringF.length-2);
+ }
+ else if ((decl_isConst (a)) && (isString (a->constF.value)))
+ {
+ /* avoid dangling else. */
+ doFuncHighC (p, a->constF.value);
+ }
+ else if (decl_isUnbounded (decl_getType (a)))
+ {
+ /* avoid dangling else. */
+ outText (p, (const char *) "_", 1);
+ outTextN (p, decl_getSymName (a));
+ outText (p, (const char *) "_high", 5);
+ }
+ else if (decl_isArray (decl_skipType (decl_getType (a))))
+ {
+ /* avoid dangling else. */
+ n = decl_skipType (decl_getType (a));
+ s = n->arrayF.subr;
+ if (isZero (getMin (s)))
+ {
+ doExprC (p, getMax (s));
+ }
+ else
+ {
+ outText (p, (const char *) "(", 1);
+ doExprC (p, getMax (s));
+ doSubtractC (p, getMin (s));
+ outText (p, (const char *) ")", 1);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ /* output sizeof (a) in bytes for the high. */
+ outText (p, (const char *) "(sizeof", 7);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, a);
+ outText (p, (const char *) ")-1)", 4);
+ }
+}
+
+
+/*
+ doMultiplyBySize -
+*/
+
+static void doMultiplyBySize (mcPretty_pretty p, decl_node a)
+{
+ if (((a != charN) && (a != byteN)) && (a != locN))
+ {
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "* sizeof (", 10);
+ doTypeNameC (p, a);
+ mcPretty_noSpace (p);
+ outText (p, (const char *) ")", 1);
+ }
+}
+
+
+/*
+ doTotype -
+*/
+
+static void doTotype (mcPretty_pretty p, decl_node a, decl_node t)
+{
+ if ((! (isString (a))) && (! (decl_isLiteral (a))))
+ {
+ if (decl_isVar (a))
+ {
+ if (((a->varF.isParameter || a->varF.isVarParameter) && (decl_isUnbounded (decl_getType (a)))) && ((decl_skipType (decl_getType (decl_getType (a)))) == (decl_skipType (decl_getType (t)))))
+ {
+ /* do not multiply by size as the existing high value is correct. */
+ return ;
+ }
+ a = decl_getType (a);
+ if (decl_isArray (a))
+ {
+ doMultiplyBySize (p, decl_skipType (decl_getType (a)));
+ }
+ }
+ }
+ if (t == wordN)
+ {
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "/ sizeof (", 10);
+ doTypeNameC (p, wordN);
+ mcPretty_noSpace (p);
+ outText (p, (const char *) ")", 1);
+ }
+}
+
+
+/*
+ doFuncUnbounded -
+*/
+
+static void doFuncUnbounded (mcPretty_pretty p, decl_node actual, decl_node formalParam, decl_node formal, decl_node func)
+{
+ decl_node h;
+ DynamicStrings_String s;
+
+ mcDebug_assert (decl_isUnbounded (formal));
+ outText (p, (const char *) "(", 1);
+ if ((lang == decl_ansiCP) && (decl_isParam (formalParam)))
+ {
+ outText (p, (const char *) "const", 5);
+ mcPretty_setNeedSpace (p);
+ }
+ doTypeC (p, decl_getType (formal), &formal);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "*)", 2);
+ mcPretty_setNeedSpace (p);
+ if ((decl_isLiteral (actual)) && ((decl_getType (actual)) == charN))
+ {
+ outText (p, (const char *) "\"\\0", 3);
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (actual->literalF.name));
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, -1);
+ outTextS (p, s);
+ outText (p, (const char *) "\"", 1);
+ s = DynamicStrings_KillString (s);
+ }
+ else if (isString (actual))
+ {
+ /* avoid dangling else. */
+ outCstring (p, actual, TRUE);
+ }
+ else if (decl_isConst (actual))
+ {
+ /* avoid dangling else. */
+ actual = resolveString (actual);
+ mcDebug_assert (isString (actual));
+ outCstring (p, actual, TRUE);
+ }
+ else if (isFuncCall (actual))
+ {
+ /* avoid dangling else. */
+ if ((getExprType (actual)) == NULL)
+ {
+ mcMetaError_metaError3 ((const char *) "there is no return type to the procedure function {%3ad} which is being passed as the parameter {%1ad} to {%2ad}", 112, (const unsigned char *) &formal, (sizeof (formal)-1), (const unsigned char *) &func, (sizeof (func)-1), (const unsigned char *) &actual, (sizeof (actual)-1));
+ }
+ else
+ {
+ outText (p, (const char *) "&", 1);
+ doExprC (p, actual);
+ }
+ }
+ else if (decl_isUnbounded (decl_getType (actual)))
+ {
+ /* avoid dangling else. */
+ /* doExprC (p, actual). */
+ doFQNameC (p, actual);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ outText (p, (const char *) "&", 1);
+ doExprC (p, actual);
+ if (decl_isArray (decl_skipType (decl_getType (actual))))
+ {
+ outText (p, (const char *) ".array[0]", 9);
+ }
+ }
+ if (! (enableDefForCStrings && (isDefForC (decl_getScope (func)))))
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ doFuncHighC (p, actual);
+ doTotype (p, actual, formal);
+ }
+}
+
+
+/*
+ doProcedureParamC -
+*/
+
+static void doProcedureParamC (mcPretty_pretty p, decl_node actual, decl_node formal)
+{
+ if (isForC (formal))
+ {
+ outText (p, (const char *) "(", 1);
+ doFQNameC (p, decl_getType (formal));
+ outText (p, (const char *) "_C", 2);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ doExprC (p, actual);
+ }
+ else
+ {
+ outText (p, (const char *) "(", 1);
+ doTypeNameC (p, decl_getType (formal));
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "{", 1);
+ outText (p, (const char *) "(", 1);
+ doFQNameC (p, decl_getType (formal));
+ outText (p, (const char *) "_t)", 3);
+ mcPretty_setNeedSpace (p);
+ doExprC (p, actual);
+ outText (p, (const char *) "}", 1);
+ }
+}
+
+
+/*
+ doAdrExprC -
+*/
+
+static void doAdrExprC (mcPretty_pretty p, decl_node n)
+{
+ if (isDeref (n))
+ {
+ /* no point in issuing & ( * n ) */
+ doExprC (p, n->unaryF.arg);
+ }
+ else if ((decl_isVar (n)) && n->varF.isVarParameter)
+ {
+ /* avoid dangling else. */
+ /* no point in issuing & ( * n ) */
+ doFQNameC (p, n);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ outText (p, (const char *) "&", 1);
+ doExprC (p, n);
+ }
+}
+
+
+/*
+ typePair -
+*/
+
+static unsigned int typePair (decl_node a, decl_node b, decl_node x, decl_node y)
+{
+ return ((a == x) && (b == y)) || ((a == y) && (b == x));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ needsCast - return TRUE if the actual type parameter needs to be cast to
+ the formal type.
+*/
+
+static unsigned int needsCast (decl_node at, decl_node ft)
+{
+ at = decl_skipType (at);
+ ft = decl_skipType (ft);
+ if (((((((((((((at == nilN) || (at->kind == decl_nil)) || (at == ft)) || (typePair (at, ft, cardinalN, wordN))) || (typePair (at, ft, cardinalN, ztypeN))) || (typePair (at, ft, integerN, ztypeN))) || (typePair (at, ft, longcardN, ztypeN))) || (typePair (at, ft, shortcardN, ztypeN))) || (typePair (at, ft, longintN, ztypeN))) || (typePair (at, ft, shortintN, ztypeN))) || (typePair (at, ft, realN, rtypeN))) || (typePair (at, ft, longrealN, rtypeN))) || (typePair (at, ft, shortrealN, rtypeN)))
+ {
+ return FALSE;
+ }
+ else
+ {
+ return TRUE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ checkSystemCast - checks to see if we are passing to/from
+ a system generic type (WORD, BYTE, ADDRESS)
+ and if so emit a cast. It returns the number of
+ open parenthesis.
+*/
+
+static unsigned int checkSystemCast (mcPretty_pretty p, decl_node actual, decl_node formal)
+{
+ decl_node at;
+ decl_node ft;
+
+ at = getExprType (actual);
+ ft = decl_getType (formal);
+ if (needsCast (at, ft))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (lang == decl_ansiCP)
+ {
+ if ((isString (actual)) && ((decl_skipType (ft)) == addressN))
+ {
+ outText (p, (const char *) "const_cast<void*> (reinterpret_cast<const void*> (", 50);
+ return 2;
+ }
+ else if ((decl_isPointer (decl_skipType (ft))) || ((decl_skipType (ft)) == addressN))
+ {
+ /* avoid dangling else. */
+ if (actual == nilN)
+ {
+ if (decl_isVarParam (formal))
+ {
+ mcMetaError_metaError1 ((const char *) "NIL is being passed to a VAR parameter {%1DMad}", 47, (const unsigned char *) &formal, (sizeof (formal)-1));
+ }
+ /* NULL is compatible with pointers/address. */
+ return 0;
+ }
+ else
+ {
+ outText (p, (const char *) "reinterpret_cast<", 17);
+ doTypeNameC (p, ft);
+ if (decl_isVarParam (formal))
+ {
+ outText (p, (const char *) "*", 1);
+ }
+ mcPretty_noSpace (p);
+ outText (p, (const char *) "> (", 3);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ outText (p, (const char *) "static_cast<", 12);
+ doTypeNameC (p, ft);
+ if (decl_isVarParam (formal))
+ {
+ outText (p, (const char *) "*", 1);
+ }
+ mcPretty_noSpace (p);
+ outText (p, (const char *) "> (", 3);
+ }
+ return 1;
+ }
+ else
+ {
+ outText (p, (const char *) "(", 1);
+ doTypeNameC (p, ft);
+ if (decl_isVarParam (formal))
+ {
+ outText (p, (const char *) "*", 1);
+ }
+ mcPretty_noSpace (p);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ emitN -
+*/
+
+static void emitN (mcPretty_pretty p, const char *a_, unsigned int _a_high, unsigned int n)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ while (n > 0)
+ {
+ outText (p, (const char *) a, _a_high);
+ n -= 1;
+ }
+}
+
+
+/*
+ isForC - return true if node n is a varparam, param or procedure
+ which was declared inside a definition module for "C".
+*/
+
+static unsigned int isForC (decl_node n)
+{
+ if (decl_isVarParam (n))
+ {
+ return n->varparamF.isForC;
+ }
+ else if (decl_isParam (n))
+ {
+ /* avoid dangling else. */
+ return n->paramF.isForC;
+ }
+ else if (decl_isProcedure (n))
+ {
+ /* avoid dangling else. */
+ return n->procedureF.isForC;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isDefForCNode - return TRUE if node n was declared inside a definition module for "C".
+*/
+
+static unsigned int isDefForCNode (decl_node n)
+{
+ nameKey_Name name;
+
+ while ((n != NULL) && (! (((decl_isImp (n)) || (decl_isDef (n))) || (decl_isModule (n)))))
+ {
+ n = decl_getScope (n);
+ }
+ if ((n != NULL) && (decl_isImp (n)))
+ {
+ name = decl_getSymName (n);
+ n = decl_lookupDef (name);
+ }
+ return ((n != NULL) && (decl_isDef (n))) && (isDefForC (n));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doFuncParamC -
+*/
+
+static void doFuncParamC (mcPretty_pretty p, decl_node actual, decl_node formal, decl_node func)
+{
+ decl_node ft;
+ decl_node at;
+ unsigned int lbr;
+
+ if (formal == NULL)
+ {
+ doExprC (p, actual);
+ }
+ else
+ {
+ ft = decl_skipType (decl_getType (formal));
+ if (decl_isUnbounded (ft))
+ {
+ doFuncUnbounded (p, actual, formal, ft, func);
+ }
+ else
+ {
+ if ((isAProcType (ft)) && (decl_isProcedure (actual)))
+ {
+ if (decl_isVarParam (formal))
+ {
+ mcMetaError_metaError1 ((const char *) "{%1MDad} cannot be passed as a VAR parameter", 44, (const unsigned char *) &actual, (sizeof (actual)-1));
+ }
+ else
+ {
+ doProcedureParamC (p, actual, formal);
+ }
+ }
+ else if (((((decl_getType (actual)) != NULL) && (decl_isProcType (decl_skipType (decl_getType (actual))))) && (isAProcType (ft))) && (isForC (formal)))
+ {
+ /* avoid dangling else. */
+ if (decl_isVarParam (formal))
+ {
+ mcMetaError_metaError2 ((const char *) "{%1MDad} cannot be passed as a VAR parameter to the definition for C module as the parameter requires a cast to the formal type {%2MDtad}", 137, (const unsigned char *) &actual, (sizeof (actual)-1), (const unsigned char *) &formal, (sizeof (formal)-1));
+ }
+ else
+ {
+ outText (p, (const char *) "(", 1);
+ doFQNameC (p, decl_getType (formal));
+ outText (p, (const char *) "_C", 2);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ doExprC (p, actual);
+ outText (p, (const char *) ".proc", 5);
+ }
+ }
+ else if ((((decl_getType (actual)) != NULL) && (decl_isProcType (decl_skipType (decl_getType (actual))))) && ((decl_getType (actual)) != (decl_getType (formal))))
+ {
+ /* avoid dangling else. */
+ if (decl_isVarParam (formal))
+ {
+ mcMetaError_metaError2 ((const char *) "{%1MDad} cannot be passed as a VAR parameter as the parameter requires a cast to the formal type {%2MDtad}", 106, (const unsigned char *) &actual, (sizeof (actual)-1), (const unsigned char *) &formal, (sizeof (formal)-1));
+ }
+ else
+ {
+ doCastC (p, decl_getType (formal), actual);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ lbr = checkSystemCast (p, actual, formal);
+ if (decl_isVarParam (formal))
+ {
+ doAdrExprC (p, actual);
+ }
+ else
+ {
+ doExprC (p, actual);
+ }
+ emitN (p, (const char *) ")", 1, lbr);
+ }
+ }
+ }
+}
+
+
+/*
+ getNthParamType - return the type of parameter, i, in list, l.
+ If the parameter is a vararg NIL is returned.
+*/
+
+static decl_node getNthParamType (Indexing_Index l, unsigned int i)
+{
+ decl_node p;
+
+ p = getNthParam (l, i);
+ if (p != NULL)
+ {
+ return decl_getType (p);
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getNthParam - return the parameter, i, in list, l.
+ If the parameter is a vararg NIL is returned.
+*/
+
+static decl_node getNthParam (Indexing_Index l, unsigned int i)
+{
+ decl_node p;
+ unsigned int j;
+ unsigned int k;
+ unsigned int h;
+
+ if (l != NULL)
+ {
+ j = Indexing_LowIndice (l);
+ h = Indexing_HighIndice (l);
+ while (j <= h)
+ {
+ p = static_cast<decl_node> (Indexing_GetIndice (l, j));
+ if (decl_isParam (p))
+ {
+ k = identListLen (p->paramF.namelist);
+ }
+ else if (decl_isVarParam (p))
+ {
+ /* avoid dangling else. */
+ k = identListLen (p->varparamF.namelist);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ mcDebug_assert (decl_isVarargs (p));
+ return NULL;
+ }
+ if (i <= k)
+ {
+ return p;
+ }
+ else
+ {
+ i -= k;
+ j += 1;
+ }
+ }
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doFuncArgsC -
+*/
+
+static void doFuncArgsC (mcPretty_pretty p, decl_node s, Indexing_Index l, unsigned int needParen)
+{
+ decl_node actual;
+ decl_node formal;
+ unsigned int i;
+ unsigned int n;
+
+ if (needParen)
+ {
+ outText (p, (const char *) "(", 1);
+ }
+ if (s->funccallF.args != NULL)
+ {
+ i = 1;
+ n = expListLen (s->funccallF.args);
+ while (i <= n)
+ {
+ actual = getExpList (s->funccallF.args, i);
+ formal = getNthParam (l, i);
+ doFuncParamC (p, actual, formal, s->funccallF.function);
+ if (i < n)
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ i += 1;
+ }
+ }
+ if (needParen)
+ {
+ mcPretty_noSpace (p);
+ outText (p, (const char *) ")", 1);
+ }
+}
+
+
+/*
+ doProcTypeArgsC -
+*/
+
+static void doProcTypeArgsC (mcPretty_pretty p, decl_node s, Indexing_Index args, unsigned int needParen)
+{
+ decl_node a;
+ decl_node b;
+ unsigned int i;
+ unsigned int n;
+
+ if (needParen)
+ {
+ outText (p, (const char *) "(", 1);
+ }
+ if (s->funccallF.args != NULL)
+ {
+ i = 1;
+ n = expListLen (s->funccallF.args);
+ while (i <= n)
+ {
+ a = getExpList (s->funccallF.args, i);
+ b = static_cast<decl_node> (Indexing_GetIndice (args, i));
+ doFuncParamC (p, a, b, s->funccallF.function);
+ if (i < n)
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ i += 1;
+ }
+ }
+ if (needParen)
+ {
+ mcPretty_noSpace (p);
+ outText (p, (const char *) ")", 1);
+ }
+}
+
+
+/*
+ doAdrArgC -
+*/
+
+static void doAdrArgC (mcPretty_pretty p, decl_node n)
+{
+ if (isDeref (n))
+ {
+ /* & and * cancel each other out. */
+ doExprC (p, n->unaryF.arg);
+ }
+ else if ((decl_isVar (n)) && n->varF.isVarParameter)
+ {
+ /* avoid dangling else. */
+ outTextN (p, decl_getSymName (n)); /* --fixme-- does the caller need to cast it? */
+ }
+ else
+ {
+ /* avoid dangling else. */
+ if (isString (n))
+ {
+ if (lang == decl_ansiCP)
+ {
+ outText (p, (const char *) "const_cast<void*> (reinterpret_cast<const void*>", 48);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, n);
+ outText (p, (const char *) "))", 2);
+ }
+ else
+ {
+ doExprC (p, n);
+ }
+ }
+ else
+ {
+ outText (p, (const char *) "&", 1);
+ doExprC (p, n);
+ }
+ }
+}
+
+
+/*
+ doAdrC -
+*/
+
+static void doAdrC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (isUnary (n));
+ doAdrArgC (p, n->unaryF.arg);
+}
+
+
+/*
+ doInc -
+*/
+
+static void doInc (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (isIntrinsic (n));
+ if (lang == decl_ansiCP)
+ {
+ doIncDecCP (p, n, (const char *) "+", 1);
+ }
+ else
+ {
+ doIncDecC (p, n, (const char *) "+=", 2);
+ }
+}
+
+
+/*
+ doDec -
+*/
+
+static void doDec (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (isIntrinsic (n));
+ if (lang == decl_ansiCP)
+ {
+ doIncDecCP (p, n, (const char *) "-", 1);
+ }
+ else
+ {
+ doIncDecC (p, n, (const char *) "-=", 2);
+ }
+}
+
+
+/*
+ doIncDecC -
+*/
+
+static void doIncDecC (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high)
+{
+ char op[_op_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (op, op_, _op_high+1);
+
+ mcDebug_assert (isIntrinsic (n));
+ if (n->intrinsicF.args != NULL)
+ {
+ doExprC (p, getExpList (n->intrinsicF.args, 1));
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) op, _op_high);
+ mcPretty_setNeedSpace (p);
+ if ((expListLen (n->intrinsicF.args)) == 1)
+ {
+ outText (p, (const char *) "1", 1);
+ }
+ else
+ {
+ doExprC (p, getExpList (n->intrinsicF.args, 2));
+ }
+ }
+}
+
+
+/*
+ doIncDecCP -
+*/
+
+static void doIncDecCP (mcPretty_pretty p, decl_node n, const char *op_, unsigned int _op_high)
+{
+ decl_node lhs;
+ decl_node type;
+ char op[_op_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (op, op_, _op_high+1);
+
+ mcDebug_assert (isIntrinsic (n));
+ if (n->intrinsicF.args != NULL)
+ {
+ lhs = getExpList (n->intrinsicF.args, 1);
+ doExprC (p, lhs);
+ mcPretty_setNeedSpace (p);
+ type = decl_getType (lhs);
+ if ((decl_isPointer (type)) || (type == addressN))
+ {
+ /* cast to (char * ) and then back again after the arithmetic is complete. */
+ outText (p, (const char *) "=", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "reinterpret_cast<", 17);
+ doTypeNameC (p, type);
+ mcPretty_noSpace (p);
+ outText (p, (const char *) "> (reinterpret_cast<char *> (", 29);
+ doExprC (p, lhs);
+ mcPretty_noSpace (p);
+ outText (p, (const char *) ")", 1);
+ outText (p, (const char *) op, _op_high);
+ if ((expListLen (n->intrinsicF.args)) == 1)
+ {
+ outText (p, (const char *) "1", 1);
+ }
+ else
+ {
+ doExprC (p, getExpList (n->intrinsicF.args, 2));
+ }
+ outText (p, (const char *) ")", 1);
+ }
+ else if (decl_isEnumeration (decl_skipType (type)))
+ {
+ /* avoid dangling else. */
+ outText (p, (const char *) "= static_cast<", 14);
+ doTypeNameC (p, type);
+ mcPretty_noSpace (p);
+ outText (p, (const char *) ">(static_cast<int>(", 19);
+ doExprC (p, lhs);
+ outText (p, (const char *) ")", 1);
+ outText (p, (const char *) op, _op_high);
+ if ((expListLen (n->intrinsicF.args)) == 1)
+ {
+ outText (p, (const char *) "1", 1);
+ }
+ else
+ {
+ doExprC (p, getExpList (n->intrinsicF.args, 2));
+ }
+ outText (p, (const char *) ")", 1);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ outText (p, (const char *) op, _op_high);
+ outText (p, (const char *) "=", 1);
+ mcPretty_setNeedSpace (p);
+ if ((expListLen (n->intrinsicF.args)) == 1)
+ {
+ outText (p, (const char *) "1", 1);
+ }
+ else
+ {
+ doExprC (p, getExpList (n->intrinsicF.args, 2));
+ }
+ }
+ }
+}
+
+
+/*
+ doInclC -
+*/
+
+static void doInclC (mcPretty_pretty p, decl_node n)
+{
+ decl_node lo;
+
+ mcDebug_assert (isIntrinsic (n));
+ if (n->intrinsicF.args != NULL)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((expListLen (n->intrinsicF.args)) == 2)
+ {
+ doExprC (p, getExpList (n->intrinsicF.args, 1));
+ lo = getSetLow (getExpList (n->intrinsicF.args, 1));
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "|=", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(1", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "<<", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, getExpList (n->intrinsicF.args, 2));
+ doSubtractC (p, lo);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "))", 2);
+ }
+ else
+ {
+ M2RTS_HALT (-1); /* metaError0 ('expecting two parameters to INCL') */
+ __builtin_unreachable ();
+ }
+ }
+}
+
+
+/*
+ doExclC -
+*/
+
+static void doExclC (mcPretty_pretty p, decl_node n)
+{
+ decl_node lo;
+
+ mcDebug_assert (isIntrinsic (n));
+ if (n->intrinsicF.args != NULL)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((expListLen (n->intrinsicF.args)) == 2)
+ {
+ doExprC (p, getExpList (n->intrinsicF.args, 1));
+ lo = getSetLow (getExpList (n->intrinsicF.args, 1));
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "&=", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(~(1", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "<<", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, getExpList (n->intrinsicF.args, 2));
+ doSubtractC (p, lo);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) ")))", 3);
+ }
+ else
+ {
+ M2RTS_HALT (-1); /* metaError0 ('expecting two parameters to EXCL') */
+ __builtin_unreachable ();
+ }
+ }
+}
+
+
+/*
+ doNewC -
+*/
+
+static void doNewC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+
+ mcDebug_assert (isIntrinsic (n));
+ if (n->intrinsicF.args == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ if ((expListLen (n->intrinsicF.args)) == 1)
+ {
+ keyc_useStorage ();
+ outText (p, (const char *) "Storage_ALLOCATE", 16);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "((void **)", 10);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "&", 1);
+ doExprC (p, getExpList (n->intrinsicF.args, 1));
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ t = decl_skipType (decl_getType (getExpList (n->intrinsicF.args, 1)));
+ if (decl_isPointer (t))
+ {
+ t = decl_getType (t);
+ outText (p, (const char *) "sizeof", 6);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doTypeNameC (p, t);
+ mcPretty_noSpace (p);
+ outText (p, (const char *) "))", 2);
+ }
+ else
+ {
+ mcMetaError_metaError1 ((const char *) "expecting a pointer type variable as the argument to NEW, rather than {%1ad}", 76, (const unsigned char *) &t, (sizeof (t)-1));
+ }
+ }
+ }
+}
+
+
+/*
+ doDisposeC -
+*/
+
+static void doDisposeC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+
+ mcDebug_assert (isIntrinsic (n));
+ if (n->intrinsicF.args == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ if ((expListLen (n->intrinsicF.args)) == 1)
+ {
+ keyc_useStorage ();
+ outText (p, (const char *) "Storage_DEALLOCATE", 18);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "((void **)", 10);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "&", 1);
+ doExprC (p, getExpList (n->intrinsicF.args, 1));
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ t = decl_skipType (decl_getType (getExpList (n->intrinsicF.args, 1)));
+ if (decl_isPointer (t))
+ {
+ t = decl_getType (t);
+ outText (p, (const char *) "sizeof", 6);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doTypeNameC (p, t);
+ mcPretty_noSpace (p);
+ outText (p, (const char *) "))", 2);
+ }
+ else
+ {
+ mcMetaError_metaError1 ((const char *) "expecting a pointer type variable as the argument to DISPOSE, rather than {%1ad}", 80, (const unsigned char *) &t, (sizeof (t)-1));
+ }
+ }
+ else
+ {
+ M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to DISPOSE') */
+ __builtin_unreachable ();
+ }
+ }
+}
+
+
+/*
+ doCapC -
+*/
+
+static void doCapC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (isUnary (n));
+ if (n->unaryF.arg == NULL)
+ {
+ M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to CAP') */
+ __builtin_unreachable ();
+ }
+ else
+ {
+ keyc_useCtype ();
+ if (mcOptions_getGccConfigSystem ())
+ {
+ outText (p, (const char *) "TOUPPER", 7);
+ }
+ else
+ {
+ outText (p, (const char *) "toupper", 7);
+ }
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, n->unaryF.arg);
+ outText (p, (const char *) ")", 1);
+ }
+}
+
+
+/*
+ doLengthC -
+*/
+
+static void doLengthC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (isUnary (n));
+ if (n->unaryF.arg == NULL)
+ {
+ M2RTS_HALT (-1); /* metaError0 ('expecting a single parameter to LENGTH') */
+ __builtin_unreachable ();
+ }
+ else
+ {
+ keyc_useM2RTS ();
+ outText (p, (const char *) "M2RTS_Length", 12);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, n->unaryF.arg);
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ doFuncHighC (p, n->unaryF.arg);
+ outText (p, (const char *) ")", 1);
+ }
+}
+
+
+/*
+ doAbsC -
+*/
+
+static void doAbsC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+
+ mcDebug_assert (isUnary (n));
+ if (n->unaryF.arg == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ t = getExprType (n);
+ }
+ if (t == longintN)
+ {
+ keyc_useLabs ();
+ outText (p, (const char *) "labs", 4);
+ }
+ else if (t == integerN)
+ {
+ /* avoid dangling else. */
+ keyc_useAbs ();
+ outText (p, (const char *) "abs", 3);
+ }
+ else if (t == realN)
+ {
+ /* avoid dangling else. */
+ keyc_useFabs ();
+ outText (p, (const char *) "fabs", 4);
+ }
+ else if (t == longrealN)
+ {
+ /* avoid dangling else. */
+ keyc_useFabsl ();
+ outText (p, (const char *) "fabsl", 5);
+ }
+ else if (t == cardinalN)
+ {
+ /* avoid dangling else. */
+ }
+ else
+ {
+ /* avoid dangling else. */
+ /* do nothing. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, n->unaryF.arg);
+ outText (p, (const char *) ")", 1);
+}
+
+
+/*
+ doValC -
+*/
+
+static void doValC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (isBinary (n));
+ outText (p, (const char *) "(", 1);
+ doTypeNameC (p, n->binaryF.left);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, n->binaryF.right);
+ outText (p, (const char *) ")", 1);
+}
+
+
+/*
+ doMinC -
+*/
+
+static void doMinC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+
+ mcDebug_assert (isUnary (n));
+ t = getExprType (n->unaryF.arg);
+ doExprC (p, getMin (t));
+}
+
+
+/*
+ doMaxC -
+*/
+
+static void doMaxC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+
+ mcDebug_assert (isUnary (n));
+ t = getExprType (n->unaryF.arg);
+ doExprC (p, getMax (t));
+}
+
+
+/*
+ isIntrinsic - returns if, n, is an intrinsic procedure.
+ The intrinsic functions are represented as unary and binary nodes.
+*/
+
+static unsigned int isIntrinsic (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_unreachable:
+ case decl_throw:
+ case decl_inc:
+ case decl_dec:
+ case decl_incl:
+ case decl_excl:
+ case decl_new:
+ case decl_dispose:
+ case decl_halt:
+ return TRUE;
+ break;
+
+
+ default:
+ return FALSE;
+ break;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doHalt -
+*/
+
+static void doHalt (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (n->kind == decl_halt);
+ if ((n->intrinsicF.args == NULL) || ((expListLen (n->intrinsicF.args)) == 0))
+ {
+ outText (p, (const char *) "M2RTS_HALT", 10);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(-1)", 4);
+ }
+ else if ((expListLen (n->intrinsicF.args)) == 1)
+ {
+ /* avoid dangling else. */
+ outText (p, (const char *) "M2RTS_HALT", 10);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, getExpList (n->intrinsicF.args, 1));
+ outText (p, (const char *) ")", 1);
+ }
+}
+
+
+/*
+ doCreal - emit the appropriate creal function.
+*/
+
+static void doCreal (mcPretty_pretty p, decl_node t)
+{
+ switch (t->kind)
+ {
+ case decl_complex:
+ keyc_useComplex ();
+ outText (p, (const char *) "creal", 5);
+ break;
+
+ case decl_longcomplex:
+ keyc_useComplex ();
+ outText (p, (const char *) "creall", 6);
+ break;
+
+ case decl_shortcomplex:
+ keyc_useComplex ();
+ outText (p, (const char *) "crealf", 6);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ doCimag - emit the appropriate cimag function.
+*/
+
+static void doCimag (mcPretty_pretty p, decl_node t)
+{
+ switch (t->kind)
+ {
+ case decl_complex:
+ keyc_useComplex ();
+ outText (p, (const char *) "cimag", 5);
+ break;
+
+ case decl_longcomplex:
+ keyc_useComplex ();
+ outText (p, (const char *) "cimagl", 6);
+ break;
+
+ case decl_shortcomplex:
+ keyc_useComplex ();
+ outText (p, (const char *) "cimagf", 6);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ doReC -
+*/
+
+static void doReC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+
+ mcDebug_assert (n->kind == decl_re);
+ if (n->unaryF.arg != NULL)
+ {
+ t = getExprType (n->unaryF.arg);
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ doCreal (p, t);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, n->unaryF.arg);
+ outText (p, (const char *) ")", 1);
+}
+
+
+/*
+ doImC -
+*/
+
+static void doImC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+
+ mcDebug_assert (n->kind == decl_im);
+ if (n->unaryF.arg != NULL)
+ {
+ t = getExprType (n->unaryF.arg);
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ doCimag (p, t);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, n->unaryF.arg);
+ outText (p, (const char *) ")", 1);
+}
+
+
+/*
+ doCmplx -
+*/
+
+static void doCmplx (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (isBinary (n));
+ keyc_useComplex ();
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, n->binaryF.left);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "+", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, n->binaryF.right);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "*", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "I", 1);
+ outText (p, (const char *) ")", 1);
+}
+
+
+/*
+ doIntrinsicC -
+*/
+
+static void doIntrinsicC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (isIntrinsic (n));
+ doCommentC (p, n->intrinsicF.intrinsicComment.body);
+ switch (n->kind)
+ {
+ case decl_unreachable:
+ doUnreachableC (p, n);
+ break;
+
+ case decl_throw:
+ doThrowC (p, n);
+ break;
+
+ case decl_halt:
+ doHalt (p, n);
+ break;
+
+ case decl_inc:
+ doInc (p, n);
+ break;
+
+ case decl_dec:
+ doDec (p, n);
+ break;
+
+ case decl_incl:
+ doInclC (p, n);
+ break;
+
+ case decl_excl:
+ doExclC (p, n);
+ break;
+
+ case decl_new:
+ doNewC (p, n);
+ break;
+
+ case decl_dispose:
+ doDisposeC (p, n);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ outText (p, (const char *) ";", 1);
+ doAfterCommentC (p, n->intrinsicF.intrinsicComment.after);
+}
+
+
+/*
+ isIntrinsicFunction - returns true if, n, is an instrinsic function.
+*/
+
+static unsigned int isIntrinsicFunction (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_val:
+ case decl_adr:
+ case decl_size:
+ case decl_tsize:
+ case decl_float:
+ case decl_trunc:
+ case decl_ord:
+ case decl_chr:
+ case decl_cap:
+ case decl_abs:
+ case decl_high:
+ case decl_length:
+ case decl_min:
+ case decl_max:
+ case decl_re:
+ case decl_im:
+ case decl_cmplx:
+ return TRUE;
+ break;
+
+
+ default:
+ return FALSE;
+ break;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doSizeC -
+*/
+
+static void doSizeC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (isUnary (n));
+ outText (p, (const char *) "sizeof (", 8);
+ doExprC (p, n->unaryF.arg);
+ outText (p, (const char *) ")", 1);
+}
+
+
+/*
+ doConvertC -
+*/
+
+static void doConvertC (mcPretty_pretty p, decl_node n, const char *conversion_, unsigned int _conversion_high)
+{
+ char conversion[_conversion_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (conversion, conversion_, _conversion_high+1);
+
+ mcDebug_assert (isUnary (n));
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ outText (p, (const char *) conversion, _conversion_high);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, n->unaryF.arg);
+ outText (p, (const char *) "))", 2);
+}
+
+
+/*
+ getFuncFromExpr -
+*/
+
+static decl_node getFuncFromExpr (decl_node n)
+{
+ n = decl_skipType (decl_getType (n));
+ while ((n != procN) && (! (decl_isProcType (n))))
+ {
+ n = decl_skipType (decl_getType (n));
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doFuncExprC -
+*/
+
+static void doFuncExprC (mcPretty_pretty p, decl_node n)
+{
+ decl_node t;
+
+ mcDebug_assert (isFuncCall (n));
+ if (decl_isProcedure (n->funccallF.function))
+ {
+ doFQDNameC (p, n->funccallF.function, TRUE);
+ mcPretty_setNeedSpace (p);
+ doFuncArgsC (p, n, n->funccallF.function->procedureF.parameters, TRUE);
+ }
+ else
+ {
+ outText (p, (const char *) "(*", 2);
+ doExprC (p, n->funccallF.function);
+ outText (p, (const char *) ".proc", 5);
+ outText (p, (const char *) ")", 1);
+ t = getFuncFromExpr (n->funccallF.function);
+ mcPretty_setNeedSpace (p);
+ if (t == procN)
+ {
+ doProcTypeArgsC (p, n, NULL, TRUE);
+ }
+ else
+ {
+ mcDebug_assert (decl_isProcType (t));
+ doProcTypeArgsC (p, n, t->proctypeF.parameters, TRUE);
+ }
+ }
+}
+
+
+/*
+ doFuncCallC -
+*/
+
+static void doFuncCallC (mcPretty_pretty p, decl_node n)
+{
+ doCommentC (p, n->funccallF.funccallComment.body);
+ doFuncExprC (p, n);
+ outText (p, (const char *) ";", 1);
+ doAfterCommentC (p, n->funccallF.funccallComment.after);
+}
+
+
+/*
+ doCaseStatementC -
+*/
+
+static void doCaseStatementC (mcPretty_pretty p, decl_node n, unsigned int needBreak)
+{
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ doStatementSequenceC (p, n);
+ if (needBreak)
+ {
+ outText (p, (const char *) "break;\\n", 8);
+ }
+ p = mcPretty_popPretty (p);
+}
+
+
+/*
+ doExceptionC -
+*/
+
+static void doExceptionC (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n)
+{
+ unsigned int w;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ w = decl_getDeclaredMod (n);
+ outText (p, (const char *) a, _a_high);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(\"", 2);
+ outTextS (p, mcLexBuf_findFileNameFromToken (w, 0));
+ outText (p, (const char *) "\",", 2);
+ mcPretty_setNeedSpace (p);
+ outCard (p, mcLexBuf_tokenToLineNo (w, 0));
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ outCard (p, mcLexBuf_tokenToColumnNo (w, 0));
+ outText (p, (const char *) ");\\n", 4);
+ outText (p, (const char *) "__builtin_unreachable ();\\n", 27);
+}
+
+
+/*
+ doExceptionCP -
+*/
+
+static void doExceptionCP (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n)
+{
+ unsigned int w;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ w = decl_getDeclaredMod (n);
+ outText (p, (const char *) a, _a_high);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(\"", 2);
+ outTextS (p, mcLexBuf_findFileNameFromToken (w, 0));
+ outText (p, (const char *) "\",", 2);
+ mcPretty_setNeedSpace (p);
+ outCard (p, mcLexBuf_tokenToLineNo (w, 0));
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ outCard (p, mcLexBuf_tokenToColumnNo (w, 0));
+ outText (p, (const char *) ");\\n", 4);
+ outText (p, (const char *) "__builtin_unreachable ();\\n", 27);
+}
+
+
+/*
+ doException -
+*/
+
+static void doException (mcPretty_pretty p, const char *a_, unsigned int _a_high, decl_node n)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ keyc_useException ();
+ if (lang == decl_ansiCP)
+ {
+ doExceptionCP (p, (const char *) a, _a_high, n);
+ }
+ else
+ {
+ doExceptionC (p, (const char *) a, _a_high, n);
+ }
+}
+
+
+/*
+ doRangeListC -
+*/
+
+static void doRangeListC (mcPretty_pretty p, decl_node c)
+{
+ decl_node r;
+ unsigned int i;
+ unsigned int h;
+
+ mcDebug_assert (decl_isCaseList (c));
+ i = 1;
+ h = Indexing_HighIndice (c->caselistF.rangePairs);
+ while (i <= h)
+ {
+ r = static_cast<decl_node> (Indexing_GetIndice (c->caselistF.rangePairs, i));
+ mcDebug_assert ((r->rangeF.hi == NULL) || (r->rangeF.lo == r->rangeF.hi));
+ outText (p, (const char *) "case", 4);
+ mcPretty_setNeedSpace (p);
+ doExprC (p, r->rangeF.lo);
+ outText (p, (const char *) ":\\n", 3);
+ i += 1;
+ }
+}
+
+
+/*
+ doRangeIfListC -
+*/
+
+static void doRangeIfListC (mcPretty_pretty p, decl_node e, decl_node c)
+{
+ decl_node r;
+ unsigned int i;
+ unsigned int h;
+
+ mcDebug_assert (decl_isCaseList (c));
+ i = 1;
+ h = Indexing_HighIndice (c->caselistF.rangePairs);
+ while (i <= h)
+ {
+ r = static_cast<decl_node> (Indexing_GetIndice (c->caselistF.rangePairs, i));
+ if ((r->rangeF.lo != r->rangeF.hi) && (r->rangeF.hi != NULL))
+ {
+ outText (p, (const char *) "((", 2);
+ doExprC (p, e);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) ">=", 2);
+ mcPretty_setNeedSpace (p);
+ doExprC (p, r->rangeF.lo);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "&&", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "((", 2);
+ doExprC (p, e);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "<=", 2);
+ mcPretty_setNeedSpace (p);
+ doExprC (p, r->rangeF.hi);
+ outText (p, (const char *) ")", 1);
+ }
+ else
+ {
+ outText (p, (const char *) "((", 2);
+ doExprC (p, e);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "==", 2);
+ mcPretty_setNeedSpace (p);
+ doExprC (p, r->rangeF.lo);
+ outText (p, (const char *) ")", 1);
+ }
+ if (i < h)
+ {
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "||", 2);
+ mcPretty_setNeedSpace (p);
+ }
+ i += 1;
+ }
+}
+
+
+/*
+ doCaseLabels -
+*/
+
+static void doCaseLabels (mcPretty_pretty p, decl_node n, unsigned int needBreak)
+{
+ mcDebug_assert (decl_isCaseLabelList (n));
+ doRangeListC (p, n->caselabellistF.caseList);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ doStatementSequenceC (p, n->caselabellistF.statements);
+ if (needBreak)
+ {
+ outText (p, (const char *) "break;\\n\\n", 10);
+ }
+ p = mcPretty_popPretty (p);
+}
+
+
+/*
+ doCaseLabelListC -
+*/
+
+static void doCaseLabelListC (mcPretty_pretty p, decl_node n, unsigned int haveElse)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node c;
+
+ mcDebug_assert (decl_isCase (n));
+ i = 1;
+ h = Indexing_HighIndice (n->caseF.caseLabelList);
+ while (i <= h)
+ {
+ c = static_cast<decl_node> (Indexing_GetIndice (n->caseF.caseLabelList, i));
+ doCaseLabels (p, c, ((i < h) || haveElse) || caseException);
+ i += 1;
+ }
+}
+
+
+/*
+ doCaseIfLabels -
+*/
+
+static void doCaseIfLabels (mcPretty_pretty p, decl_node e, decl_node n, unsigned int i, unsigned int h)
+{
+ mcDebug_assert (decl_isCaseLabelList (n));
+ if (i > 1)
+ {
+ outText (p, (const char *) "else", 4);
+ mcPretty_setNeedSpace (p);
+ }
+ outText (p, (const char *) "if", 2);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doRangeIfListC (p, e, n->caselabellistF.caseList);
+ outText (p, (const char *) ")\\n", 3);
+ if (h == 1)
+ {
+ doCompoundStmt (p, n->caselabellistF.statements);
+ }
+ else
+ {
+ outText (p, (const char *) "{\\n", 3);
+ doStatementSequenceC (p, n->caselabellistF.statements);
+ outText (p, (const char *) "}\\n", 3);
+ }
+}
+
+
+/*
+ doCaseIfLabelListC -
+*/
+
+static void doCaseIfLabelListC (mcPretty_pretty p, decl_node n)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node c;
+
+ mcDebug_assert (decl_isCase (n));
+ i = 1;
+ h = Indexing_HighIndice (n->caseF.caseLabelList);
+ while (i <= h)
+ {
+ c = static_cast<decl_node> (Indexing_GetIndice (n->caseF.caseLabelList, i));
+ doCaseIfLabels (p, n->caseF.expression, c, i, h);
+ i += 1;
+ }
+}
+
+
+/*
+ doCaseElseC -
+*/
+
+static void doCaseElseC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (decl_isCase (n));
+ if (n->caseF.else_ == NULL)
+ {
+ /* avoid dangling else. */
+ if (caseException)
+ {
+ outText (p, (const char *) "\\ndefault:\\n", 12);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ doException (p, (const char *) "CaseException", 13, n);
+ p = mcPretty_popPretty (p);
+ }
+ }
+ else
+ {
+ outText (p, (const char *) "\\ndefault:\\n", 12);
+ doCaseStatementC (p, n->caseF.else_, TRUE);
+ }
+}
+
+
+/*
+ doCaseIfElseC -
+*/
+
+static void doCaseIfElseC (mcPretty_pretty p, decl_node n)
+{
+ mcDebug_assert (decl_isCase (n));
+ if (n->caseF.else_ == NULL)
+ {
+ /* avoid dangling else. */
+ if (TRUE)
+ {
+ outText (p, (const char *) "\\n", 2);
+ outText (p, (const char *) "else {\\n", 8);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ doException (p, (const char *) "CaseException", 13, n);
+ p = mcPretty_popPretty (p);
+ outText (p, (const char *) "}\\n", 3);
+ }
+ }
+ else
+ {
+ outText (p, (const char *) "\\n", 2);
+ outText (p, (const char *) "else {\\n", 8);
+ doCaseStatementC (p, n->caseF.else_, FALSE);
+ outText (p, (const char *) "}\\n", 3);
+ }
+}
+
+
+/*
+ canUseSwitchCaseLabels - returns TRUE if all the case labels are
+ single values and not ranges.
+*/
+
+static unsigned int canUseSwitchCaseLabels (decl_node n)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node r;
+ decl_node l;
+
+ mcDebug_assert (decl_isCaseLabelList (n));
+ l = n->caselabellistF.caseList;
+ i = 1;
+ h = Indexing_HighIndice (l->caselistF.rangePairs);
+ while (i <= h)
+ {
+ r = static_cast<decl_node> (Indexing_GetIndice (l->caselistF.rangePairs, i));
+ if ((r->rangeF.hi != NULL) && (r->rangeF.lo != r->rangeF.hi))
+ {
+ return FALSE;
+ }
+ i += 1;
+ }
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ canUseSwitch - returns TRUE if the case statement can be implement
+ by a switch statement. This will be TRUE if all case
+ selectors are single values rather than ranges.
+*/
+
+static unsigned int canUseSwitch (decl_node n)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node c;
+
+ mcDebug_assert (decl_isCase (n));
+ i = 1;
+ h = Indexing_HighIndice (n->caseF.caseLabelList);
+ while (i <= h)
+ {
+ c = static_cast<decl_node> (Indexing_GetIndice (n->caseF.caseLabelList, i));
+ if (! (canUseSwitchCaseLabels (c)))
+ {
+ return FALSE;
+ }
+ i += 1;
+ }
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doCaseC -
+*/
+
+static void doCaseC (mcPretty_pretty p, decl_node n)
+{
+ unsigned int i;
+
+ mcDebug_assert (decl_isCase (n));
+ if (canUseSwitch (n))
+ {
+ i = mcPretty_getindent (p);
+ outText (p, (const char *) "switch", 6);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(", 1);
+ doExprC (p, n->caseF.expression);
+ p = mcPretty_pushPretty (p);
+ outText (p, (const char *) ")", 1);
+ mcPretty_setindent (p, i+indentationC);
+ outText (p, (const char *) "\\n{\\n", 5);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ doCaseLabelListC (p, n, n->caseF.else_ != NULL);
+ doCaseElseC (p, n);
+ p = mcPretty_popPretty (p);
+ outText (p, (const char *) "}\\n", 3);
+ p = mcPretty_popPretty (p);
+ }
+ else
+ {
+ doCaseIfLabelListC (p, n);
+ doCaseIfElseC (p, n);
+ }
+}
+
+
+/*
+ doLoopC -
+*/
+
+static void doLoopC (mcPretty_pretty p, decl_node s)
+{
+ mcDebug_assert (decl_isLoop (s));
+ outText (p, (const char *) "for (;;)\\n", 10);
+ outText (p, (const char *) "{\\n", 3);
+ p = mcPretty_pushPretty (p);
+ mcPretty_setindent (p, (mcPretty_getindent (p))+indentationC);
+ doStatementSequenceC (p, s->loopF.statements);
+ p = mcPretty_popPretty (p);
+ outText (p, (const char *) "}\\n", 3);
+}
+
+
+/*
+ doExitC -
+*/
+
+static void doExitC (mcPretty_pretty p, decl_node s)
+{
+ mcDebug_assert (decl_isExit (s));
+ outText (p, (const char *) "/* exit. */\\n", 14);
+}
+
+
+/*
+ doStatementsC -
+*/
+
+static void doStatementsC (mcPretty_pretty p, decl_node s)
+{
+ if (s == NULL)
+ {} /* empty. */
+ else if (decl_isStatementSequence (s))
+ {
+ /* avoid dangling else. */
+ doStatementSequenceC (p, s);
+ }
+ else if (isComment (s))
+ {
+ /* avoid dangling else. */
+ doCommentC (p, s);
+ }
+ else if (decl_isExit (s))
+ {
+ /* avoid dangling else. */
+ doExitC (p, s);
+ }
+ else if (decl_isReturn (s))
+ {
+ /* avoid dangling else. */
+ doReturnC (p, s);
+ }
+ else if (isAssignment (s))
+ {
+ /* avoid dangling else. */
+ doAssignmentC (p, s);
+ }
+ else if (decl_isIf (s))
+ {
+ /* avoid dangling else. */
+ doIfC (p, s);
+ }
+ else if (decl_isFor (s))
+ {
+ /* avoid dangling else. */
+ doForC (p, s);
+ }
+ else if (decl_isRepeat (s))
+ {
+ /* avoid dangling else. */
+ doRepeatC (p, s);
+ }
+ else if (decl_isWhile (s))
+ {
+ /* avoid dangling else. */
+ doWhileC (p, s);
+ }
+ else if (isIntrinsic (s))
+ {
+ /* avoid dangling else. */
+ doIntrinsicC (p, s);
+ }
+ else if (isFuncCall (s))
+ {
+ /* avoid dangling else. */
+ doFuncCallC (p, s);
+ }
+ else if (decl_isCase (s))
+ {
+ /* avoid dangling else. */
+ doCaseC (p, s);
+ }
+ else if (decl_isLoop (s))
+ {
+ /* avoid dangling else. */
+ doLoopC (p, s);
+ }
+ else if (decl_isExit (s))
+ {
+ /* avoid dangling else. */
+ doExitC (p, s);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1); /* need to handle another s^.kind. */
+ __builtin_unreachable ();
+ }
+}
+
+static void stop (void)
+{
+}
+
+
+/*
+ doLocalVarC -
+*/
+
+static void doLocalVarC (mcPretty_pretty p, decl_scopeT s)
+{
+ includeVarProcedure (s);
+ debugLists ();
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
+}
+
+
+/*
+ doLocalConstTypesC -
+*/
+
+static void doLocalConstTypesC (mcPretty_pretty p, decl_scopeT s)
+{
+ simplifyTypes (s);
+ includeConstType (s);
+ doP = p;
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
+}
+
+
+/*
+ addParamDone -
+*/
+
+static void addParamDone (decl_node n)
+{
+ if ((decl_isVar (n)) && n->varF.isParameter)
+ {
+ addDone (n);
+ addDone (decl_getType (n));
+ }
+}
+
+
+/*
+ includeParameters -
+*/
+
+static void includeParameters (decl_node n)
+{
+ mcDebug_assert (decl_isProcedure (n));
+ Indexing_ForeachIndiceInIndexDo (n->procedureF.decls.variables, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) addParamDone});
+}
+
+
+/*
+ isHalt -
+*/
+
+static unsigned int isHalt (decl_node n)
+{
+ return n->kind == decl_halt;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isReturnOrHalt -
+*/
+
+static unsigned int isReturnOrHalt (decl_node n)
+{
+ return (isHalt (n)) || (decl_isReturn (n));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isLastStatementReturn -
+*/
+
+static unsigned int isLastStatementReturn (decl_node n)
+{
+ return isLastStatement (n, (decl_isNodeF) {(decl_isNodeF_t) isReturnOrHalt});
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isLastStatementSequence -
+*/
+
+static unsigned int isLastStatementSequence (decl_node n, decl_isNodeF q)
+{
+ unsigned int h;
+
+ mcDebug_assert (decl_isStatementSequence (n));
+ h = Indexing_HighIndice (n->stmtF.statements);
+ if (h > 0)
+ {
+ return isLastStatement (reinterpret_cast<decl_node> (Indexing_GetIndice (n->stmtF.statements, h)), q);
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isLastStatementIf -
+*/
+
+static unsigned int isLastStatementIf (decl_node n, decl_isNodeF q)
+{
+ unsigned int ret;
+
+ mcDebug_assert (decl_isIf (n));
+ ret = TRUE;
+ if ((n->ifF.elsif != NULL) && ret)
+ {
+ ret = isLastStatement (n->ifF.elsif, q);
+ }
+ if ((n->ifF.then != NULL) && ret)
+ {
+ ret = isLastStatement (n->ifF.then, q);
+ }
+ if ((n->ifF.else_ != NULL) && ret)
+ {
+ ret = isLastStatement (n->ifF.else_, q);
+ }
+ return ret;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isLastStatementElsif -
+*/
+
+static unsigned int isLastStatementElsif (decl_node n, decl_isNodeF q)
+{
+ unsigned int ret;
+
+ mcDebug_assert (decl_isElsif (n));
+ ret = TRUE;
+ if ((n->elsifF.elsif != NULL) && ret)
+ {
+ ret = isLastStatement (n->elsifF.elsif, q);
+ }
+ if ((n->elsifF.then != NULL) && ret)
+ {
+ ret = isLastStatement (n->elsifF.then, q);
+ }
+ if ((n->elsifF.else_ != NULL) && ret)
+ {
+ ret = isLastStatement (n->elsifF.else_, q);
+ }
+ return ret;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isLastStatementCase -
+*/
+
+static unsigned int isLastStatementCase (decl_node n, decl_isNodeF q)
+{
+ unsigned int ret;
+ unsigned int i;
+ unsigned int h;
+ decl_node c;
+
+ ret = TRUE;
+ mcDebug_assert (decl_isCase (n));
+ i = 1;
+ h = Indexing_HighIndice (n->caseF.caseLabelList);
+ while (i <= h)
+ {
+ c = static_cast<decl_node> (Indexing_GetIndice (n->caseF.caseLabelList, i));
+ mcDebug_assert (decl_isCaseLabelList (c));
+ ret = ret && (isLastStatement (c->caselabellistF.statements, q));
+ i += 1;
+ }
+ if (n->caseF.else_ != NULL)
+ {
+ ret = ret && (isLastStatement (n->caseF.else_, q));
+ }
+ return ret;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isLastStatement - returns TRUE if the last statement in, n, is, q.
+*/
+
+static unsigned int isLastStatement (decl_node n, decl_isNodeF q)
+{
+ unsigned int ret;
+
+ if (n == NULL)
+ {
+ return FALSE;
+ }
+ else if (decl_isStatementSequence (n))
+ {
+ /* avoid dangling else. */
+ return isLastStatementSequence (n, q);
+ }
+ else if (decl_isProcedure (n))
+ {
+ /* avoid dangling else. */
+ mcDebug_assert (decl_isProcedure (n));
+ return isLastStatement (n->procedureF.beginStatements, q);
+ }
+ else if (decl_isIf (n))
+ {
+ /* avoid dangling else. */
+ return isLastStatementIf (n, q);
+ }
+ else if (decl_isElsif (n))
+ {
+ /* avoid dangling else. */
+ return isLastStatementElsif (n, q);
+ }
+ else if (decl_isCase (n))
+ {
+ /* avoid dangling else. */
+ return isLastStatementCase (n, q);
+ }
+ else if ((*q.proc) (n))
+ {
+ /* avoid dangling else. */
+ return TRUE;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doProcedureC -
+*/
+
+static void doProcedureC (decl_node n)
+{
+ unsigned int s;
+
+ outText (doP, (const char *) "\\n", 2);
+ includeParameters (n);
+ keyc_enterScope (n);
+ doProcedureHeadingC (n, FALSE);
+ outText (doP, (const char *) "\\n", 2);
+ doP = outKc (doP, (const char *) "{\\n", 3);
+ s = mcPretty_getcurline (doP);
+ doLocalConstTypesC (doP, n->procedureF.decls);
+ doLocalVarC (doP, n->procedureF.decls);
+ doUnboundedParamCopyC (doP, n);
+ if (s != (mcPretty_getcurline (doP)))
+ {
+ outText (doP, (const char *) "\\n", 2);
+ }
+ doStatementsC (doP, n->procedureF.beginStatements);
+ if (n->procedureF.returnType != NULL)
+ {
+ if (returnException)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (isLastStatementReturn (n))
+ {
+ outText (doP, (const char *) "/* static analysis guarentees a RETURN statement will be used before here. */\\n", 80);
+ outText (doP, (const char *) "__builtin_unreachable ();\\n", 27);
+ }
+ else
+ {
+ doException (doP, (const char *) "ReturnException", 15, n);
+ }
+ }
+ }
+ doP = outKc (doP, (const char *) "}\\n", 3);
+ keyc_leaveScope (n);
+}
+
+
+/*
+ outProceduresC -
+*/
+
+static void outProceduresC (mcPretty_pretty p, decl_scopeT s)
+{
+ doP = p;
+ if (debugDecl)
+ {
+ libc_printf ((const char *) "seen %d procedures\\n", 20, Indexing_HighIndice (s.procedures));
+ }
+ Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doProcedureC});
+}
+
+
+/*
+ output -
+*/
+
+static void output (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v)
+{
+ if (decl_isConst (n))
+ {
+ (*c.proc) (n);
+ }
+ else if (decl_isVar (n))
+ {
+ /* avoid dangling else. */
+ (*v.proc) (n);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ (*t.proc) (n);
+ }
+}
+
+
+/*
+ allDependants -
+*/
+
+static decl_dependentState allDependants (decl_node n)
+{
+ alists_alist l;
+ decl_dependentState s;
+
+ l = alists_initList ();
+ s = walkDependants (l, n);
+ alists_killList (&l);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkDependants -
+*/
+
+static decl_dependentState walkDependants (alists_alist l, decl_node n)
+{
+ if ((n == NULL) || (alists_isItemInList (doneQ, reinterpret_cast<void *> (n))))
+ {
+ return decl_completed;
+ }
+ else if (alists_isItemInList (l, reinterpret_cast<void *> (n)))
+ {
+ /* avoid dangling else. */
+ return decl_recursive;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ alists_includeItemIntoList (l, reinterpret_cast<void *> (n));
+ return doDependants (l, n);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkType -
+*/
+
+static decl_dependentState walkType (alists_alist l, decl_node n)
+{
+ decl_node t;
+
+ t = decl_getType (n);
+ if (alists_isItemInList (doneQ, reinterpret_cast<void *> (t)))
+ {
+ return decl_completed;
+ }
+ else if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+ {
+ /* avoid dangling else. */
+ return decl_blocked;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ queueBlocked (t);
+ return decl_blocked;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ db -
+*/
+
+static void db (const char *a_, unsigned int _a_high, decl_node n)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ if (mcOptions_getDebugTopological ())
+ {
+ outText (doP, (const char *) a, _a_high);
+ if (n != NULL)
+ {
+ outTextS (doP, gen (n));
+ }
+ }
+}
+
+
+/*
+ dbt -
+*/
+
+static void dbt (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ if (mcOptions_getDebugTopological ())
+ {
+ outText (doP, (const char *) a, _a_high);
+ }
+}
+
+
+/*
+ dbs -
+*/
+
+static void dbs (decl_dependentState s, decl_node n)
+{
+ if (mcOptions_getDebugTopological ())
+ {
+ switch (s)
+ {
+ case decl_completed:
+ outText (doP, (const char *) "{completed ", 11);
+ break;
+
+ case decl_blocked:
+ outText (doP, (const char *) "{blocked ", 9);
+ break;
+
+ case decl_partial:
+ outText (doP, (const char *) "{partial ", 9);
+ break;
+
+ case decl_recursive:
+ outText (doP, (const char *) "{recursive ", 11);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ if (n != NULL)
+ {
+ outTextS (doP, gen (n));
+ }
+ outText (doP, (const char *) "}\\n", 3);
+ }
+}
+
+
+/*
+ dbq -
+*/
+
+static void dbq (decl_node n)
+{
+ if (mcOptions_getDebugTopological ())
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (alists_isItemInList (todoQ, reinterpret_cast<void *> (n)))
+ {
+ db ((const char *) "{T", 2, n);
+ outText (doP, (const char *) "}", 1);
+ }
+ else if (alists_isItemInList (partialQ, reinterpret_cast<void *> (n)))
+ {
+ /* avoid dangling else. */
+ db ((const char *) "{P", 2, n);
+ outText (doP, (const char *) "}", 1);
+ }
+ else if (alists_isItemInList (doneQ, reinterpret_cast<void *> (n)))
+ {
+ /* avoid dangling else. */
+ db ((const char *) "{D", 2, n);
+ outText (doP, (const char *) "}", 1);
+ }
+ }
+}
+
+
+/*
+ walkRecord -
+*/
+
+static decl_dependentState walkRecord (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+ unsigned int o;
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ i = Indexing_LowIndice (n->recordF.listOfSons);
+ t = Indexing_HighIndice (n->recordF.listOfSons);
+ db ((const char *) "\\nwalking ", 10, n);
+ o = mcPretty_getindent (doP);
+ mcPretty_setindent (doP, (mcPretty_getcurpos (doP))+3);
+ dbq (n);
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->recordF.listOfSons, i));
+ db ((const char *) "", 0, q);
+ if ((decl_isRecordField (q)) && q->recordfieldF.tag)
+ {} /* empty. */
+ else
+ {
+ /* do nothing as it is a tag selector processed in the varient. */
+ s = walkDependants (l, q);
+ if (s != decl_completed)
+ {
+ dbs (s, q);
+ addTodo (n);
+ dbq (n);
+ db ((const char *) "\\n", 2, NULL);
+ mcPretty_setindent (doP, o);
+ return s;
+ }
+ }
+ i += 1;
+ }
+ db ((const char *) "{completed", 10, n);
+ dbt ((const char *) "}\\n", 3);
+ mcPretty_setindent (doP, o);
+ return decl_completed;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkVarient -
+*/
+
+static decl_dependentState walkVarient (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ db ((const char *) "\\nwalking", 9, n);
+ s = walkDependants (l, n->varientF.tag);
+ if (s != decl_completed)
+ {
+ dbs (s, n->varientF.tag);
+ dbq (n->varientF.tag);
+ db ((const char *) "\\n", 2, NULL);
+ return s;
+ }
+ i = Indexing_LowIndice (n->varientF.listOfSons);
+ t = Indexing_HighIndice (n->varientF.listOfSons);
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->varientF.listOfSons, i));
+ db ((const char *) "", 0, q);
+ s = walkDependants (l, q);
+ if (s != decl_completed)
+ {
+ dbs (s, q);
+ db ((const char *) "\\n", 2, NULL);
+ return s;
+ }
+ i += 1;
+ }
+ db ((const char *) "{completed", 10, n);
+ dbt ((const char *) "}\\n", 3);
+ return decl_completed;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ queueBlocked -
+*/
+
+static void queueBlocked (decl_node n)
+{
+ if (! ((alists_isItemInList (doneQ, reinterpret_cast<void *> (n))) || (alists_isItemInList (partialQ, reinterpret_cast<void *> (n)))))
+ {
+ addTodo (n);
+ }
+}
+
+
+/*
+ walkVar -
+*/
+
+static decl_dependentState walkVar (alists_alist l, decl_node n)
+{
+ decl_node t;
+
+ t = decl_getType (n);
+ if (alists_isItemInList (doneQ, reinterpret_cast<void *> (t)))
+ {
+ return decl_completed;
+ }
+ else
+ {
+ queueBlocked (t);
+ return decl_blocked;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkEnumeration -
+*/
+
+static decl_dependentState walkEnumeration (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ i = Indexing_LowIndice (n->enumerationF.listOfSons);
+ t = Indexing_HighIndice (n->enumerationF.listOfSons);
+ s = decl_completed;
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->enumerationF.listOfSons, i));
+ s = walkDependants (l, q);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ i += 1;
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkSubrange -
+*/
+
+static decl_dependentState walkSubrange (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+
+ s = walkDependants (l, n->subrangeF.low);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ s = walkDependants (l, n->subrangeF.high);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ s = walkDependants (l, n->subrangeF.type);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ return decl_completed;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkSubscript -
+*/
+
+static decl_dependentState walkSubscript (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+
+ s = walkDependants (l, n->subscriptF.expr);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ s = walkDependants (l, n->subscriptF.type);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ return decl_completed;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkPointer -
+*/
+
+static decl_dependentState walkPointer (alists_alist l, decl_node n)
+{
+ decl_node t;
+
+ /* if the type of, n, is done or partial then we can output pointer. */
+ t = decl_getType (n);
+ if ((alists_isItemInList (partialQ, reinterpret_cast<void *> (t))) || (alists_isItemInList (doneQ, reinterpret_cast<void *> (t))))
+ {
+ /* pointer to partial can always generate a complete type. */
+ return decl_completed;
+ }
+ return walkType (l, n);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkArray -
+*/
+
+static decl_dependentState walkArray (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+
+ /* an array can only be declared if its data type has already been emitted. */
+ if (! (alists_isItemInList (doneQ, reinterpret_cast<void *> (n->arrayF.type))))
+ {
+ s = walkDependants (l, n->arrayF.type);
+ queueBlocked (n->arrayF.type);
+ if (s == decl_completed)
+ {
+ /* downgrade the completed to partial as it has not yet been written. */
+ return decl_partial;
+ }
+ else
+ {
+ return s;
+ }
+ }
+ return walkDependants (l, n->arrayF.subr);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkConst -
+*/
+
+static decl_dependentState walkConst (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+
+ s = walkDependants (l, n->constF.type);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ s = walkDependants (l, n->constF.value);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ return decl_completed;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkVarParam -
+*/
+
+static decl_dependentState walkVarParam (alists_alist l, decl_node n)
+{
+ decl_node t;
+
+ t = decl_getType (n);
+ if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+ {
+ /* parameter can be issued from a partial. */
+ return decl_completed;
+ }
+ return walkDependants (l, t);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkParam -
+*/
+
+static decl_dependentState walkParam (alists_alist l, decl_node n)
+{
+ decl_node t;
+
+ t = decl_getType (n);
+ if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+ {
+ /* parameter can be issued from a partial. */
+ return decl_completed;
+ }
+ return walkDependants (l, t);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkOptarg -
+*/
+
+static decl_dependentState walkOptarg (alists_alist l, decl_node n)
+{
+ decl_node t;
+
+ t = decl_getType (n);
+ if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+ {
+ /* parameter can be issued from a partial. */
+ return decl_completed;
+ }
+ return walkDependants (l, t);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkRecordField -
+*/
+
+static decl_dependentState walkRecordField (alists_alist l, decl_node n)
+{
+ decl_node t;
+ decl_dependentState s;
+
+ mcDebug_assert (decl_isRecordField (n));
+ t = decl_getType (n);
+ if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+ {
+ dbs (decl_partial, n);
+ return decl_partial;
+ }
+ else if (alists_isItemInList (doneQ, reinterpret_cast<void *> (t)))
+ {
+ /* avoid dangling else. */
+ dbs (decl_completed, n);
+ return decl_completed;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ addTodo (t);
+ dbs (decl_blocked, n);
+ dbq (n);
+ dbq (t);
+ /* s := walkDependants (l, t) */
+ return decl_blocked;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkVarientField -
+*/
+
+static decl_dependentState walkVarientField (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ i = Indexing_LowIndice (n->varientfieldF.listOfSons);
+ t = Indexing_HighIndice (n->varientfieldF.listOfSons);
+ s = decl_completed;
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->varientfieldF.listOfSons, i));
+ s = walkDependants (l, q);
+ if (s != decl_completed)
+ {
+ dbs (s, n);
+ return s;
+ }
+ i += 1;
+ }
+ n->varientfieldF.simple = t <= 1;
+ dbs (s, n);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkEnumerationField -
+*/
+
+static decl_dependentState walkEnumerationField (alists_alist l, decl_node n)
+{
+ return decl_completed;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkSet -
+*/
+
+static decl_dependentState walkSet (alists_alist l, decl_node n)
+{
+ return walkDependants (l, decl_getType (n));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkProcType -
+*/
+
+static decl_dependentState walkProcType (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+ decl_node t;
+
+ t = decl_getType (n);
+ if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+ {} /* empty. */
+ else
+ {
+ /* proctype can be generated from partial types. */
+ s = walkDependants (l, t);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ }
+ return walkParameters (l, n->proctypeF.parameters);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkProcedure -
+*/
+
+static decl_dependentState walkProcedure (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+
+ s = walkDependants (l, decl_getType (n));
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ return walkParameters (l, n->procedureF.parameters);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkParameters -
+*/
+
+static decl_dependentState walkParameters (alists_alist l, Indexing_Index p)
+{
+ decl_dependentState s;
+ unsigned int i;
+ unsigned int h;
+ decl_node q;
+
+ i = Indexing_LowIndice (p);
+ h = Indexing_HighIndice (p);
+ while (i <= h)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (p, i));
+ s = walkDependants (l, q);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ i += 1;
+ }
+ return decl_completed;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkFuncCall -
+*/
+
+static decl_dependentState walkFuncCall (alists_alist l, decl_node n)
+{
+ return decl_completed;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkUnary -
+*/
+
+static decl_dependentState walkUnary (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+
+ s = walkDependants (l, n->unaryF.arg);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ return walkDependants (l, n->unaryF.resultType);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkBinary -
+*/
+
+static decl_dependentState walkBinary (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+
+ s = walkDependants (l, n->binaryF.left);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ s = walkDependants (l, n->binaryF.right);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ return walkDependants (l, n->binaryF.resultType);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkComponentRef -
+*/
+
+static decl_dependentState walkComponentRef (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+
+ s = walkDependants (l, n->componentrefF.rec);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ s = walkDependants (l, n->componentrefF.field);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ return walkDependants (l, n->componentrefF.resultType);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkPointerRef -
+*/
+
+static decl_dependentState walkPointerRef (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+
+ s = walkDependants (l, n->pointerrefF.ptr);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ s = walkDependants (l, n->pointerrefF.field);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ return walkDependants (l, n->pointerrefF.resultType);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ walkSetValue -
+*/
+
+static decl_dependentState walkSetValue (alists_alist l, decl_node n)
+{
+ decl_dependentState s;
+ unsigned int i;
+ unsigned int j;
+
+ mcDebug_assert (decl_isSetValue (n));
+ s = walkDependants (l, n->setvalueF.type);
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ i = Indexing_LowIndice (n->setvalueF.values);
+ j = Indexing_HighIndice (n->setvalueF.values);
+ while (i <= j)
+ {
+ s = walkDependants (l, reinterpret_cast<decl_node> (Indexing_GetIndice (n->setvalueF.values, i)));
+ if (s != decl_completed)
+ {
+ return s;
+ }
+ i += 1;
+ }
+ return decl_completed;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doDependants - return the dependentState depending upon whether
+ all dependants have been declared.
+*/
+
+static decl_dependentState doDependants (alists_alist l, decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_throw:
+ case decl_varargs:
+ case decl_address:
+ case decl_loc:
+ case decl_byte:
+ case decl_word:
+ case decl_csizet:
+ case decl_cssizet:
+ case decl_boolean:
+ case decl_char:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_real:
+ case decl_longreal:
+ case decl_shortreal:
+ case decl_bitset:
+ case decl_ztype:
+ case decl_rtype:
+ case decl_complex:
+ case decl_longcomplex:
+ case decl_shortcomplex:
+ case decl_proc:
+ /* base types. */
+ return decl_completed;
+ break;
+
+ case decl_type:
+ /* language features and compound type attributes. */
+ return walkType (l, n);
+ break;
+
+ case decl_record:
+ return walkRecord (l, n);
+ break;
+
+ case decl_varient:
+ return walkVarient (l, n);
+ break;
+
+ case decl_var:
+ return walkVar (l, n);
+ break;
+
+ case decl_enumeration:
+ return walkEnumeration (l, n);
+ break;
+
+ case decl_subrange:
+ return walkSubrange (l, n);
+ break;
+
+ case decl_pointer:
+ return walkPointer (l, n);
+ break;
+
+ case decl_array:
+ return walkArray (l, n);
+ break;
+
+ case decl_string:
+ return decl_completed;
+ break;
+
+ case decl_const:
+ return walkConst (l, n);
+ break;
+
+ case decl_literal:
+ return decl_completed;
+ break;
+
+ case decl_varparam:
+ return walkVarParam (l, n);
+ break;
+
+ case decl_param:
+ return walkParam (l, n);
+ break;
+
+ case decl_optarg:
+ return walkOptarg (l, n);
+ break;
+
+ case decl_recordfield:
+ return walkRecordField (l, n);
+ break;
+
+ case decl_varientfield:
+ return walkVarientField (l, n);
+ break;
+
+ case decl_enumerationfield:
+ return walkEnumerationField (l, n);
+ break;
+
+ case decl_set:
+ return walkSet (l, n);
+ break;
+
+ case decl_proctype:
+ return walkProcType (l, n);
+ break;
+
+ case decl_subscript:
+ return walkSubscript (l, n);
+ break;
+
+ case decl_procedure:
+ /* blocks. */
+ return walkProcedure (l, n);
+ break;
+
+ case decl_def:
+ case decl_imp:
+ case decl_module:
+ case decl_loop:
+ case decl_while:
+ case decl_for:
+ case decl_repeat:
+ case decl_if:
+ case decl_elsif:
+ case decl_assignment:
+ /* statements. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ break;
+
+ case decl_componentref:
+ /* expressions. */
+ return walkComponentRef (l, n);
+ break;
+
+ case decl_pointerref:
+ return walkPointerRef (l, n);
+ break;
+
+ case decl_not:
+ case decl_abs:
+ case decl_min:
+ case decl_max:
+ case decl_chr:
+ case decl_cap:
+ case decl_ord:
+ case decl_float:
+ case decl_trunc:
+ case decl_high:
+ return walkUnary (l, n);
+ break;
+
+ case decl_cast:
+ case decl_val:
+ case decl_plus:
+ case decl_sub:
+ case decl_div:
+ case decl_mod:
+ case decl_mult:
+ case decl_divide:
+ return walkBinary (l, n);
+ break;
+
+ case decl_constexp:
+ case decl_neg:
+ case decl_adr:
+ case decl_size:
+ case decl_tsize:
+ case decl_deref:
+ return walkUnary (l, n);
+ break;
+
+ case decl_equal:
+ case decl_notequal:
+ case decl_less:
+ case decl_greater:
+ case decl_greequal:
+ case decl_lessequal:
+ return walkBinary (l, n);
+ break;
+
+ case decl_funccall:
+ return walkFuncCall (l, n);
+ break;
+
+ case decl_setvalue:
+ return walkSetValue (l, n);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ tryComplete - returns TRUE if node, n, can be and was completed.
+*/
+
+static unsigned int tryComplete (decl_node n, decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v)
+{
+ if (decl_isEnumeration (n))
+ {
+ /* can always emit enumerated types. */
+ output (n, c, t, v);
+ return TRUE;
+ }
+ else if (((decl_isType (n)) && (decl_isTypeHidden (n))) && ((decl_getType (n)) == NULL))
+ {
+ /* avoid dangling else. */
+ /* can always emit hidden types. */
+ outputHidden (n);
+ return TRUE;
+ }
+ else if ((allDependants (n)) == decl_completed)
+ {
+ /* avoid dangling else. */
+ output (n, c, t, v);
+ return TRUE;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ tryCompleteFromPartial -
+*/
+
+static unsigned int tryCompleteFromPartial (decl_node n, decl_nodeProcedure t)
+{
+ if ((((decl_isType (n)) && ((decl_getType (n)) != NULL)) && (decl_isPointer (decl_getType (n)))) && ((allDependants (decl_getType (n))) == decl_completed))
+ {
+ /* alists.includeItemIntoList (partialQ, getType (n)) ; */
+ outputHiddenComplete (n);
+ return TRUE;
+ }
+ else if ((allDependants (n)) == decl_completed)
+ {
+ /* avoid dangling else. */
+ (*t.proc) (n);
+ return TRUE;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ visitIntrinsicFunction -
+*/
+
+static void visitIntrinsicFunction (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (isIntrinsicFunction (n));
+ switch (n->kind)
+ {
+ case decl_val:
+ case decl_cmplx:
+ visitNode (v, n->binaryF.left, p);
+ visitNode (v, n->binaryF.right, p);
+ visitNode (v, n->binaryF.resultType, p);
+ break;
+
+ case decl_length:
+ case decl_adr:
+ case decl_size:
+ case decl_tsize:
+ case decl_float:
+ case decl_trunc:
+ case decl_ord:
+ case decl_chr:
+ case decl_cap:
+ case decl_abs:
+ case decl_high:
+ case decl_min:
+ case decl_max:
+ case decl_re:
+ case decl_im:
+ visitNode (v, n->unaryF.arg, p);
+ visitNode (v, n->unaryF.resultType, p);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ visitUnary -
+*/
+
+static void visitUnary (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (isUnary (n));
+ visitNode (v, n->unaryF.arg, p);
+ visitNode (v, n->unaryF.resultType, p);
+}
+
+
+/*
+ visitBinary -
+*/
+
+static void visitBinary (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ visitNode (v, n->binaryF.left, p);
+ visitNode (v, n->binaryF.right, p);
+ visitNode (v, n->binaryF.resultType, p);
+}
+
+
+/*
+ visitBoolean -
+*/
+
+static void visitBoolean (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ visitNode (v, falseN, p);
+ visitNode (v, trueN, p);
+}
+
+
+/*
+ visitScope -
+*/
+
+static void visitScope (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ if (mustVisitScope)
+ {
+ visitNode (v, n, p);
+ }
+}
+
+
+/*
+ visitType -
+*/
+
+static void visitType (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isType (n));
+ visitNode (v, n->typeF.type, p);
+ visitScope (v, n->typeF.scope, p);
+}
+
+
+/*
+ visitIndex -
+*/
+
+static void visitIndex (alists_alist v, Indexing_Index i, decl_nodeProcedure p)
+{
+ unsigned int j;
+ unsigned int h;
+
+ j = 1;
+ h = Indexing_HighIndice (i);
+ while (j <= h)
+ {
+ visitNode (v, reinterpret_cast<decl_node> (Indexing_GetIndice (i, j)), p);
+ j += 1;
+ }
+}
+
+
+/*
+ visitRecord -
+*/
+
+static void visitRecord (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isRecord (n));
+ visitScope (v, n->recordF.scope, p);
+ visitIndex (v, n->recordF.listOfSons, p);
+}
+
+
+/*
+ visitVarient -
+*/
+
+static void visitVarient (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isVarient (n));
+ visitIndex (v, n->varientF.listOfSons, p);
+ visitNode (v, n->varientF.varient, p);
+ visitNode (v, n->varientF.tag, p);
+ visitScope (v, n->varientF.scope, p);
+}
+
+
+/*
+ visitVar -
+*/
+
+static void visitVar (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isVar (n));
+ visitNode (v, n->varF.type, p);
+ visitNode (v, n->varF.decl, p);
+ visitScope (v, n->varF.scope, p);
+}
+
+
+/*
+ visitEnumeration -
+*/
+
+static void visitEnumeration (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isEnumeration (n));
+ visitIndex (v, n->enumerationF.listOfSons, p);
+ visitScope (v, n->enumerationF.scope, p);
+}
+
+
+/*
+ visitSubrange -
+*/
+
+static void visitSubrange (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isSubrange (n));
+ visitNode (v, n->subrangeF.low, p);
+ visitNode (v, n->subrangeF.high, p);
+ visitNode (v, n->subrangeF.type, p);
+ visitScope (v, n->subrangeF.scope, p);
+}
+
+
+/*
+ visitPointer -
+*/
+
+static void visitPointer (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isPointer (n));
+ visitNode (v, n->pointerF.type, p);
+ visitScope (v, n->pointerF.scope, p);
+}
+
+
+/*
+ visitArray -
+*/
+
+static void visitArray (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isArray (n));
+ visitNode (v, n->arrayF.subr, p);
+ visitNode (v, n->arrayF.type, p);
+ visitScope (v, n->arrayF.scope, p);
+}
+
+
+/*
+ visitConst -
+*/
+
+static void visitConst (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isConst (n));
+ visitNode (v, n->constF.type, p);
+ visitNode (v, n->constF.value, p);
+ visitScope (v, n->constF.scope, p);
+}
+
+
+/*
+ visitVarParam -
+*/
+
+static void visitVarParam (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isVarParam (n));
+ visitNode (v, n->varparamF.namelist, p);
+ visitNode (v, n->varparamF.type, p);
+ visitScope (v, n->varparamF.scope, p);
+}
+
+
+/*
+ visitParam -
+*/
+
+static void visitParam (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isParam (n));
+ visitNode (v, n->paramF.namelist, p);
+ visitNode (v, n->paramF.type, p);
+ visitScope (v, n->paramF.scope, p);
+}
+
+
+/*
+ visitOptarg -
+*/
+
+static void visitOptarg (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isOptarg (n));
+ visitNode (v, n->optargF.namelist, p);
+ visitNode (v, n->optargF.type, p);
+ visitNode (v, n->optargF.init, p);
+ visitScope (v, n->optargF.scope, p);
+}
+
+
+/*
+ visitRecordField -
+*/
+
+static void visitRecordField (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isRecordField (n));
+ visitNode (v, n->recordfieldF.type, p);
+ visitNode (v, n->recordfieldF.parent, p);
+ visitNode (v, n->recordfieldF.varient, p);
+ visitScope (v, n->recordfieldF.scope, p);
+}
+
+
+/*
+ visitVarientField -
+*/
+
+static void visitVarientField (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isVarientField (n));
+ visitNode (v, n->varientfieldF.parent, p);
+ visitNode (v, n->varientfieldF.varient, p);
+ visitIndex (v, n->varientfieldF.listOfSons, p);
+ visitScope (v, n->varientfieldF.scope, p);
+}
+
+
+/*
+ visitEnumerationField -
+*/
+
+static void visitEnumerationField (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isEnumerationField (n));
+ visitNode (v, n->enumerationfieldF.type, p);
+ visitScope (v, n->enumerationfieldF.scope, p);
+}
+
+
+/*
+ visitSet -
+*/
+
+static void visitSet (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isSet (n));
+ visitNode (v, n->setF.type, p);
+ visitScope (v, n->setF.scope, p);
+}
+
+
+/*
+ visitProcType -
+*/
+
+static void visitProcType (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isProcType (n));
+ visitIndex (v, n->proctypeF.parameters, p);
+ visitNode (v, n->proctypeF.optarg_, p);
+ visitNode (v, n->proctypeF.returnType, p);
+ visitScope (v, n->proctypeF.scope, p);
+}
+
+
+/*
+ visitSubscript -
+*/
+
+static void visitSubscript (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+}
+
+
+/*
+ visitDecls -
+*/
+
+static void visitDecls (alists_alist v, decl_scopeT s, decl_nodeProcedure p)
+{
+ visitIndex (v, s.constants, p);
+ visitIndex (v, s.types, p);
+ visitIndex (v, s.procedures, p);
+ visitIndex (v, s.variables, p);
+}
+
+
+/*
+ visitProcedure -
+*/
+
+static void visitProcedure (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isProcedure (n));
+ visitDecls (v, n->procedureF.decls, p);
+ visitScope (v, n->procedureF.scope, p);
+ visitIndex (v, n->procedureF.parameters, p);
+ visitNode (v, n->procedureF.optarg_, p);
+ visitNode (v, n->procedureF.returnType, p);
+ visitNode (v, n->procedureF.beginStatements, p);
+}
+
+
+/*
+ visitDef -
+*/
+
+static void visitDef (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isDef (n));
+ visitDecls (v, n->defF.decls, p);
+}
+
+
+/*
+ visitImp -
+*/
+
+static void visitImp (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isImp (n));
+ visitDecls (v, n->impF.decls, p);
+ visitNode (v, n->impF.beginStatements, p);
+ /* --fixme-- do we need to visit definitionModule? */
+ visitNode (v, n->impF.finallyStatements, p);
+}
+
+
+/*
+ visitModule -
+*/
+
+static void visitModule (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isModule (n));
+ visitDecls (v, n->moduleF.decls, p);
+ visitNode (v, n->moduleF.beginStatements, p);
+ visitNode (v, n->moduleF.finallyStatements, p);
+}
+
+
+/*
+ visitLoop -
+*/
+
+static void visitLoop (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isLoop (n));
+ visitNode (v, n->loopF.statements, p);
+}
+
+
+/*
+ visitWhile -
+*/
+
+static void visitWhile (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isWhile (n));
+ visitNode (v, n->whileF.expr, p);
+ visitNode (v, n->whileF.statements, p);
+}
+
+
+/*
+ visitRepeat -
+*/
+
+static void visitRepeat (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isRepeat (n));
+ visitNode (v, n->repeatF.expr, p);
+ visitNode (v, n->repeatF.statements, p);
+}
+
+
+/*
+ visitCase -
+*/
+
+static void visitCase (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isCase (n));
+ visitNode (v, n->caseF.expression, p);
+ visitIndex (v, n->caseF.caseLabelList, p);
+ visitNode (v, n->caseF.else_, p);
+}
+
+
+/*
+ visitCaseLabelList -
+*/
+
+static void visitCaseLabelList (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isCaseLabelList (n));
+ visitNode (v, n->caselabellistF.caseList, p);
+ visitNode (v, n->caselabellistF.statements, p);
+}
+
+
+/*
+ visitCaseList -
+*/
+
+static void visitCaseList (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isCaseList (n));
+ visitIndex (v, n->caselistF.rangePairs, p);
+}
+
+
+/*
+ visitRange -
+*/
+
+static void visitRange (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isRange (n));
+ visitNode (v, n->rangeF.lo, p);
+ visitNode (v, n->rangeF.hi, p);
+}
+
+
+/*
+ visitIf -
+*/
+
+static void visitIf (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isIf (n));
+ visitNode (v, n->ifF.expr, p);
+ visitNode (v, n->ifF.elsif, p);
+ visitNode (v, n->ifF.then, p);
+ visitNode (v, n->ifF.else_, p);
+}
+
+
+/*
+ visitElsif -
+*/
+
+static void visitElsif (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isElsif (n));
+ visitNode (v, n->elsifF.expr, p);
+ visitNode (v, n->elsifF.elsif, p);
+ visitNode (v, n->elsifF.then, p);
+ visitNode (v, n->elsifF.else_, p);
+}
+
+
+/*
+ visitFor -
+*/
+
+static void visitFor (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isFor (n));
+ visitNode (v, n->forF.des, p);
+ visitNode (v, n->forF.start, p);
+ visitNode (v, n->forF.end, p);
+ visitNode (v, n->forF.increment, p);
+ visitNode (v, n->forF.statements, p);
+}
+
+
+/*
+ visitAssignment -
+*/
+
+static void visitAssignment (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (isAssignment (n));
+ visitNode (v, n->assignmentF.des, p);
+ visitNode (v, n->assignmentF.expr, p);
+}
+
+
+/*
+ visitComponentRef -
+*/
+
+static void visitComponentRef (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (isComponentRef (n));
+ visitNode (v, n->componentrefF.rec, p);
+ visitNode (v, n->componentrefF.field, p);
+ visitNode (v, n->componentrefF.resultType, p);
+}
+
+
+/*
+ visitPointerRef -
+*/
+
+static void visitPointerRef (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isPointerRef (n));
+ visitNode (v, n->pointerrefF.ptr, p);
+ visitNode (v, n->pointerrefF.field, p);
+ visitNode (v, n->pointerrefF.resultType, p);
+}
+
+
+/*
+ visitArrayRef -
+*/
+
+static void visitArrayRef (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (isArrayRef (n));
+ visitNode (v, n->arrayrefF.array, p);
+ visitNode (v, n->arrayrefF.index, p);
+ visitNode (v, n->arrayrefF.resultType, p);
+}
+
+
+/*
+ visitFunccall -
+*/
+
+static void visitFunccall (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (isFuncCall (n));
+ visitNode (v, n->funccallF.function, p);
+ visitNode (v, n->funccallF.args, p);
+ visitNode (v, n->funccallF.type, p);
+}
+
+
+/*
+ visitVarDecl -
+*/
+
+static void visitVarDecl (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (isVarDecl (n));
+ visitNode (v, n->vardeclF.type, p);
+ visitScope (v, n->vardeclF.scope, p);
+}
+
+
+/*
+ visitExplist -
+*/
+
+static void visitExplist (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isExpList (n));
+ visitIndex (v, n->explistF.exp, p);
+}
+
+
+/*
+ visitExit -
+*/
+
+static void visitExit (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isExit (n));
+ visitNode (v, n->exitF.loop, p);
+}
+
+
+/*
+ visitReturn -
+*/
+
+static void visitReturn (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isReturn (n));
+ visitNode (v, n->returnF.exp, p);
+}
+
+
+/*
+ visitStmtSeq -
+*/
+
+static void visitStmtSeq (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isStatementSequence (n));
+ visitIndex (v, n->stmtF.statements, p);
+}
+
+
+/*
+ visitVarargs -
+*/
+
+static void visitVarargs (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isVarargs (n));
+ visitScope (v, n->varargsF.scope, p);
+}
+
+
+/*
+ visitSetValue -
+*/
+
+static void visitSetValue (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (decl_isSetValue (n));
+ visitNode (v, n->setvalueF.type, p);
+ visitIndex (v, n->setvalueF.values, p);
+}
+
+
+/*
+ visitIntrinsic -
+*/
+
+static void visitIntrinsic (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (isIntrinsic (n));
+ visitNode (v, n->intrinsicF.args, p);
+}
+
+
+/*
+ visitDependants - helper procedure function called from visitNode.
+ node n has just been visited, this procedure will
+ visit node, n, dependants.
+*/
+
+static void visitDependants (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ mcDebug_assert (n != NULL);
+ mcDebug_assert (alists_isItemInList (v, reinterpret_cast<void *> (n)));
+ switch (n->kind)
+ {
+ case decl_explist:
+ visitExplist (v, n, p);
+ break;
+
+ case decl_funccall:
+ visitFunccall (v, n, p);
+ break;
+
+ case decl_exit:
+ visitExit (v, n, p);
+ break;
+
+ case decl_return:
+ visitReturn (v, n, p);
+ break;
+
+ case decl_stmtseq:
+ visitStmtSeq (v, n, p);
+ break;
+
+ case decl_comment:
+ break;
+
+ case decl_length:
+ visitIntrinsicFunction (v, n, p);
+ break;
+
+ case decl_unreachable:
+ case decl_throw:
+ case decl_halt:
+ case decl_new:
+ case decl_dispose:
+ case decl_inc:
+ case decl_dec:
+ case decl_incl:
+ case decl_excl:
+ visitIntrinsic (v, n, p);
+ break;
+
+ case decl_boolean:
+ visitBoolean (v, n, p);
+ break;
+
+ case decl_nil:
+ case decl_false:
+ case decl_true:
+ break;
+
+ case decl_varargs:
+ visitVarargs (v, n, p);
+ break;
+
+ case decl_address:
+ case decl_loc:
+ case decl_byte:
+ case decl_word:
+ case decl_csizet:
+ case decl_cssizet:
+ case decl_char:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_real:
+ case decl_longreal:
+ case decl_shortreal:
+ case decl_bitset:
+ case decl_ztype:
+ case decl_rtype:
+ case decl_complex:
+ case decl_longcomplex:
+ case decl_shortcomplex:
+ case decl_proc:
+ break;
+
+ case decl_type:
+ /* language features and compound type attributes. */
+ visitType (v, n, p);
+ break;
+
+ case decl_record:
+ visitRecord (v, n, p);
+ break;
+
+ case decl_varient:
+ visitVarient (v, n, p);
+ break;
+
+ case decl_var:
+ visitVar (v, n, p);
+ break;
+
+ case decl_enumeration:
+ visitEnumeration (v, n, p);
+ break;
+
+ case decl_subrange:
+ visitSubrange (v, n, p);
+ break;
+
+ case decl_pointer:
+ visitPointer (v, n, p);
+ break;
+
+ case decl_array:
+ visitArray (v, n, p);
+ break;
+
+ case decl_string:
+ break;
+
+ case decl_const:
+ visitConst (v, n, p);
+ break;
+
+ case decl_literal:
+ break;
+
+ case decl_varparam:
+ visitVarParam (v, n, p);
+ break;
+
+ case decl_param:
+ visitParam (v, n, p);
+ break;
+
+ case decl_optarg:
+ visitOptarg (v, n, p);
+ break;
+
+ case decl_recordfield:
+ visitRecordField (v, n, p);
+ break;
+
+ case decl_varientfield:
+ visitVarientField (v, n, p);
+ break;
+
+ case decl_enumerationfield:
+ visitEnumerationField (v, n, p);
+ break;
+
+ case decl_set:
+ visitSet (v, n, p);
+ break;
+
+ case decl_proctype:
+ visitProcType (v, n, p);
+ break;
+
+ case decl_subscript:
+ visitSubscript (v, n, p);
+ break;
+
+ case decl_procedure:
+ /* blocks. */
+ visitProcedure (v, n, p);
+ break;
+
+ case decl_def:
+ visitDef (v, n, p);
+ break;
+
+ case decl_imp:
+ visitImp (v, n, p);
+ break;
+
+ case decl_module:
+ visitModule (v, n, p);
+ break;
+
+ case decl_loop:
+ /* statements. */
+ visitLoop (v, n, p);
+ break;
+
+ case decl_while:
+ visitWhile (v, n, p);
+ break;
+
+ case decl_for:
+ visitFor (v, n, p);
+ break;
+
+ case decl_repeat:
+ visitRepeat (v, n, p);
+ break;
+
+ case decl_case:
+ visitCase (v, n, p);
+ break;
+
+ case decl_caselabellist:
+ visitCaseLabelList (v, n, p);
+ break;
+
+ case decl_caselist:
+ visitCaseList (v, n, p);
+ break;
+
+ case decl_range:
+ visitRange (v, n, p);
+ break;
+
+ case decl_if:
+ visitIf (v, n, p);
+ break;
+
+ case decl_elsif:
+ visitElsif (v, n, p);
+ break;
+
+ case decl_assignment:
+ visitAssignment (v, n, p);
+ break;
+
+ case decl_componentref:
+ /* expressions. */
+ visitComponentRef (v, n, p);
+ break;
+
+ case decl_pointerref:
+ visitPointerRef (v, n, p);
+ break;
+
+ case decl_arrayref:
+ visitArrayRef (v, n, p);
+ break;
+
+ case decl_cmplx:
+ case decl_equal:
+ case decl_notequal:
+ case decl_less:
+ case decl_greater:
+ case decl_greequal:
+ case decl_lessequal:
+ case decl_and:
+ case decl_or:
+ case decl_in:
+ case decl_cast:
+ case decl_val:
+ case decl_plus:
+ case decl_sub:
+ case decl_div:
+ case decl_mod:
+ case decl_mult:
+ case decl_divide:
+ visitBinary (v, n, p);
+ break;
+
+ case decl_re:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_im:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_abs:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_chr:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_cap:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_high:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_ord:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_float:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_trunc:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_not:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_neg:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_adr:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_size:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_tsize:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_min:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_max:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_constexp:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_deref:
+ visitUnary (v, n, p);
+ break;
+
+ case decl_identlist:
+ break;
+
+ case decl_vardecl:
+ visitVarDecl (v, n, p);
+ break;
+
+ case decl_setvalue:
+ visitSetValue (v, n, p);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ visitNode - visits node, n, if it is not already in the alist, v.
+ It calls p(n) if the node is unvisited.
+*/
+
+static void visitNode (alists_alist v, decl_node n, decl_nodeProcedure p)
+{
+ if ((n != NULL) && (! (alists_isItemInList (v, reinterpret_cast<void *> (n)))))
+ {
+ alists_includeItemIntoList (v, reinterpret_cast<void *> (n));
+ (*p.proc) (n);
+ visitDependants (v, n, p);
+ }
+}
+
+
+/*
+ genKind - returns a string depending upon the kind of node, n.
+*/
+
+static DynamicStrings_String genKind (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_nil:
+ case decl_true:
+ case decl_false:
+ case decl_address:
+ case decl_loc:
+ case decl_byte:
+ case decl_word:
+ case decl_csizet:
+ case decl_cssizet:
+ case decl_char:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_real:
+ case decl_longreal:
+ case decl_shortreal:
+ case decl_bitset:
+ case decl_boolean:
+ case decl_proc:
+ case decl_ztype:
+ case decl_rtype:
+ case decl_complex:
+ case decl_longcomplex:
+ case decl_shortcomplex:
+ /* types, no need to generate a kind string as it it contained in the name. */
+ return NULL;
+ break;
+
+ case decl_type:
+ /* language features and compound type attributes. */
+ return DynamicStrings_InitString ((const char *) "type", 4);
+ break;
+
+ case decl_record:
+ return DynamicStrings_InitString ((const char *) "record", 6);
+ break;
+
+ case decl_varient:
+ return DynamicStrings_InitString ((const char *) "varient", 7);
+ break;
+
+ case decl_var:
+ return DynamicStrings_InitString ((const char *) "var", 3);
+ break;
+
+ case decl_enumeration:
+ return DynamicStrings_InitString ((const char *) "enumeration", 11);
+ break;
+
+ case decl_subrange:
+ return DynamicStrings_InitString ((const char *) "subrange", 8);
+ break;
+
+ case decl_array:
+ return DynamicStrings_InitString ((const char *) "array", 5);
+ break;
+
+ case decl_subscript:
+ return DynamicStrings_InitString ((const char *) "subscript", 9);
+ break;
+
+ case decl_string:
+ return DynamicStrings_InitString ((const char *) "string", 6);
+ break;
+
+ case decl_const:
+ return DynamicStrings_InitString ((const char *) "const", 5);
+ break;
+
+ case decl_literal:
+ return DynamicStrings_InitString ((const char *) "literal", 7);
+ break;
+
+ case decl_varparam:
+ return DynamicStrings_InitString ((const char *) "varparam", 8);
+ break;
+
+ case decl_param:
+ return DynamicStrings_InitString ((const char *) "param", 5);
+ break;
+
+ case decl_varargs:
+ return DynamicStrings_InitString ((const char *) "varargs", 7);
+ break;
+
+ case decl_pointer:
+ return DynamicStrings_InitString ((const char *) "pointer", 7);
+ break;
+
+ case decl_recordfield:
+ return DynamicStrings_InitString ((const char *) "recordfield", 11);
+ break;
+
+ case decl_varientfield:
+ return DynamicStrings_InitString ((const char *) "varientfield", 12);
+ break;
+
+ case decl_enumerationfield:
+ return DynamicStrings_InitString ((const char *) "enumerationfield", 16);
+ break;
+
+ case decl_set:
+ return DynamicStrings_InitString ((const char *) "set", 3);
+ break;
+
+ case decl_proctype:
+ return DynamicStrings_InitString ((const char *) "proctype", 8);
+ break;
+
+ case decl_procedure:
+ /* blocks. */
+ return DynamicStrings_InitString ((const char *) "procedure", 9);
+ break;
+
+ case decl_def:
+ return DynamicStrings_InitString ((const char *) "def", 3);
+ break;
+
+ case decl_imp:
+ return DynamicStrings_InitString ((const char *) "imp", 3);
+ break;
+
+ case decl_module:
+ return DynamicStrings_InitString ((const char *) "module", 6);
+ break;
+
+ case decl_loop:
+ /* statements. */
+ return DynamicStrings_InitString ((const char *) "loop", 4);
+ break;
+
+ case decl_while:
+ return DynamicStrings_InitString ((const char *) "while", 5);
+ break;
+
+ case decl_for:
+ return DynamicStrings_InitString ((const char *) "for", 3);
+ break;
+
+ case decl_repeat:
+ return DynamicStrings_InitString ((const char *) "repeat", 6);
+ break;
+
+ case decl_assignment:
+ return DynamicStrings_InitString ((const char *) "assignment", 10);
+ break;
+
+ case decl_if:
+ return DynamicStrings_InitString ((const char *) "if", 2);
+ break;
+
+ case decl_elsif:
+ return DynamicStrings_InitString ((const char *) "elsif", 5);
+ break;
+
+ case decl_constexp:
+ /* expressions. */
+ return DynamicStrings_InitString ((const char *) "constexp", 8);
+ break;
+
+ case decl_neg:
+ return DynamicStrings_InitString ((const char *) "neg", 3);
+ break;
+
+ case decl_cast:
+ return DynamicStrings_InitString ((const char *) "cast", 4);
+ break;
+
+ case decl_val:
+ return DynamicStrings_InitString ((const char *) "val", 3);
+ break;
+
+ case decl_plus:
+ return DynamicStrings_InitString ((const char *) "plus", 4);
+ break;
+
+ case decl_sub:
+ return DynamicStrings_InitString ((const char *) "sub", 3);
+ break;
+
+ case decl_div:
+ return DynamicStrings_InitString ((const char *) "div", 3);
+ break;
+
+ case decl_mod:
+ return DynamicStrings_InitString ((const char *) "mod", 3);
+ break;
+
+ case decl_mult:
+ return DynamicStrings_InitString ((const char *) "mult", 4);
+ break;
+
+ case decl_divide:
+ return DynamicStrings_InitString ((const char *) "divide", 6);
+ break;
+
+ case decl_adr:
+ return DynamicStrings_InitString ((const char *) "adr", 3);
+ break;
+
+ case decl_size:
+ return DynamicStrings_InitString ((const char *) "size", 4);
+ break;
+
+ case decl_tsize:
+ return DynamicStrings_InitString ((const char *) "tsize", 5);
+ break;
+
+ case decl_chr:
+ return DynamicStrings_InitString ((const char *) "chr", 3);
+ break;
+
+ case decl_ord:
+ return DynamicStrings_InitString ((const char *) "ord", 3);
+ break;
+
+ case decl_float:
+ return DynamicStrings_InitString ((const char *) "float", 5);
+ break;
+
+ case decl_trunc:
+ return DynamicStrings_InitString ((const char *) "trunc", 5);
+ break;
+
+ case decl_high:
+ return DynamicStrings_InitString ((const char *) "high", 4);
+ break;
+
+ case decl_componentref:
+ return DynamicStrings_InitString ((const char *) "componentref", 12);
+ break;
+
+ case decl_pointerref:
+ return DynamicStrings_InitString ((const char *) "pointerref", 10);
+ break;
+
+ case decl_arrayref:
+ return DynamicStrings_InitString ((const char *) "arrayref", 8);
+ break;
+
+ case decl_deref:
+ return DynamicStrings_InitString ((const char *) "deref", 5);
+ break;
+
+ case decl_equal:
+ return DynamicStrings_InitString ((const char *) "equal", 5);
+ break;
+
+ case decl_notequal:
+ return DynamicStrings_InitString ((const char *) "notequal", 8);
+ break;
+
+ case decl_less:
+ return DynamicStrings_InitString ((const char *) "less", 4);
+ break;
+
+ case decl_greater:
+ return DynamicStrings_InitString ((const char *) "greater", 7);
+ break;
+
+ case decl_greequal:
+ return DynamicStrings_InitString ((const char *) "greequal", 8);
+ break;
+
+ case decl_lessequal:
+ return DynamicStrings_InitString ((const char *) "lessequal", 9);
+ break;
+
+ case decl_lsl:
+ return DynamicStrings_InitString ((const char *) "lsl", 3);
+ break;
+
+ case decl_lsr:
+ return DynamicStrings_InitString ((const char *) "lsr", 3);
+ break;
+
+ case decl_lor:
+ return DynamicStrings_InitString ((const char *) "lor", 3);
+ break;
+
+ case decl_land:
+ return DynamicStrings_InitString ((const char *) "land", 4);
+ break;
+
+ case decl_lnot:
+ return DynamicStrings_InitString ((const char *) "lnot", 4);
+ break;
+
+ case decl_lxor:
+ return DynamicStrings_InitString ((const char *) "lxor", 4);
+ break;
+
+ case decl_and:
+ return DynamicStrings_InitString ((const char *) "and", 3);
+ break;
+
+ case decl_or:
+ return DynamicStrings_InitString ((const char *) "or", 2);
+ break;
+
+ case decl_not:
+ return DynamicStrings_InitString ((const char *) "not", 3);
+ break;
+
+ case decl_identlist:
+ return DynamicStrings_InitString ((const char *) "identlist", 9);
+ break;
+
+ case decl_vardecl:
+ return DynamicStrings_InitString ((const char *) "vardecl", 7);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ gen - generate a small string describing node, n.
+*/
+
+static DynamicStrings_String gen (decl_node n)
+{
+ DynamicStrings_String s;
+ unsigned int d;
+
+ d = (unsigned int ) ((long unsigned int ) (n));
+ s = FormatStrings_Sprintf1 (DynamicStrings_InitString ((const char *) "< %d ", 5), (const unsigned char *) &d, (sizeof (d)-1)); /* use 0x%x once FormatStrings has been released. */
+ s = DynamicStrings_ConCat (s, genKind (n)); /* use 0x%x once FormatStrings has been released. */
+ s = DynamicStrings_ConCat (s, DynamicStrings_InitString ((const char *) " ", 1));
+ s = DynamicStrings_ConCat (s, getFQstring (n));
+ s = DynamicStrings_ConCat (s, DynamicStrings_InitString ((const char *) " >", 2));
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dumpQ -
+*/
+
+static void dumpQ (const char *q_, unsigned int _q_high, alists_alist l)
+{
+ DynamicStrings_String m;
+ decl_node n;
+ unsigned int d;
+ unsigned int h;
+ unsigned int i;
+ char q[_q_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (q, q_, _q_high+1);
+
+ m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "Queue ", 6));
+ m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
+ m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) q, _q_high));
+ m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
+ m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2));
+ m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
+ i = 1;
+ h = alists_noOfItemsInList (l);
+ while (i <= h)
+ {
+ n = static_cast<decl_node> (alists_getItemFromList (l, i));
+ m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, gen (n)));
+ i += 1;
+ }
+ m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2));
+ m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
+}
+
+
+/*
+ dumpLists -
+*/
+
+static void dumpLists (void)
+{
+ DynamicStrings_String m;
+
+ if (mcOptions_getDebugTopological ())
+ {
+ m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) "\\n", 2));
+ m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
+ dumpQ ((const char *) "todo", 4, todoQ);
+ dumpQ ((const char *) "partial", 7, partialQ);
+ dumpQ ((const char *) "done", 4, doneQ);
+ }
+}
+
+
+/*
+ outputHidden -
+*/
+
+static void outputHidden (decl_node n)
+{
+ outText (doP, (const char *) "#if !defined (", 14);
+ doFQNameC (doP, n);
+ outText (doP, (const char *) "_D)\\n", 5);
+ outText (doP, (const char *) "# define ", 10);
+ doFQNameC (doP, n);
+ outText (doP, (const char *) "_D\\n", 4);
+ outText (doP, (const char *) " typedef void *", 17);
+ doFQNameC (doP, n);
+ outText (doP, (const char *) ";\\n", 3);
+ outText (doP, (const char *) "#endif\\n\\n", 10);
+}
+
+
+/*
+ outputHiddenComplete -
+*/
+
+static void outputHiddenComplete (decl_node n)
+{
+ decl_node t;
+
+ mcDebug_assert (decl_isType (n));
+ t = decl_getType (n);
+ mcDebug_assert (decl_isPointer (t));
+ outText (doP, (const char *) "#define ", 8);
+ doFQNameC (doP, n);
+ outText (doP, (const char *) "_D\\n", 4);
+ outText (doP, (const char *) "typedef ", 8);
+ doTypeNameC (doP, decl_getType (t));
+ mcPretty_setNeedSpace (doP);
+ outText (doP, (const char *) "*", 1);
+ doFQNameC (doP, n);
+ outText (doP, (const char *) ";\\n", 3);
+}
+
+
+/*
+ tryPartial -
+*/
+
+static unsigned int tryPartial (decl_node n, decl_nodeProcedure pt)
+{
+ decl_node q;
+
+ if ((n != NULL) && (decl_isType (n)))
+ {
+ q = decl_getType (n);
+ while (decl_isPointer (q))
+ {
+ q = decl_getType (q);
+ }
+ if (q != NULL)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((decl_isRecord (q)) || (decl_isProcType (q)))
+ {
+ (*pt.proc) (n);
+ addTodo (q);
+ return TRUE;
+ }
+ else if (decl_isArray (q))
+ {
+ /* avoid dangling else. */
+ (*pt.proc) (n);
+ addTodo (q);
+ return TRUE;
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ outputPartialRecordArrayProcType -
+*/
+
+static void outputPartialRecordArrayProcType (decl_node n, decl_node q, unsigned int indirection)
+{
+ DynamicStrings_String s;
+
+ outText (doP, (const char *) "typedef struct", 14);
+ mcPretty_setNeedSpace (doP);
+ s = getFQstring (n);
+ if (decl_isRecord (q))
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_r", 2)));
+ }
+ else if (decl_isArray (q))
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_a", 2)));
+ }
+ else if (decl_isProcType (q))
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "_p", 2)));
+ }
+ outTextS (doP, s);
+ mcPretty_setNeedSpace (doP);
+ s = DynamicStrings_KillString (s);
+ while (indirection > 0)
+ {
+ outText (doP, (const char *) "*", 1);
+ indirection -= 1;
+ }
+ doFQNameC (doP, n);
+ outText (doP, (const char *) ";\\n\\n", 5);
+}
+
+
+/*
+ outputPartial -
+*/
+
+static void outputPartial (decl_node n)
+{
+ decl_node q;
+ unsigned int indirection;
+
+ q = decl_getType (n);
+ indirection = 0;
+ while (decl_isPointer (q))
+ {
+ q = decl_getType (q);
+ indirection += 1;
+ }
+ outputPartialRecordArrayProcType (n, q, indirection);
+}
+
+
+/*
+ tryOutputTodo -
+*/
+
+static void tryOutputTodo (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure pt)
+{
+ unsigned int i;
+ unsigned int n;
+ decl_node d;
+
+ i = 1;
+ n = alists_noOfItemsInList (todoQ);
+ while (i <= n)
+ {
+ d = static_cast<decl_node> (alists_getItemFromList (todoQ, i));
+ if (tryComplete (d, c, t, v))
+ {
+ alists_removeItemFromList (todoQ, reinterpret_cast<void *> (d));
+ alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (d));
+ i = 1;
+ }
+ else if (tryPartial (d, pt))
+ {
+ /* avoid dangling else. */
+ alists_removeItemFromList (todoQ, reinterpret_cast<void *> (d));
+ alists_includeItemIntoList (partialQ, reinterpret_cast<void *> (d));
+ i = 1;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ i += 1;
+ }
+ n = alists_noOfItemsInList (todoQ);
+ }
+}
+
+
+/*
+ tryOutputPartial -
+*/
+
+static void tryOutputPartial (decl_nodeProcedure t)
+{
+ unsigned int i;
+ unsigned int n;
+ decl_node d;
+
+ i = 1;
+ n = alists_noOfItemsInList (partialQ);
+ while (i <= n)
+ {
+ d = static_cast<decl_node> (alists_getItemFromList (partialQ, i));
+ if (tryCompleteFromPartial (d, t))
+ {
+ alists_removeItemFromList (partialQ, reinterpret_cast<void *> (d));
+ alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (d));
+ i = 1;
+ n -= 1;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+}
+
+
+/*
+ debugList -
+*/
+
+static void debugList (const char *a_, unsigned int _a_high, alists_alist l)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node n;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ h = alists_noOfItemsInList (l);
+ if (h > 0)
+ {
+ outText (doP, (const char *) a, _a_high);
+ outText (doP, (const char *) " still contains node(s)\\n", 25);
+ i = 1;
+ do {
+ n = static_cast<decl_node> (alists_getItemFromList (l, i));
+ dbg (n);
+ i += 1;
+ } while (! (i > h));
+ }
+}
+
+
+/*
+ debugLists -
+*/
+
+static void debugLists (void)
+{
+ if (mcOptions_getDebugTopological ())
+ {
+ debugList ((const char *) "todo", 4, todoQ);
+ debugList ((const char *) "partial", 7, partialQ);
+ }
+}
+
+
+/*
+ addEnumConst -
+*/
+
+static void addEnumConst (decl_node n)
+{
+ DynamicStrings_String s;
+
+ if ((decl_isConst (n)) || (decl_isEnumeration (n)))
+ {
+ addTodo (n);
+ }
+}
+
+
+/*
+ populateTodo -
+*/
+
+static void populateTodo (decl_nodeProcedure p)
+{
+ decl_node n;
+ unsigned int i;
+ unsigned int h;
+ alists_alist l;
+
+ h = alists_noOfItemsInList (todoQ);
+ i = 1;
+ while (i <= h)
+ {
+ n = static_cast<decl_node> (alists_getItemFromList (todoQ, i));
+ l = alists_initList ();
+ visitNode (l, n, p);
+ alists_killList (&l);
+ h = alists_noOfItemsInList (todoQ);
+ i += 1;
+ }
+}
+
+
+/*
+ topologicallyOut -
+*/
+
+static void topologicallyOut (decl_nodeProcedure c, decl_nodeProcedure t, decl_nodeProcedure v, decl_nodeProcedure tp, decl_nodeProcedure pc, decl_nodeProcedure pt, decl_nodeProcedure pv)
+{
+ unsigned int tol;
+ unsigned int pal;
+ unsigned int to;
+ unsigned int pa;
+
+ populateTodo ((decl_nodeProcedure) {(decl_nodeProcedure_t) addEnumConst});
+ tol = 0;
+ pal = 0;
+ to = alists_noOfItemsInList (todoQ);
+ pa = alists_noOfItemsInList (partialQ);
+ while ((tol != to) || (pal != pa))
+ {
+ dumpLists ();
+ tryOutputTodo (c, t, v, tp);
+ dumpLists ();
+ tryOutputPartial (pt);
+ tol = to;
+ pal = pa;
+ to = alists_noOfItemsInList (todoQ);
+ pa = alists_noOfItemsInList (partialQ);
+ }
+ dumpLists ();
+ debugLists ();
+}
+
+
+/*
+ scaffoldStatic -
+*/
+
+static void scaffoldStatic (mcPretty_pretty p, decl_node n)
+{
+ outText (p, (const char *) "\\n", 2);
+ doExternCP (p);
+ outText (p, (const char *) "void", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "_M2_", 4);
+ doFQNameC (p, n);
+ outText (p, (const char *) "_init", 5);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(__attribute__((unused)) int argc", 33);
+ outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37);
+ outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40);
+ p = outKc (p, (const char *) "{\\n", 3);
+ doStatementsC (p, n->impF.beginStatements);
+ p = outKc (p, (const char *) "}\\n", 3);
+ outText (p, (const char *) "\\n", 2);
+ doExternCP (p);
+ outText (p, (const char *) "void", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "_M2_", 4);
+ doFQNameC (p, n);
+ outText (p, (const char *) "_fini", 5);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(__attribute__((unused)) int argc", 33);
+ outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37);
+ outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40);
+ p = outKc (p, (const char *) "{\\n", 3);
+ doStatementsC (p, n->impF.finallyStatements);
+ p = outKc (p, (const char *) "}\\n", 3);
+}
+
+
+/*
+ emitCtor -
+*/
+
+static void emitCtor (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ outText (p, (const char *) "\\n", 2);
+ outText (p, (const char *) "static void", 11);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "ctorFunction ()\\n", 17);
+ doFQNameC (p, n);
+ p = outKc (p, (const char *) "{\\n", 3);
+ outText (p, (const char *) "M2RTS_RegisterModule (\"", 23);
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ mcPretty_prints (p, s);
+ outText (p, (const char *) "\",\\n", 4);
+ outText (p, (const char *) "init, fini, dependencies);\\n", 28);
+ p = outKc (p, (const char *) "}\\n\\n", 5);
+ p = outKc (p, (const char *) "struct ", 7);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2 { ", 13);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2 (); ~", 16);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2 (); } global_module_", 31);
+ mcPretty_prints (p, s);
+ outText (p, (const char *) ";\\n\\n", 5);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2::", 12);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2 ()\\n", 15);
+ p = outKc (p, (const char *) "{\\n", 3);
+ outText (p, (const char *) "M2RTS_RegisterModule (\"", 23);
+ mcPretty_prints (p, s);
+ outText (p, (const char *) "\", init, fini, dependencies);", 29);
+ p = outKc (p, (const char *) "}\\n", 3);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2::~", 13);
+ mcPretty_prints (p, s);
+ p = outKc (p, (const char *) "_module_m2 ()\\n", 15);
+ p = outKc (p, (const char *) "{\\n", 3);
+ p = outKc (p, (const char *) "}\\n", 3);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ scaffoldDynamic -
+*/
+
+static void scaffoldDynamic (mcPretty_pretty p, decl_node n)
+{
+ outText (p, (const char *) "\\n", 2);
+ doExternCP (p);
+ outText (p, (const char *) "void", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "_M2_", 4);
+ doFQNameC (p, n);
+ outText (p, (const char *) "_init", 5);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(__attribute__((unused)) int argc,", 34);
+ outText (p, (const char *) " __attribute__((unused)) char *argv[]", 37);
+ outText (p, (const char *) " __attribute__((unused)) char *envp[])\\n", 40);
+ p = outKc (p, (const char *) "{\\n", 3);
+ doStatementsC (p, n->impF.beginStatements);
+ p = outKc (p, (const char *) "}\\n", 3);
+ outText (p, (const char *) "\\n", 2);
+ doExternCP (p);
+ outText (p, (const char *) "void", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "_M2_", 4);
+ doFQNameC (p, n);
+ outText (p, (const char *) "_fini", 5);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(__attribute__((unused)) int argc,", 34);
+ outText (p, (const char *) " __attribute__((unused)) char *argv[]", 37);
+ outText (p, (const char *) " __attribute__((unused)) char *envp[])\\n", 40);
+ p = outKc (p, (const char *) "{\\n", 3);
+ doStatementsC (p, n->impF.finallyStatements);
+ p = outKc (p, (const char *) "}\\n", 3);
+ emitCtor (p, n);
+}
+
+
+/*
+ scaffoldMain -
+*/
+
+static void scaffoldMain (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ outText (p, (const char *) "int\\n", 5);
+ outText (p, (const char *) "main", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(int argc, char *argv[], char *envp[])\\n", 40);
+ p = outKc (p, (const char *) "{\\n", 3);
+ outText (p, (const char *) "M2RTS_ConstructModules (", 24);
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ mcPretty_prints (p, s);
+ outText (p, (const char *) ", argc, argv, envp);\\n", 22);
+ outText (p, (const char *) "M2RTS_DeconstructModules (", 26);
+ mcPretty_prints (p, s);
+ outText (p, (const char *) ", argc, argv, envp);\\n", 22);
+ outText (p, (const char *) "return 0;", 9);
+ p = outKc (p, (const char *) "}\\n", 3);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ outImpInitC - emit the init/fini functions and main function if required.
+*/
+
+static void outImpInitC (mcPretty_pretty p, decl_node n)
+{
+ if (mcOptions_getScaffoldDynamic ())
+ {
+ scaffoldDynamic (p, n);
+ }
+ else
+ {
+ scaffoldStatic (p, n);
+ }
+ if (mcOptions_getScaffoldMain ())
+ {
+ scaffoldMain (p, n);
+ }
+}
+
+
+/*
+ runSimplifyTypes -
+*/
+
+static void runSimplifyTypes (decl_node n)
+{
+ if (decl_isImp (n))
+ {
+ simplifyTypes (n->impF.decls);
+ }
+ else if (decl_isModule (n))
+ {
+ /* avoid dangling else. */
+ simplifyTypes (n->moduleF.decls);
+ }
+ else if (decl_isDef (n))
+ {
+ /* avoid dangling else. */
+ simplifyTypes (n->defF.decls);
+ }
+}
+
+
+/*
+ outDefC -
+*/
+
+static void outDefC (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ mcDebug_assert (decl_isDef (n));
+ outputFile = mcStream_openFrag (1); /* first fragment. */
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */
+ mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) ". */\\n", 7);
+ mcOptions_writeGPLheader (outputFile);
+ doCommentC (p, n->defF.com.body);
+ mcPretty_print (p, (const char *) "\\n\\n#if !defined (_", 19);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) "_H)\\n", 5);
+ mcPretty_print (p, (const char *) "# define _", 12);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) "_H\\n\\n", 6);
+ keyc_genConfigSystem (p);
+ mcPretty_print (p, (const char *) "# ifdef __cplusplus\\n", 23);
+ mcPretty_print (p, (const char *) "extern \"C\" {\\n", 14);
+ mcPretty_print (p, (const char *) "# endif\\n", 11);
+ outputFile = mcStream_openFrag (3); /* third fragment. */
+ doP = p; /* third fragment. */
+ Indexing_ForeachIndiceInIndexDo (n->defF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC});
+ mcPretty_print (p, (const char *) "\\n", 2);
+ mcPretty_print (p, (const char *) "# if defined (_", 17);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) "_C)\\n", 5);
+ mcPretty_print (p, (const char *) "# define EXTERN\\n", 22);
+ mcPretty_print (p, (const char *) "# else\\n", 10);
+ mcPretty_print (p, (const char *) "# define EXTERN extern\\n", 29);
+ mcPretty_print (p, (const char *) "# endif\\n\\n", 13);
+ outDeclsDefC (p, n);
+ runPrototypeDefC (n);
+ mcPretty_print (p, (const char *) "# ifdef __cplusplus\\n", 23);
+ mcPretty_print (p, (const char *) "}\\n", 3);
+ mcPretty_print (p, (const char *) "# endif\\n", 11);
+ mcPretty_print (p, (const char *) "\\n", 2);
+ mcPretty_print (p, (const char *) "# undef EXTERN\\n", 18);
+ mcPretty_print (p, (const char *) "#endif\\n", 8);
+ outputFile = mcStream_openFrag (2); /* second fragment. */
+ keyc_genDefs (p); /* second fragment. */
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ runPrototypeExported -
+*/
+
+static void runPrototypeExported (decl_node n)
+{
+ if (decl_isExported (n))
+ {
+ keyc_enterScope (n);
+ doProcedureHeadingC (n, TRUE);
+ mcPretty_print (doP, (const char *) ";\\n", 3);
+ keyc_leaveScope (n);
+ }
+}
+
+
+/*
+ runPrototypeDefC -
+*/
+
+static void runPrototypeDefC (decl_node n)
+{
+ if (decl_isDef (n))
+ {
+ Indexing_ForeachIndiceInIndexDo (n->defF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) runPrototypeExported});
+ }
+}
+
+
+/*
+ outImpC -
+*/
+
+static void outImpC (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+ decl_node defModule;
+
+ mcDebug_assert (decl_isImp (n));
+ outputFile = mcStream_openFrag (1); /* first fragment. */
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */
+ mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) ". */\\n", 7);
+ mcOptions_writeGPLheader (outputFile);
+ doCommentC (p, n->impF.com.body);
+ outText (p, (const char *) "\\n", 2);
+ outputFile = mcStream_openFrag (3); /* third fragment. */
+ if (mcOptions_getExtendedOpaque ()) /* third fragment. */
+ {
+ doP = p;
+ /* ForeachIndiceInIndexDo (n^.impF.importedModules, doIncludeC) ; */
+ includeExternals (n);
+ foreachModuleDo (n, (symbolKey_performOperation) {(symbolKey_performOperation_t) runSimplifyTypes});
+ libc_printf ((const char *) "/* --extended-opaque seen therefore no #include will be used and everything will be declared in full. */\\n", 108);
+ decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runIncludeDefConstType});
+ includeDefVarProcedure (n);
+ outDeclsImpC (p, n->impF.decls);
+ decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runPrototypeDefC});
+ }
+ else
+ {
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ /* we don't want to include the .h file for this implementation module. */
+ mcPretty_print (p, (const char *) "#define _", 9);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) "_H\\n", 4);
+ mcPretty_print (p, (const char *) "#define _", 9);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) "_C\\n\\n", 6);
+ s = DynamicStrings_KillString (s);
+ doP = p;
+ Indexing_ForeachIndiceInIndexDo (n->impF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC});
+ mcPretty_print (p, (const char *) "\\n", 2);
+ includeDefConstType (n);
+ includeDefVarProcedure (n);
+ outDeclsImpC (p, n->impF.decls);
+ defModule = decl_lookupDef (decl_getSymName (n));
+ if (defModule != NULL)
+ {
+ runPrototypeDefC (defModule);
+ }
+ }
+ Indexing_ForeachIndiceInIndexDo (n->impF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC});
+ outProceduresC (p, n->impF.decls);
+ outImpInitC (p, n);
+ outputFile = mcStream_openFrag (2); /* second fragment. */
+ keyc_genConfigSystem (p); /* second fragment. */
+ keyc_genDefs (p);
+}
+
+
+/*
+ outDeclsModuleC -
+*/
+
+static void outDeclsModuleC (mcPretty_pretty p, decl_scopeT s)
+{
+ simplifyTypes (s);
+ includeConstType (s);
+ doP = p;
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
+ /* try and output types, constants before variables and procedures. */
+ includeVarProcedure (s);
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartial}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doCompletePartialC}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNone});
+ Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC});
+}
+
+
+/*
+ outModuleInitC -
+*/
+
+static void outModuleInitC (mcPretty_pretty p, decl_node n)
+{
+ outText (p, (const char *) "\\n", 2);
+ doExternCP (p);
+ outText (p, (const char *) "void", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "_M2_", 4);
+ doFQNameC (p, n);
+ outText (p, (const char *) "_init", 5);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(__attribute__((unused)) int argc", 33);
+ outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37);
+ outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40);
+ p = outKc (p, (const char *) "{\\n", 3);
+ doStatementsC (p, n->moduleF.beginStatements);
+ p = outKc (p, (const char *) "}\\n", 3);
+ outText (p, (const char *) "\\n", 2);
+ doExternCP (p);
+ outText (p, (const char *) "void", 4);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "_M2_", 4);
+ doFQNameC (p, n);
+ outText (p, (const char *) "_fini", 5);
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "(__attribute__((unused)) int argc", 33);
+ outText (p, (const char *) ",__attribute__((unused)) char *argv[]", 37);
+ outText (p, (const char *) ",__attribute__((unused)) char *envp[])\\n", 40);
+ p = outKc (p, (const char *) "{\\n", 3);
+ doStatementsC (p, n->moduleF.finallyStatements);
+ p = outKc (p, (const char *) "}\\n", 3);
+}
+
+
+/*
+ outModuleC -
+*/
+
+static void outModuleC (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ mcDebug_assert (decl_isModule (n));
+ outputFile = mcStream_openFrag (1); /* first fragment. */
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))); /* first fragment. */
+ mcPretty_print (p, (const char *) "/* do not edit automatically generated by mc from ", 50);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) ". */\\n", 7);
+ mcOptions_writeGPLheader (outputFile);
+ doCommentC (p, n->moduleF.com.body);
+ outText (p, (const char *) "\\n", 2);
+ outputFile = mcStream_openFrag (3); /* third fragment. */
+ if (mcOptions_getExtendedOpaque ()) /* third fragment. */
+ {
+ doP = p;
+ includeExternals (n);
+ foreachModuleDo (n, (symbolKey_performOperation) {(symbolKey_performOperation_t) runSimplifyTypes});
+ libc_printf ((const char *) "/* --extended-opaque seen therefore no #include will be used and everything will be declared in full. */\\n", 108);
+ decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runIncludeDefConstType});
+ outDeclsModuleC (p, n->moduleF.decls);
+ decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) runPrototypeDefC});
+ }
+ else
+ {
+ doP = p;
+ Indexing_ForeachIndiceInIndexDo (n->moduleF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeC});
+ mcPretty_print (p, (const char *) "\\n", 2);
+ outDeclsModuleC (p, n->moduleF.decls);
+ }
+ Indexing_ForeachIndiceInIndexDo (n->moduleF.decls.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC});
+ outProceduresC (p, n->moduleF.decls);
+ outModuleInitC (p, n);
+ outputFile = mcStream_openFrag (2); /* second fragment. */
+ keyc_genConfigSystem (p); /* second fragment. */
+ keyc_genDefs (p);
+}
+
+
+/*
+ outC -
+*/
+
+static void outC (mcPretty_pretty p, decl_node n)
+{
+ keyc_enterScope (n);
+ if (decl_isDef (n))
+ {
+ outDefC (p, n);
+ }
+ else if (decl_isImp (n))
+ {
+ /* avoid dangling else. */
+ outImpC (p, n);
+ }
+ else if (decl_isModule (n))
+ {
+ /* avoid dangling else. */
+ outModuleC (p, n);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ keyc_leaveScope (n);
+}
+
+
+/*
+ doIncludeM2 - include modules in module, n.
+*/
+
+static void doIncludeM2 (decl_node n)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ mcPretty_print (doP, (const char *) "IMPORT ", 7);
+ mcPretty_prints (doP, s);
+ mcPretty_print (doP, (const char *) " ;\\n", 4);
+ s = DynamicStrings_KillString (s);
+ if (decl_isDef (n))
+ {
+ symbolKey_foreachNodeDo (n->defF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone});
+ }
+ else if (decl_isImp (n))
+ {
+ /* avoid dangling else. */
+ symbolKey_foreachNodeDo (n->impF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone});
+ }
+ else if (decl_isModule (n))
+ {
+ /* avoid dangling else. */
+ symbolKey_foreachNodeDo (n->moduleF.decls.symbols, (symbolKey_performOperation) {(symbolKey_performOperation_t) addDone});
+ }
+}
+
+
+/*
+ doConstM2 -
+*/
+
+static void doConstM2 (decl_node n)
+{
+ mcPretty_print (doP, (const char *) "CONST\\n", 7);
+ doFQNameC (doP, n);
+ mcPretty_setNeedSpace (doP);
+ doExprC (doP, n->constF.value);
+ mcPretty_print (doP, (const char *) "\\n", 2);
+}
+
+
+/*
+ doProcTypeM2 -
+*/
+
+static void doProcTypeM2 (mcPretty_pretty p, decl_node n)
+{
+ outText (p, (const char *) "proc type to do..", 17);
+}
+
+
+/*
+ doRecordFieldM2 -
+*/
+
+static void doRecordFieldM2 (mcPretty_pretty p, decl_node f)
+{
+ doNameM2 (p, f);
+ outText (p, (const char *) ":", 1);
+ mcPretty_setNeedSpace (p);
+ doTypeM2 (p, decl_getType (f));
+ mcPretty_setNeedSpace (p);
+}
+
+
+/*
+ doVarientFieldM2 -
+*/
+
+static void doVarientFieldM2 (mcPretty_pretty p, decl_node n)
+{
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ mcDebug_assert (decl_isVarientField (n));
+ doNameM2 (p, n);
+ outText (p, (const char *) ":", 1);
+ mcPretty_setNeedSpace (p);
+ i = Indexing_LowIndice (n->varientfieldF.listOfSons);
+ t = Indexing_HighIndice (n->varientfieldF.listOfSons);
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->varientfieldF.listOfSons, i));
+ if (decl_isRecordField (q))
+ {
+ doRecordFieldM2 (p, q);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ else if (decl_isVarient (q))
+ {
+ /* avoid dangling else. */
+ doVarientM2 (p, q);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ i += 1;
+ }
+}
+
+
+/*
+ doVarientM2 -
+*/
+
+static void doVarientM2 (mcPretty_pretty p, decl_node n)
+{
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ mcDebug_assert (decl_isVarient (n));
+ outText (p, (const char *) "CASE", 4);
+ mcPretty_setNeedSpace (p);
+ if (n->varientF.tag != NULL)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (decl_isRecordField (n->varientF.tag))
+ {
+ doRecordFieldM2 (p, n->varientF.tag);
+ }
+ else if (decl_isVarientField (n->varientF.tag))
+ {
+ /* avoid dangling else. */
+ doVarientFieldM2 (p, n->varientF.tag);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ }
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "OF\\n", 4);
+ i = Indexing_LowIndice (n->varientF.listOfSons);
+ t = Indexing_HighIndice (n->varientF.listOfSons);
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->varientF.listOfSons, i));
+ if (decl_isRecordField (q))
+ {
+ /* avoid dangling else. */
+ if (! q->recordfieldF.tag)
+ {
+ doRecordFieldM2 (p, q);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ }
+ else if (decl_isVarientField (q))
+ {
+ /* avoid dangling else. */
+ doVarientFieldM2 (p, q);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ i += 1;
+ }
+ outText (p, (const char *) "END", 3);
+ mcPretty_setNeedSpace (p);
+}
+
+
+/*
+ doRecordM2 -
+*/
+
+static void doRecordM2 (mcPretty_pretty p, decl_node n)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node f;
+
+ mcDebug_assert (decl_isRecord (n));
+ p = outKm2 (p, (const char *) "RECORD", 6);
+ i = Indexing_LowIndice (n->recordF.listOfSons);
+ h = Indexing_HighIndice (n->recordF.listOfSons);
+ outText (p, (const char *) "\\n", 2);
+ while (i <= h)
+ {
+ f = static_cast<decl_node> (Indexing_GetIndice (n->recordF.listOfSons, i));
+ if (decl_isRecordField (f))
+ {
+ /* avoid dangling else. */
+ if (! f->recordfieldF.tag)
+ {
+ doRecordFieldM2 (p, f);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ }
+ else if (decl_isVarient (f))
+ {
+ /* avoid dangling else. */
+ doVarientM2 (p, f);
+ outText (p, (const char *) ";\\n", 3);
+ }
+ else if (decl_isVarientField (f))
+ {
+ /* avoid dangling else. */
+ doVarientFieldM2 (p, f);
+ }
+ i += 1;
+ }
+ p = outKm2 (p, (const char *) "END", 3);
+ mcPretty_setNeedSpace (p);
+}
+
+
+/*
+ doPointerM2 -
+*/
+
+static void doPointerM2 (mcPretty_pretty p, decl_node n)
+{
+ outText (p, (const char *) "POINTER TO", 10);
+ mcPretty_setNeedSpace (doP);
+ doTypeM2 (p, decl_getType (n));
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) ";\\n", 3);
+}
+
+
+/*
+ doTypeAliasM2 -
+*/
+
+static void doTypeAliasM2 (mcPretty_pretty p, decl_node n)
+{
+ doTypeNameC (p, n);
+ mcPretty_setNeedSpace (p);
+ outText (doP, (const char *) "=", 1);
+ mcPretty_setNeedSpace (p);
+ doTypeM2 (p, decl_getType (n));
+ mcPretty_setNeedSpace (p);
+ outText (p, (const char *) "\\n", 2);
+}
+
+
+/*
+ doEnumerationM2 -
+*/
+
+static void doEnumerationM2 (mcPretty_pretty p, decl_node n)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node s;
+ DynamicStrings_String t;
+
+ outText (p, (const char *) "(", 1);
+ i = Indexing_LowIndice (n->enumerationF.listOfSons);
+ h = Indexing_HighIndice (n->enumerationF.listOfSons);
+ while (i <= h)
+ {
+ s = static_cast<decl_node> (Indexing_GetIndice (n->enumerationF.listOfSons, i));
+ doFQNameC (p, s);
+ if (i < h)
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ i += 1;
+ }
+ outText (p, (const char *) ")", 1);
+}
+
+
+/*
+ doBaseM2 -
+*/
+
+static void doBaseM2 (mcPretty_pretty p, decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_char:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_complex:
+ case decl_longcomplex:
+ case decl_shortcomplex:
+ case decl_real:
+ case decl_longreal:
+ case decl_shortreal:
+ case decl_bitset:
+ case decl_boolean:
+ case decl_proc:
+ doNameM2 (p, n);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ mcPretty_setNeedSpace (p);
+}
+
+
+/*
+ doSystemM2 -
+*/
+
+static void doSystemM2 (mcPretty_pretty p, decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_address:
+ case decl_loc:
+ case decl_byte:
+ case decl_word:
+ case decl_csizet:
+ case decl_cssizet:
+ doNameM2 (p, n);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ doTypeM2 -
+*/
+
+static void doTypeM2 (mcPretty_pretty p, decl_node n)
+{
+ if (isBase (n))
+ {
+ doBaseM2 (p, n);
+ }
+ else if (isSystem (n))
+ {
+ /* avoid dangling else. */
+ doSystemM2 (p, n);
+ }
+ else if (decl_isType (n))
+ {
+ /* avoid dangling else. */
+ doTypeAliasM2 (p, n);
+ }
+ else if (decl_isProcType (n))
+ {
+ /* avoid dangling else. */
+ doProcTypeM2 (p, n);
+ }
+ else if (decl_isPointer (n))
+ {
+ /* avoid dangling else. */
+ doPointerM2 (p, n);
+ }
+ else if (decl_isEnumeration (n))
+ {
+ /* avoid dangling else. */
+ doEnumerationM2 (p, n);
+ }
+ else if (decl_isRecord (n))
+ {
+ /* avoid dangling else. */
+ doRecordM2 (p, n);
+ }
+}
+
+
+/*
+ doTypesM2 -
+*/
+
+static void doTypesM2 (decl_node n)
+{
+ decl_node m;
+
+ outText (doP, (const char *) "TYPE\\n", 6);
+ doTypeM2 (doP, n);
+}
+
+
+/*
+ doVarM2 -
+*/
+
+static void doVarM2 (decl_node n)
+{
+ mcDebug_assert (decl_isVar (n));
+ doNameC (doP, n);
+ outText (doP, (const char *) ":", 1);
+ mcPretty_setNeedSpace (doP);
+ doTypeM2 (doP, decl_getType (n));
+ mcPretty_setNeedSpace (doP);
+ outText (doP, (const char *) ";\\n", 3);
+}
+
+
+/*
+ doVarsM2 -
+*/
+
+static void doVarsM2 (decl_node n)
+{
+ decl_node m;
+
+ outText (doP, (const char *) "VAR\\n", 5);
+ doVarM2 (n);
+}
+
+
+/*
+ doTypeNameM2 -
+*/
+
+static void doTypeNameM2 (mcPretty_pretty p, decl_node n)
+{
+ doNameM2 (p, n);
+}
+
+
+/*
+ doParamM2 -
+*/
+
+static void doParamM2 (mcPretty_pretty p, decl_node n)
+{
+ decl_node ptype;
+ nameKey_Name i;
+ unsigned int c;
+ unsigned int t;
+ wlists_wlist l;
+
+ mcDebug_assert (decl_isParam (n));
+ ptype = decl_getType (n);
+ if (n->paramF.namelist == NULL)
+ {
+ doTypeNameM2 (p, ptype);
+ }
+ else
+ {
+ mcDebug_assert (isIdentList (n->paramF.namelist));
+ l = n->paramF.namelist->identlistF.names;
+ if (l == NULL)
+ {
+ doTypeNameM2 (p, ptype);
+ }
+ else
+ {
+ t = wlists_noOfItemsInList (l);
+ c = 1;
+ while (c <= t)
+ {
+ i = static_cast<nameKey_Name> (wlists_getItemFromList (l, c));
+ mcPretty_setNeedSpace (p);
+ doNamesC (p, i);
+ if (c < t)
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ c += 1;
+ }
+ outText (p, (const char *) ":", 1);
+ mcPretty_setNeedSpace (p);
+ doTypeNameM2 (p, ptype);
+ }
+ }
+}
+
+
+/*
+ doVarParamM2 -
+*/
+
+static void doVarParamM2 (mcPretty_pretty p, decl_node n)
+{
+ decl_node ptype;
+ nameKey_Name i;
+ unsigned int c;
+ unsigned int t;
+ wlists_wlist l;
+
+ mcDebug_assert (decl_isVarParam (n));
+ outText (p, (const char *) "VAR", 3);
+ mcPretty_setNeedSpace (p);
+ ptype = decl_getType (n);
+ if (n->varparamF.namelist == NULL)
+ {
+ doTypeNameM2 (p, ptype);
+ }
+ else
+ {
+ mcDebug_assert (isIdentList (n->varparamF.namelist));
+ l = n->varparamF.namelist->identlistF.names;
+ if (l == NULL)
+ {
+ doTypeNameM2 (p, ptype);
+ }
+ else
+ {
+ t = wlists_noOfItemsInList (l);
+ c = 1;
+ while (c <= t)
+ {
+ i = static_cast<nameKey_Name> (wlists_getItemFromList (l, c));
+ mcPretty_setNeedSpace (p);
+ doNamesC (p, i);
+ if (c < t)
+ {
+ outText (p, (const char *) ",", 1);
+ mcPretty_setNeedSpace (p);
+ }
+ c += 1;
+ }
+ outText (p, (const char *) ":", 1);
+ mcPretty_setNeedSpace (p);
+ doTypeNameM2 (p, ptype);
+ }
+ }
+}
+
+
+/*
+ doParameterM2 -
+*/
+
+static void doParameterM2 (mcPretty_pretty p, decl_node n)
+{
+ if (decl_isParam (n))
+ {
+ doParamM2 (p, n);
+ }
+ else if (decl_isVarParam (n))
+ {
+ /* avoid dangling else. */
+ doVarParamM2 (p, n);
+ }
+ else if (decl_isVarargs (n))
+ {
+ /* avoid dangling else. */
+ mcPretty_print (p, (const char *) "...", 3);
+ }
+}
+
+
+/*
+ doPrototypeM2 -
+*/
+
+static void doPrototypeM2 (decl_node n)
+{
+ unsigned int i;
+ unsigned int h;
+ decl_node p;
+
+ mcDebug_assert (decl_isProcedure (n));
+ mcPretty_noSpace (doP);
+ doNameM2 (doP, n);
+ mcPretty_setNeedSpace (doP);
+ outText (doP, (const char *) "(", 1);
+ i = Indexing_LowIndice (n->procedureF.parameters);
+ h = Indexing_HighIndice (n->procedureF.parameters);
+ while (i <= h)
+ {
+ p = static_cast<decl_node> (Indexing_GetIndice (n->procedureF.parameters, i));
+ doParameterM2 (doP, p);
+ mcPretty_noSpace (doP);
+ if (i < h)
+ {
+ mcPretty_print (doP, (const char *) ";", 1);
+ mcPretty_setNeedSpace (doP);
+ }
+ i += 1;
+ }
+ outText (doP, (const char *) ")", 1);
+ if (n->procedureF.returnType != NULL)
+ {
+ mcPretty_setNeedSpace (doP);
+ outText (doP, (const char *) ":", 1);
+ doTypeM2 (doP, n->procedureF.returnType);
+ mcPretty_setNeedSpace (doP);
+ }
+ outText (doP, (const char *) ";\\n", 3);
+}
+
+
+/*
+ outputPartialM2 - just writes out record, array, and proctypes.
+ No need for forward declarations in Modula-2
+ but we need to keep topological sort happy.
+ So when asked to output partial we emit the
+ full type for these types and then do nothing
+ when trying to complete partial to full.
+*/
+
+static void outputPartialM2 (decl_node n)
+{
+ decl_node q;
+
+ q = decl_getType (n);
+ if (decl_isRecord (q))
+ {
+ doTypeM2 (doP, n);
+ }
+ else if (decl_isArray (q))
+ {
+ /* avoid dangling else. */
+ doTypeM2 (doP, n);
+ }
+ else if (decl_isProcType (q))
+ {
+ /* avoid dangling else. */
+ doTypeM2 (doP, n);
+ }
+}
+
+
+/*
+ outDeclsDefM2 -
+*/
+
+static void outDeclsDefM2 (mcPretty_pretty p, decl_scopeT s)
+{
+ simplifyTypes (s);
+ includeConstType (s);
+ doP = p;
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarsM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing});
+ includeVarProcedure (s);
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarsM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing});
+ Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeM2});
+}
+
+
+/*
+ outDefM2 -
+*/
+
+static void outDefM2 (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSource (n)));
+ mcPretty_print (p, (const char *) "(* automatically created by mc from ", 36);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) ". *)\\n\\n", 9);
+ s = DynamicStrings_KillString (s);
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ mcPretty_print (p, (const char *) "DEFINITION MODULE ", 18);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) " ;\\n\\n", 6);
+ doP = p;
+ Indexing_ForeachIndiceInIndexDo (n->defF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeM2});
+ mcPretty_print (p, (const char *) "\\n", 2);
+ outDeclsDefM2 (p, n->defF.decls);
+ mcPretty_print (p, (const char *) "\\n", 2);
+ mcPretty_print (p, (const char *) "END ", 4);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) ".\\n", 3);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ outDeclsImpM2 -
+*/
+
+static void outDeclsImpM2 (mcPretty_pretty p, decl_scopeT s)
+{
+ simplifyTypes (s);
+ includeConstType (s);
+ doP = p;
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing});
+ includeVarProcedure (s);
+ topologicallyOut ((decl_nodeProcedure) {(decl_nodeProcedure_t) doConstM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doTypesM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doVarsM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) outputPartialM2}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing}, (decl_nodeProcedure) {(decl_nodeProcedure_t) doNothing});
+ outText (p, (const char *) "\\n", 2);
+ Indexing_ForeachIndiceInIndexDo (s.procedures, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doPrototypeC});
+}
+
+
+/*
+ outImpM2 -
+*/
+
+static void outImpM2 (mcPretty_pretty p, decl_node n)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSource (n)));
+ mcPretty_print (p, (const char *) "(* automatically created by mc from ", 36);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) ". *)\\n\\n", 9);
+ mcPretty_print (p, (const char *) "IMPLEMENTATION MODULE ", 22);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) " ;\\n\\n", 6);
+ doP = p;
+ Indexing_ForeachIndiceInIndexDo (n->impF.importedModules, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) doIncludeM2});
+ mcPretty_print (p, (const char *) "\\n", 2);
+ includeDefConstType (n);
+ outDeclsImpM2 (p, n->impF.decls);
+ mcPretty_print (p, (const char *) "\\n", 2);
+ mcPretty_print (p, (const char *) "END ", 4);
+ mcPretty_prints (p, s);
+ mcPretty_print (p, (const char *) ".\\n", 3);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ outModuleM2 -
+*/
+
+static void outModuleM2 (mcPretty_pretty p, decl_node n)
+{
+}
+
+
+/*
+ outM2 -
+*/
+
+static void outM2 (mcPretty_pretty p, decl_node n)
+{
+ if (decl_isDef (n))
+ {
+ outDefM2 (p, n);
+ }
+ else if (decl_isImp (n))
+ {
+ /* avoid dangling else. */
+ outImpM2 (p, n);
+ }
+ else if (decl_isModule (n))
+ {
+ /* avoid dangling else. */
+ outModuleM2 (p, n);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ addDone - adds node, n, to the doneQ.
+*/
+
+static void addDone (decl_node n)
+{
+ alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (n));
+}
+
+
+/*
+ addDoneDef - adds node, n, to the doneQ providing
+ it is not an opaque of the main module we are compiling.
+*/
+
+static void addDoneDef (decl_node n)
+{
+ if (decl_isDef (n))
+ {
+ addDone (n);
+ return ;
+ }
+ if ((! (decl_isDef (n))) && ((decl_lookupImp (decl_getSymName (decl_getScope (n)))) == (decl_getMainModule ())))
+ {
+ mcMetaError_metaError1 ((const char *) "cyclic dependancy found between another module using {%1ad} from the definition module of the implementation main being compiled, use the --extended-opaque option to compile", 173, (const unsigned char *) &n, (sizeof (n)-1));
+ mcError_flushErrors ();
+ mcError_errorAbort0 ((const char *) "terminating compilation", 23);
+ }
+ else
+ {
+ addDone (n);
+ }
+}
+
+
+/*
+ dbgAdd -
+*/
+
+static decl_node dbgAdd (alists_alist l, decl_node n)
+{
+ if (n != NULL)
+ {
+ alists_includeItemIntoList (l, reinterpret_cast<void *> (n));
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dbgType -
+*/
+
+static void dbgType (alists_alist l, decl_node n)
+{
+ decl_node t;
+
+ t = dbgAdd (l, decl_getType (n));
+ out1 ((const char *) "<%s type", 8, n);
+ if (t == NULL)
+ {
+ out0 ((const char *) ", type = NIL\\n", 14);
+ }
+ else
+ {
+ out1 ((const char *) ", type = %s>\\n", 14, t);
+ }
+}
+
+
+/*
+ dbgPointer -
+*/
+
+static void dbgPointer (alists_alist l, decl_node n)
+{
+ decl_node t;
+
+ t = dbgAdd (l, decl_getType (n));
+ out1 ((const char *) "<%s pointer", 11, n);
+ out1 ((const char *) " to %s>\\n", 9, t);
+}
+
+
+/*
+ dbgRecord -
+*/
+
+static void dbgRecord (alists_alist l, decl_node n)
+{
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ out1 ((const char *) "<%s record:\\n", 13, n);
+ i = Indexing_LowIndice (n->recordF.listOfSons);
+ t = Indexing_HighIndice (n->recordF.listOfSons);
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->recordF.listOfSons, i));
+ if (decl_isRecordField (q))
+ {
+ out1 ((const char *) " <recordfield %s", 16, q);
+ }
+ else if (decl_isVarientField (q))
+ {
+ /* avoid dangling else. */
+ out1 ((const char *) " <varientfield %s", 17, q);
+ }
+ else if (decl_isVarient (q))
+ {
+ /* avoid dangling else. */
+ out1 ((const char *) " <varient %s", 12, q);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ q = dbgAdd (l, decl_getType (q));
+ out1 ((const char *) ": %s>\\n", 7, q);
+ i += 1;
+ }
+ outText (doP, (const char *) ">\\n", 3);
+}
+
+
+/*
+ dbgVarient -
+*/
+
+static void dbgVarient (alists_alist l, decl_node n)
+{
+ unsigned int i;
+ unsigned int t;
+ decl_node q;
+
+ out1 ((const char *) "<%s varient: ", 13, n);
+ out1 ((const char *) "tag %s", 6, n->varientF.tag);
+ q = decl_getType (n->varientF.tag);
+ if (q == NULL)
+ {
+ outText (doP, (const char *) "\\n", 2);
+ }
+ else
+ {
+ out1 ((const char *) ": %s\\n", 6, q);
+ q = dbgAdd (l, q);
+ }
+ i = Indexing_LowIndice (n->varientF.listOfSons);
+ t = Indexing_HighIndice (n->varientF.listOfSons);
+ while (i <= t)
+ {
+ q = static_cast<decl_node> (Indexing_GetIndice (n->varientF.listOfSons, i));
+ if (decl_isRecordField (q))
+ {
+ out1 ((const char *) " <recordfield %s", 16, q);
+ }
+ else if (decl_isVarientField (q))
+ {
+ /* avoid dangling else. */
+ out1 ((const char *) " <varientfield %s", 17, q);
+ }
+ else if (decl_isVarient (q))
+ {
+ /* avoid dangling else. */
+ out1 ((const char *) " <varient %s", 12, q);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ q = dbgAdd (l, decl_getType (q));
+ out1 ((const char *) ": %s>\\n", 7, q);
+ i += 1;
+ }
+ outText (doP, (const char *) ">\\n", 3);
+}
+
+
+/*
+ dbgEnumeration -
+*/
+
+static void dbgEnumeration (alists_alist l, decl_node n)
+{
+ decl_node e;
+ unsigned int i;
+ unsigned int h;
+
+ outText (doP, (const char *) "< enumeration ", 14);
+ i = Indexing_LowIndice (n->enumerationF.listOfSons);
+ h = Indexing_HighIndice (n->enumerationF.listOfSons);
+ while (i <= h)
+ {
+ e = static_cast<decl_node> (Indexing_GetIndice (n->enumerationF.listOfSons, i));
+ out1 ((const char *) "%s, ", 4, e);
+ i += 1;
+ }
+ outText (doP, (const char *) ">\\n", 3);
+}
+
+
+/*
+ dbgVar -
+*/
+
+static void dbgVar (alists_alist l, decl_node n)
+{
+ decl_node t;
+
+ t = dbgAdd (l, decl_getType (n));
+ out1 ((const char *) "<%s var", 7, n);
+ out1 ((const char *) ", type = %s>\\n", 14, t);
+}
+
+
+/*
+ dbgSubrange -
+*/
+
+static void dbgSubrange (alists_alist l, decl_node n)
+{
+ if (n->subrangeF.low == NULL)
+ {
+ out1 ((const char *) "%s", 2, n->subrangeF.type);
+ }
+ else
+ {
+ out1 ((const char *) "[%s", 3, n->subrangeF.low);
+ out1 ((const char *) "..%s]", 5, n->subrangeF.high);
+ }
+}
+
+
+/*
+ dbgArray -
+*/
+
+static void dbgArray (alists_alist l, decl_node n)
+{
+ decl_node t;
+
+ t = dbgAdd (l, decl_getType (n));
+ out1 ((const char *) "<%s array ", 10, n);
+ if (n->arrayF.subr != NULL)
+ {
+ dbgSubrange (l, n->arrayF.subr);
+ }
+ out1 ((const char *) " of %s>\\n", 9, t);
+}
+
+
+/*
+ doDbg -
+*/
+
+static void doDbg (alists_alist l, decl_node n)
+{
+ if (n == NULL)
+ {} /* empty. */
+ else if (decl_isSubrange (n))
+ {
+ /* avoid dangling else. */
+ dbgSubrange (l, n);
+ }
+ else if (decl_isType (n))
+ {
+ /* avoid dangling else. */
+ dbgType (l, n);
+ }
+ else if (decl_isRecord (n))
+ {
+ /* avoid dangling else. */
+ dbgRecord (l, n);
+ }
+ else if (decl_isVarient (n))
+ {
+ /* avoid dangling else. */
+ dbgVarient (l, n);
+ }
+ else if (decl_isEnumeration (n))
+ {
+ /* avoid dangling else. */
+ dbgEnumeration (l, n);
+ }
+ else if (decl_isPointer (n))
+ {
+ /* avoid dangling else. */
+ dbgPointer (l, n);
+ }
+ else if (decl_isArray (n))
+ {
+ /* avoid dangling else. */
+ dbgArray (l, n);
+ }
+ else if (decl_isVar (n))
+ {
+ /* avoid dangling else. */
+ dbgVar (l, n);
+ }
+}
+
+
+/*
+ dbg -
+*/
+
+static void dbg (decl_node n)
+{
+ alists_alist l;
+ mcPretty_pretty o;
+ FIO_File f;
+ DynamicStrings_String s;
+ unsigned int i;
+
+ o = doP;
+ f = outputFile;
+ outputFile = FIO_StdOut;
+ doP = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln});
+ l = alists_initList ();
+ alists_includeItemIntoList (l, reinterpret_cast<void *> (n));
+ i = 1;
+ out1 ((const char *) "dbg (%s)\\n", 10, n);
+ do {
+ n = static_cast<decl_node> (alists_getItemFromList (l, i));
+ doDbg (l, n);
+ i += 1;
+ } while (! (i > (alists_noOfItemsInList (l))));
+ doP = o;
+ outputFile = f;
+}
+
+
+/*
+ addGenericBody - adds comment node to funccall, return, assignment
+ nodes.
+*/
+
+static void addGenericBody (decl_node n, decl_node c)
+{
+ switch (n->kind)
+ {
+ case decl_unreachable:
+ case decl_throw:
+ case decl_halt:
+ case decl_new:
+ case decl_dispose:
+ case decl_inc:
+ case decl_dec:
+ case decl_incl:
+ case decl_excl:
+ n->intrinsicF.intrinsicComment.body = c;
+ break;
+
+ case decl_funccall:
+ n->funccallF.funccallComment.body = c;
+ break;
+
+ case decl_return:
+ n->returnF.returnComment.body = c;
+ break;
+
+ case decl_assignment:
+ n->assignmentF.assignComment.body = c;
+ break;
+
+ case decl_module:
+ n->moduleF.com.body = c;
+ break;
+
+ case decl_def:
+ n->defF.com.body = c;
+ break;
+
+ case decl_imp:
+ n->impF.com.body = c;
+ break;
+
+
+ default:
+ break;
+ }
+}
+
+
+/*
+ addGenericAfter - adds comment node to funccall, return, assignment
+ nodes.
+*/
+
+static void addGenericAfter (decl_node n, decl_node c)
+{
+ switch (n->kind)
+ {
+ case decl_unreachable:
+ case decl_throw:
+ case decl_halt:
+ case decl_new:
+ case decl_dispose:
+ case decl_inc:
+ case decl_dec:
+ case decl_incl:
+ case decl_excl:
+ n->intrinsicF.intrinsicComment.after = c;
+ break;
+
+ case decl_funccall:
+ n->funccallF.funccallComment.after = c;
+ break;
+
+ case decl_return:
+ n->returnF.returnComment.after = c;
+ break;
+
+ case decl_assignment:
+ n->assignmentF.assignComment.after = c;
+ break;
+
+ case decl_module:
+ n->moduleF.com.after = c;
+ break;
+
+ case decl_def:
+ n->defF.com.after = c;
+ break;
+
+ case decl_imp:
+ n->impF.com.after = c;
+ break;
+
+
+ default:
+ break;
+ }
+}
+
+
+/*
+ isAssignment -
+*/
+
+static unsigned int isAssignment (decl_node n)
+{
+ return n->kind == decl_assignment;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isComment - returns TRUE if node, n, is a comment.
+*/
+
+static unsigned int isComment (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_comment;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ initPair - initialise the commentPair, c.
+*/
+
+static void initPair (decl_commentPair *c)
+{
+ (*c).after = NULL;
+ (*c).body = NULL;
+}
+
+
+/*
+ dupExplist -
+*/
+
+static decl_node dupExplist (decl_node n)
+{
+ decl_node m;
+ unsigned int i;
+
+ mcDebug_assert (decl_isExpList (n));
+ m = decl_makeExpList ();
+ i = Indexing_LowIndice (n->explistF.exp);
+ while (i <= (Indexing_HighIndice (n->explistF.exp)))
+ {
+ decl_putExpList (m, decl_dupExpr (reinterpret_cast<decl_node> (Indexing_GetIndice (n->explistF.exp, i))));
+ i += 1;
+ }
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dupArrayref -
+*/
+
+static decl_node dupArrayref (decl_node n)
+{
+ mcDebug_assert (isArrayRef (n));
+ return decl_makeArrayRef (decl_dupExpr (n->arrayrefF.array), decl_dupExpr (n->arrayrefF.index));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dupPointerref -
+*/
+
+static decl_node dupPointerref (decl_node n)
+{
+ mcDebug_assert (decl_isPointerRef (n));
+ return decl_makePointerRef (decl_dupExpr (n->pointerrefF.ptr), decl_dupExpr (n->pointerrefF.field));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dupComponentref -
+*/
+
+static decl_node dupComponentref (decl_node n)
+{
+ mcDebug_assert (isComponentRef (n));
+ return doMakeComponentRef (decl_dupExpr (n->componentrefF.rec), decl_dupExpr (n->componentrefF.field));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dupBinary -
+*/
+
+static decl_node dupBinary (decl_node n)
+{
+ /* assert (isBinary (n)) ; */
+ return makeBinary (n->kind, decl_dupExpr (n->binaryF.left), decl_dupExpr (n->binaryF.right), n->binaryF.resultType);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dupUnary -
+*/
+
+static decl_node dupUnary (decl_node n)
+{
+ /* assert (isUnary (n)) ; */
+ return makeUnary (n->kind, decl_dupExpr (n->unaryF.arg), n->unaryF.resultType);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dupFunccall -
+*/
+
+static decl_node dupFunccall (decl_node n)
+{
+ decl_node m;
+
+ mcDebug_assert (isFuncCall (n));
+ m = decl_makeFuncCall (decl_dupExpr (n->funccallF.function), decl_dupExpr (n->funccallF.args));
+ m->funccallF.type = n->funccallF.type;
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dupSetValue -
+*/
+
+static decl_node dupSetValue (decl_node n)
+{
+ decl_node m;
+ unsigned int i;
+
+ m = newNode (decl_setvalue);
+ m->setvalueF.type = n->setvalueF.type;
+ i = Indexing_LowIndice (n->setvalueF.values);
+ while (i <= (Indexing_HighIndice (n->setvalueF.values)))
+ {
+ m = decl_putSetValue (m, decl_dupExpr (reinterpret_cast<decl_node> (Indexing_GetIndice (n->setvalueF.values, i))));
+ i += 1;
+ }
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doDupExpr -
+*/
+
+static decl_node doDupExpr (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ switch (n->kind)
+ {
+ case decl_explist:
+ return dupExplist (n);
+ break;
+
+ case decl_exit:
+ case decl_return:
+ case decl_stmtseq:
+ case decl_comment:
+ M2RTS_HALT (-1); /* should not be duplicating code. */
+ __builtin_unreachable ();
+ break;
+
+ case decl_length:
+ M2RTS_HALT (-1); /* length should have been converted into unary. */
+ __builtin_unreachable ();
+ break;
+
+ case decl_nil:
+ case decl_true:
+ case decl_false:
+ case decl_address:
+ case decl_loc:
+ case decl_byte:
+ case decl_word:
+ case decl_csizet:
+ case decl_cssizet:
+ case decl_boolean:
+ case decl_proc:
+ case decl_char:
+ case decl_integer:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_longint:
+ case decl_shortint:
+ case decl_real:
+ case decl_longreal:
+ case decl_shortreal:
+ case decl_bitset:
+ case decl_ztype:
+ case decl_rtype:
+ case decl_complex:
+ case decl_longcomplex:
+ case decl_shortcomplex:
+ /* base types. */
+ return n;
+ break;
+
+ case decl_type:
+ case decl_record:
+ case decl_varient:
+ case decl_var:
+ case decl_enumeration:
+ case decl_subrange:
+ case decl_subscript:
+ case decl_array:
+ case decl_string:
+ case decl_const:
+ case decl_literal:
+ case decl_varparam:
+ case decl_param:
+ case decl_varargs:
+ case decl_optarg:
+ case decl_pointer:
+ case decl_recordfield:
+ case decl_varientfield:
+ case decl_enumerationfield:
+ case decl_set:
+ case decl_proctype:
+ /* language features and compound type attributes. */
+ return n;
+ break;
+
+ case decl_procedure:
+ case decl_def:
+ case decl_imp:
+ case decl_module:
+ /* blocks. */
+ return n;
+ break;
+
+ case decl_loop:
+ case decl_while:
+ case decl_for:
+ case decl_repeat:
+ case decl_case:
+ case decl_caselabellist:
+ case decl_caselist:
+ case decl_range:
+ case decl_if:
+ case decl_elsif:
+ case decl_assignment:
+ /* statements. */
+ return n;
+ break;
+
+ case decl_arrayref:
+ /* expressions. */
+ return dupArrayref (n);
+ break;
+
+ case decl_pointerref:
+ return dupPointerref (n);
+ break;
+
+ case decl_componentref:
+ return dupComponentref (n);
+ break;
+
+ case decl_cmplx:
+ case decl_and:
+ case decl_or:
+ case decl_equal:
+ case decl_notequal:
+ case decl_less:
+ case decl_greater:
+ case decl_greequal:
+ case decl_lessequal:
+ case decl_cast:
+ case decl_val:
+ case decl_plus:
+ case decl_sub:
+ case decl_div:
+ case decl_mod:
+ case decl_mult:
+ case decl_divide:
+ case decl_in:
+ return dupBinary (n);
+ break;
+
+ case decl_re:
+ case decl_im:
+ case decl_constexp:
+ case decl_deref:
+ case decl_abs:
+ case decl_chr:
+ case decl_cap:
+ case decl_high:
+ case decl_float:
+ case decl_trunc:
+ case decl_ord:
+ case decl_not:
+ case decl_neg:
+ case decl_adr:
+ case decl_size:
+ case decl_tsize:
+ case decl_min:
+ case decl_max:
+ return dupUnary (n);
+ break;
+
+ case decl_identlist:
+ return n;
+ break;
+
+ case decl_vardecl:
+ return n;
+ break;
+
+ case decl_funccall:
+ return dupFunccall (n);
+ break;
+
+ case decl_setvalue:
+ return dupSetValue (n);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeSystem -
+*/
+
+static void makeSystem (void)
+{
+ systemN = decl_lookupDef (nameKey_makeKey ((const char *) "SYSTEM", 6));
+ addressN = makeBase (decl_address);
+ locN = makeBase (decl_loc);
+ byteN = makeBase (decl_byte);
+ wordN = makeBase (decl_word);
+ csizetN = makeBase (decl_csizet);
+ cssizetN = makeBase (decl_cssizet);
+ adrN = makeBase (decl_adr);
+ tsizeN = makeBase (decl_tsize);
+ throwN = makeBase (decl_throw);
+ decl_enterScope (systemN);
+ addressN = addToScope (addressN);
+ locN = addToScope (locN);
+ byteN = addToScope (byteN);
+ wordN = addToScope (wordN);
+ csizetN = addToScope (csizetN);
+ cssizetN = addToScope (cssizetN);
+ adrN = addToScope (adrN);
+ tsizeN = addToScope (tsizeN);
+ throwN = addToScope (throwN);
+ mcDebug_assert (sizeN != NULL); /* assumed to be built already. */
+ sizeN = addToScope (sizeN); /* also export size from system. */
+ decl_leaveScope (); /* also export size from system. */
+ addDone (addressN);
+ addDone (locN);
+ addDone (byteN);
+ addDone (wordN);
+ addDone (csizetN);
+ addDone (cssizetN);
+}
+
+
+/*
+ makeM2rts -
+*/
+
+static void makeM2rts (void)
+{
+ m2rtsN = decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5));
+}
+
+
+/*
+ makeBitnum -
+*/
+
+static decl_node makeBitnum (void)
+{
+ decl_node b;
+
+ b = newNode (decl_subrange);
+ b->subrangeF.type = NULL;
+ b->subrangeF.scope = NULL;
+ b->subrangeF.low = lookupConst (b, nameKey_makeKey ((const char *) "0", 1));
+ b->subrangeF.high = lookupConst (b, nameKey_makeKey ((const char *) "31", 2));
+ return b;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeBaseSymbols -
+*/
+
+static void makeBaseSymbols (void)
+{
+ baseSymbols = symbolKey_initTree ();
+ booleanN = makeBase (decl_boolean);
+ charN = makeBase (decl_char);
+ procN = makeBase (decl_proc);
+ cardinalN = makeBase (decl_cardinal);
+ longcardN = makeBase (decl_longcard);
+ shortcardN = makeBase (decl_shortcard);
+ integerN = makeBase (decl_integer);
+ longintN = makeBase (decl_longint);
+ shortintN = makeBase (decl_shortint);
+ bitsetN = makeBase (decl_bitset);
+ bitnumN = makeBitnum ();
+ ztypeN = makeBase (decl_ztype);
+ rtypeN = makeBase (decl_rtype);
+ complexN = makeBase (decl_complex);
+ longcomplexN = makeBase (decl_longcomplex);
+ shortcomplexN = makeBase (decl_shortcomplex);
+ realN = makeBase (decl_real);
+ longrealN = makeBase (decl_longreal);
+ shortrealN = makeBase (decl_shortreal);
+ nilN = makeBase (decl_nil);
+ trueN = makeBase (decl_true);
+ falseN = makeBase (decl_false);
+ sizeN = makeBase (decl_size);
+ minN = makeBase (decl_min);
+ maxN = makeBase (decl_max);
+ floatN = makeBase (decl_float);
+ truncN = makeBase (decl_trunc);
+ ordN = makeBase (decl_ord);
+ valN = makeBase (decl_val);
+ chrN = makeBase (decl_chr);
+ capN = makeBase (decl_cap);
+ absN = makeBase (decl_abs);
+ newN = makeBase (decl_new);
+ disposeN = makeBase (decl_dispose);
+ lengthN = makeBase (decl_length);
+ incN = makeBase (decl_inc);
+ decN = makeBase (decl_dec);
+ inclN = makeBase (decl_incl);
+ exclN = makeBase (decl_excl);
+ highN = makeBase (decl_high);
+ imN = makeBase (decl_im);
+ reN = makeBase (decl_re);
+ cmplxN = makeBase (decl_cmplx);
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "BOOLEAN", 7), reinterpret_cast<void *> (booleanN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "PROC", 4), reinterpret_cast<void *> (procN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CHAR", 4), reinterpret_cast<void *> (charN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CARDINAL", 8), reinterpret_cast<void *> (cardinalN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTCARD", 9), reinterpret_cast<void *> (shortcardN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGCARD", 8), reinterpret_cast<void *> (longcardN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INTEGER", 7), reinterpret_cast<void *> (integerN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGINT", 7), reinterpret_cast<void *> (longintN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTINT", 8), reinterpret_cast<void *> (shortintN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "BITSET", 6), reinterpret_cast<void *> (bitsetN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "REAL", 4), reinterpret_cast<void *> (realN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTREAL", 9), reinterpret_cast<void *> (shortrealN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGREAL", 8), reinterpret_cast<void *> (longrealN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "COMPLEX", 7), reinterpret_cast<void *> (complexN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LONGCOMPLEX", 11), reinterpret_cast<void *> (longcomplexN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SHORTCOMPLEX", 12), reinterpret_cast<void *> (shortcomplexN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "NIL", 3), reinterpret_cast<void *> (nilN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "TRUE", 4), reinterpret_cast<void *> (trueN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "FALSE", 5), reinterpret_cast<void *> (falseN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "SIZE", 4), reinterpret_cast<void *> (sizeN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "MIN", 3), reinterpret_cast<void *> (minN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "MAX", 3), reinterpret_cast<void *> (maxN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "FLOAT", 5), reinterpret_cast<void *> (floatN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "TRUNC", 5), reinterpret_cast<void *> (truncN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "ORD", 3), reinterpret_cast<void *> (ordN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "VAL", 3), reinterpret_cast<void *> (valN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CHR", 3), reinterpret_cast<void *> (chrN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CAP", 3), reinterpret_cast<void *> (capN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "ABS", 3), reinterpret_cast<void *> (absN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "NEW", 3), reinterpret_cast<void *> (newN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "DISPOSE", 7), reinterpret_cast<void *> (disposeN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "LENGTH", 6), reinterpret_cast<void *> (lengthN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INC", 3), reinterpret_cast<void *> (incN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "DEC", 3), reinterpret_cast<void *> (decN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "INCL", 4), reinterpret_cast<void *> (inclN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "EXCL", 4), reinterpret_cast<void *> (exclN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "HIGH", 4), reinterpret_cast<void *> (highN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "CMPLX", 5), reinterpret_cast<void *> (cmplxN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "RE", 2), reinterpret_cast<void *> (reN));
+ symbolKey_putSymKey (baseSymbols, nameKey_makeKey ((const char *) "IM", 2), reinterpret_cast<void *> (imN));
+ addDone (booleanN);
+ addDone (charN);
+ addDone (cardinalN);
+ addDone (longcardN);
+ addDone (shortcardN);
+ addDone (integerN);
+ addDone (longintN);
+ addDone (shortintN);
+ addDone (bitsetN);
+ addDone (bitnumN);
+ addDone (ztypeN);
+ addDone (rtypeN);
+ addDone (realN);
+ addDone (longrealN);
+ addDone (shortrealN);
+ addDone (complexN);
+ addDone (longcomplexN);
+ addDone (shortcomplexN);
+ addDone (procN);
+ addDone (nilN);
+ addDone (trueN);
+ addDone (falseN);
+}
+
+
+/*
+ makeBuiltins -
+*/
+
+static void makeBuiltins (void)
+{
+ bitsperunitN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "8", 1));
+ bitsperwordN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "32", 2));
+ bitspercharN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "8", 1));
+ unitsperwordN = decl_makeLiteralInt (nameKey_makeKey ((const char *) "4", 1));
+ addDone (bitsperunitN);
+ addDone (bitsperwordN);
+ addDone (bitspercharN);
+ addDone (unitsperwordN);
+}
+
+
+/*
+ init -
+*/
+
+static void init (void)
+{
+ lang = decl_ansiC;
+ outputFile = FIO_StdOut;
+ doP = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln});
+ todoQ = alists_initList ();
+ partialQ = alists_initList ();
+ doneQ = alists_initList ();
+ modUniverse = symbolKey_initTree ();
+ defUniverse = symbolKey_initTree ();
+ modUniverseI = Indexing_InitIndex (1);
+ defUniverseI = Indexing_InitIndex (1);
+ scopeStack = Indexing_InitIndex (1);
+ makeBaseSymbols ();
+ makeSystem ();
+ makeBuiltins ();
+ makeM2rts ();
+ outputState = decl_punct;
+ tempCount = 0;
+ mustVisitScope = FALSE;
+}
+
+
+/*
+ getDeclaredMod - returns the token number associated with the nodes declaration
+ in the implementation or program module.
+*/
+
+extern "C" unsigned int decl_getDeclaredMod (decl_node n)
+{
+ return n->at.modDeclared;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getDeclaredDef - returns the token number associated with the nodes declaration
+ in the definition module.
+*/
+
+extern "C" unsigned int decl_getDeclaredDef (decl_node n)
+{
+ return n->at.defDeclared;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getFirstUsed - returns the token number associated with the first use of
+ node, n.
+*/
+
+extern "C" unsigned int decl_getFirstUsed (decl_node n)
+{
+ return n->at.firstUsed;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isDef - return TRUE if node, n, is a definition module.
+*/
+
+extern "C" unsigned int decl_isDef (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_def;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isImp - return TRUE if node, n, is an implementation module.
+*/
+
+extern "C" unsigned int decl_isImp (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_imp;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isImpOrModule - returns TRUE if, n, is a program module or implementation module.
+*/
+
+extern "C" unsigned int decl_isImpOrModule (decl_node n)
+{
+ return (decl_isImp (n)) || (decl_isModule (n));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isVisited - returns TRUE if the node was visited.
+*/
+
+extern "C" unsigned int decl_isVisited (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_def:
+ return n->defF.visited;
+ break;
+
+ case decl_imp:
+ return n->impF.visited;
+ break;
+
+ case decl_module:
+ return n->moduleF.visited;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ unsetVisited - unset the visited flag on a def/imp/module node.
+*/
+
+extern "C" void decl_unsetVisited (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_def:
+ n->defF.visited = FALSE;
+ break;
+
+ case decl_imp:
+ n->impF.visited = FALSE;
+ break;
+
+ case decl_module:
+ n->moduleF.visited = FALSE;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ setVisited - set the visited flag on a def/imp/module node.
+*/
+
+extern "C" void decl_setVisited (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_def:
+ n->defF.visited = TRUE;
+ break;
+
+ case decl_imp:
+ n->impF.visited = TRUE;
+ break;
+
+ case decl_module:
+ n->moduleF.visited = TRUE;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ setEnumsComplete - sets the field inside the def or imp or module, n.
+*/
+
+extern "C" void decl_setEnumsComplete (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_def:
+ n->defF.enumsComplete = TRUE;
+ break;
+
+ case decl_imp:
+ n->impF.enumsComplete = TRUE;
+ break;
+
+ case decl_module:
+ n->moduleF.enumsComplete = TRUE;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ getEnumsComplete - gets the field from the def or imp or module, n.
+*/
+
+extern "C" unsigned int decl_getEnumsComplete (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_def:
+ return n->defF.enumsComplete;
+ break;
+
+ case decl_imp:
+ return n->impF.enumsComplete;
+ break;
+
+ case decl_module:
+ return n->moduleF.enumsComplete;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ resetEnumPos - resets the index into the saved list of enums inside
+ module, n.
+*/
+
+extern "C" void decl_resetEnumPos (decl_node n)
+{
+ mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n)));
+ if (decl_isDef (n))
+ {
+ n->defF.enumFixup.count = 0;
+ }
+ else if (decl_isImp (n))
+ {
+ /* avoid dangling else. */
+ n->impF.enumFixup.count = 0;
+ }
+ else if (decl_isModule (n))
+ {
+ /* avoid dangling else. */
+ n->moduleF.enumFixup.count = 0;
+ }
+}
+
+
+/*
+ getNextEnum - returns the next enumeration node.
+*/
+
+extern "C" decl_node decl_getNextEnum (void)
+{
+ decl_node n;
+
+ n = NULL;
+ mcDebug_assert (((decl_isDef (currentModule)) || (decl_isImp (currentModule))) || (decl_isModule (currentModule)));
+ if (decl_isDef (currentModule))
+ {
+ n = getNextFixup (¤tModule->defF.enumFixup);
+ }
+ else if (decl_isImp (currentModule))
+ {
+ /* avoid dangling else. */
+ n = getNextFixup (¤tModule->impF.enumFixup);
+ }
+ else if (decl_isModule (currentModule))
+ {
+ /* avoid dangling else. */
+ n = getNextFixup (¤tModule->moduleF.enumFixup);
+ }
+ mcDebug_assert (n != NULL);
+ mcDebug_assert ((decl_isEnumeration (n)) || (decl_isEnumerationField (n)));
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isModule - return TRUE if node, n, is a program module.
+*/
+
+extern "C" unsigned int decl_isModule (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_module;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isMainModule - return TRUE if node, n, is the main module specified
+ by the source file. This might be a definition,
+ implementation or program module.
+*/
+
+extern "C" unsigned int decl_isMainModule (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n == mainModule;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ setMainModule - sets node, n, as the main module to be compiled.
+*/
+
+extern "C" void decl_setMainModule (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ mainModule = n;
+}
+
+
+/*
+ setCurrentModule - sets node, n, as the current module being compiled.
+*/
+
+extern "C" void decl_setCurrentModule (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ currentModule = n;
+}
+
+
+/*
+ lookupDef - returns a definition module node named, n.
+*/
+
+extern "C" decl_node decl_lookupDef (nameKey_Name n)
+{
+ decl_node d;
+
+ d = static_cast<decl_node> (symbolKey_getSymKey (defUniverse, n));
+ if (d == NULL)
+ {
+ d = makeDef (n);
+ symbolKey_putSymKey (defUniverse, n, reinterpret_cast<void *> (d));
+ Indexing_IncludeIndiceIntoIndex (defUniverseI, reinterpret_cast<void *> (d));
+ }
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ lookupImp - returns an implementation module node named, n.
+*/
+
+extern "C" decl_node decl_lookupImp (nameKey_Name n)
+{
+ decl_node m;
+
+ m = static_cast<decl_node> (symbolKey_getSymKey (modUniverse, n));
+ if (m == NULL)
+ {
+ m = makeImp (n);
+ symbolKey_putSymKey (modUniverse, n, reinterpret_cast<void *> (m));
+ Indexing_IncludeIndiceIntoIndex (modUniverseI, reinterpret_cast<void *> (m));
+ }
+ mcDebug_assert (! (decl_isModule (m)));
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ lookupModule - returns a module node named, n.
+*/
+
+extern "C" decl_node decl_lookupModule (nameKey_Name n)
+{
+ decl_node m;
+
+ m = static_cast<decl_node> (symbolKey_getSymKey (modUniverse, n));
+ if (m == NULL)
+ {
+ m = makeModule (n);
+ symbolKey_putSymKey (modUniverse, n, reinterpret_cast<void *> (m));
+ Indexing_IncludeIndiceIntoIndex (modUniverseI, reinterpret_cast<void *> (m));
+ }
+ mcDebug_assert (! (decl_isImp (m)));
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putDefForC - the definition module was defined FOR "C".
+*/
+
+extern "C" void decl_putDefForC (decl_node n)
+{
+ mcDebug_assert (decl_isDef (n));
+ n->defF.forC = TRUE;
+}
+
+
+/*
+ lookupInScope - looks up a symbol named, n, from, scope.
+*/
+
+extern "C" decl_node decl_lookupInScope (decl_node scope, nameKey_Name n)
+{
+ switch (scope->kind)
+ {
+ case decl_def:
+ return static_cast<decl_node> (symbolKey_getSymKey (scope->defF.decls.symbols, n));
+ break;
+
+ case decl_module:
+ return static_cast<decl_node> (symbolKey_getSymKey (scope->moduleF.decls.symbols, n));
+ break;
+
+ case decl_imp:
+ return static_cast<decl_node> (symbolKey_getSymKey (scope->impF.decls.symbols, n));
+ break;
+
+ case decl_procedure:
+ return static_cast<decl_node> (symbolKey_getSymKey (scope->procedureF.decls.symbols, n));
+ break;
+
+ case decl_record:
+ return static_cast<decl_node> (symbolKey_getSymKey (scope->recordF.localSymbols, n));
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isConst - returns TRUE if node, n, is a const.
+*/
+
+extern "C" unsigned int decl_isConst (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_const;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isType - returns TRUE if node, n, is a type.
+*/
+
+extern "C" unsigned int decl_isType (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_type;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putType - places, exp, as the type alias to des.
+ TYPE des = exp ;
+*/
+
+extern "C" void decl_putType (decl_node des, decl_node exp)
+{
+ mcDebug_assert (des != NULL);
+ mcDebug_assert (decl_isType (des));
+ des->typeF.type = exp;
+}
+
+
+/*
+ getType - returns the type associated with node, n.
+*/
+
+extern "C" decl_node decl_getType (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_new:
+ case decl_dispose:
+ return NULL;
+ break;
+
+ case decl_length:
+ return cardinalN;
+ break;
+
+ case decl_inc:
+ case decl_dec:
+ case decl_incl:
+ case decl_excl:
+ return NULL;
+ break;
+
+ case decl_nil:
+ return addressN;
+ break;
+
+ case decl_true:
+ case decl_false:
+ return booleanN;
+ break;
+
+ case decl_address:
+ return n;
+ break;
+
+ case decl_loc:
+ return n;
+ break;
+
+ case decl_byte:
+ return n;
+ break;
+
+ case decl_word:
+ return n;
+ break;
+
+ case decl_csizet:
+ return n;
+ break;
+
+ case decl_cssizet:
+ return n;
+ break;
+
+ case decl_boolean:
+ /* base types. */
+ return n;
+ break;
+
+ case decl_proc:
+ return n;
+ break;
+
+ case decl_char:
+ return n;
+ break;
+
+ case decl_cardinal:
+ return n;
+ break;
+
+ case decl_longcard:
+ return n;
+ break;
+
+ case decl_shortcard:
+ return n;
+ break;
+
+ case decl_integer:
+ return n;
+ break;
+
+ case decl_longint:
+ return n;
+ break;
+
+ case decl_shortint:
+ return n;
+ break;
+
+ case decl_real:
+ return n;
+ break;
+
+ case decl_longreal:
+ return n;
+ break;
+
+ case decl_shortreal:
+ return n;
+ break;
+
+ case decl_bitset:
+ return n;
+ break;
+
+ case decl_ztype:
+ return n;
+ break;
+
+ case decl_rtype:
+ return n;
+ break;
+
+ case decl_complex:
+ return n;
+ break;
+
+ case decl_longcomplex:
+ return n;
+ break;
+
+ case decl_shortcomplex:
+ return n;
+ break;
+
+ case decl_type:
+ /* language features and compound type attributes. */
+ return n->typeF.type;
+ break;
+
+ case decl_record:
+ return n;
+ break;
+
+ case decl_varient:
+ return n;
+ break;
+
+ case decl_var:
+ return n->varF.type;
+ break;
+
+ case decl_enumeration:
+ return n;
+ break;
+
+ case decl_subrange:
+ return n->subrangeF.type;
+ break;
+
+ case decl_array:
+ return n->arrayF.type;
+ break;
+
+ case decl_string:
+ return charN;
+ break;
+
+ case decl_const:
+ return n->constF.type;
+ break;
+
+ case decl_literal:
+ return n->literalF.type;
+ break;
+
+ case decl_varparam:
+ return n->varparamF.type;
+ break;
+
+ case decl_param:
+ return n->paramF.type;
+ break;
+
+ case decl_optarg:
+ return n->optargF.type;
+ break;
+
+ case decl_pointer:
+ return n->pointerF.type;
+ break;
+
+ case decl_recordfield:
+ return n->recordfieldF.type;
+ break;
+
+ case decl_varientfield:
+ return n;
+ break;
+
+ case decl_enumerationfield:
+ return n->enumerationfieldF.type;
+ break;
+
+ case decl_set:
+ return n->setF.type;
+ break;
+
+ case decl_proctype:
+ return n->proctypeF.returnType;
+ break;
+
+ case decl_subscript:
+ return n->subscriptF.type;
+ break;
+
+ case decl_procedure:
+ /* blocks. */
+ return n->procedureF.returnType;
+ break;
+
+ case decl_throw:
+ return NULL;
+ break;
+
+ case decl_unreachable:
+ return NULL;
+ break;
+
+ case decl_def:
+ case decl_imp:
+ case decl_module:
+ case decl_loop:
+ case decl_while:
+ case decl_for:
+ case decl_repeat:
+ case decl_if:
+ case decl_elsif:
+ case decl_assignment:
+ /* statements. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ break;
+
+ case decl_cmplx:
+ case decl_cast:
+ case decl_val:
+ case decl_plus:
+ case decl_sub:
+ case decl_div:
+ case decl_mod:
+ case decl_mult:
+ case decl_divide:
+ /* expressions. */
+ return n->binaryF.resultType;
+ break;
+
+ case decl_in:
+ return booleanN;
+ break;
+
+ case decl_max:
+ case decl_min:
+ case decl_re:
+ case decl_im:
+ case decl_abs:
+ case decl_constexp:
+ case decl_deref:
+ case decl_neg:
+ case decl_adr:
+ case decl_size:
+ case decl_tsize:
+ return n->unaryF.resultType;
+ break;
+
+ case decl_and:
+ case decl_or:
+ case decl_not:
+ case decl_equal:
+ case decl_notequal:
+ case decl_less:
+ case decl_greater:
+ case decl_greequal:
+ case decl_lessequal:
+ return booleanN;
+ break;
+
+ case decl_trunc:
+ return integerN;
+ break;
+
+ case decl_float:
+ return realN;
+ break;
+
+ case decl_high:
+ return cardinalN;
+ break;
+
+ case decl_ord:
+ return cardinalN;
+ break;
+
+ case decl_chr:
+ return charN;
+ break;
+
+ case decl_cap:
+ return charN;
+ break;
+
+ case decl_arrayref:
+ return n->arrayrefF.resultType;
+ break;
+
+ case decl_componentref:
+ return n->componentrefF.resultType;
+ break;
+
+ case decl_pointerref:
+ return n->pointerrefF.resultType;
+ break;
+
+ case decl_funccall:
+ return n->funccallF.type;
+ break;
+
+ case decl_setvalue:
+ return n->setvalueF.type;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ skipType - skips over type aliases.
+*/
+
+extern "C" decl_node decl_skipType (decl_node n)
+{
+ while ((n != NULL) && (decl_isType (n)))
+ {
+ if ((decl_getType (n)) == NULL)
+ {
+ /* this will occur if, n, is an opaque type. */
+ return n;
+ }
+ n = decl_getType (n);
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putTypeHidden - marks type, des, as being a hidden type.
+ TYPE des ;
+*/
+
+extern "C" void decl_putTypeHidden (decl_node des)
+{
+ decl_node s;
+
+ mcDebug_assert (des != NULL);
+ mcDebug_assert (decl_isType (des));
+ des->typeF.isHidden = TRUE;
+ s = decl_getScope (des);
+ mcDebug_assert (decl_isDef (s));
+ s->defF.hasHidden = TRUE;
+}
+
+
+/*
+ isTypeHidden - returns TRUE if type, n, is hidden.
+*/
+
+extern "C" unsigned int decl_isTypeHidden (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ mcDebug_assert (decl_isType (n));
+ return n->typeF.isHidden;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ hasHidden - returns TRUE if module, n, has a hidden type.
+*/
+
+extern "C" unsigned int decl_hasHidden (decl_node n)
+{
+ mcDebug_assert (decl_isDef (n));
+ return n->defF.hasHidden;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isVar - returns TRUE if node, n, is a type.
+*/
+
+extern "C" unsigned int decl_isVar (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_var;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isTemporary - returns TRUE if node, n, is a variable and temporary.
+*/
+
+extern "C" unsigned int decl_isTemporary (decl_node n)
+{
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isExported - returns TRUE if symbol, n, is exported from
+ the definition module.
+*/
+
+extern "C" unsigned int decl_isExported (decl_node n)
+{
+ decl_node s;
+
+ s = decl_getScope (n);
+ if (s != NULL)
+ {
+ switch (s->kind)
+ {
+ case decl_def:
+ return Indexing_IsIndiceInIndex (s->defF.exported, reinterpret_cast<void *> (n));
+ break;
+
+
+ default:
+ return FALSE;
+ break;
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getDeclScope - returns the node representing the
+ current declaration scope.
+*/
+
+extern "C" decl_node decl_getDeclScope (void)
+{
+ unsigned int i;
+
+ i = Indexing_HighIndice (scopeStack);
+ return static_cast<decl_node> (Indexing_GetIndice (scopeStack, i));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getScope - returns the scope associated with node, n.
+*/
+
+extern "C" decl_node decl_getScope (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_stmtseq:
+ case decl_exit:
+ case decl_return:
+ case decl_comment:
+ case decl_identlist:
+ case decl_setvalue:
+ case decl_halt:
+ case decl_new:
+ case decl_dispose:
+ case decl_length:
+ case decl_inc:
+ case decl_dec:
+ case decl_incl:
+ case decl_excl:
+ case decl_nil:
+ case decl_true:
+ case decl_false:
+ return NULL;
+ break;
+
+ case decl_address:
+ case decl_loc:
+ case decl_byte:
+ case decl_word:
+ case decl_csizet:
+ case decl_cssizet:
+ return systemN;
+ break;
+
+ case decl_boolean:
+ case decl_proc:
+ case decl_char:
+ case decl_cardinal:
+ case decl_longcard:
+ case decl_shortcard:
+ case decl_integer:
+ case decl_longint:
+ case decl_shortint:
+ case decl_real:
+ case decl_longreal:
+ case decl_shortreal:
+ case decl_bitset:
+ case decl_ztype:
+ case decl_rtype:
+ case decl_complex:
+ case decl_longcomplex:
+ case decl_shortcomplex:
+ /* base types. */
+ return NULL;
+ break;
+
+ case decl_type:
+ /* language features and compound type attributes. */
+ return n->typeF.scope;
+ break;
+
+ case decl_record:
+ return n->recordF.scope;
+ break;
+
+ case decl_varient:
+ return n->varientF.scope;
+ break;
+
+ case decl_var:
+ return n->varF.scope;
+ break;
+
+ case decl_enumeration:
+ return n->enumerationF.scope;
+ break;
+
+ case decl_subrange:
+ return n->subrangeF.scope;
+ break;
+
+ case decl_array:
+ return n->arrayF.scope;
+ break;
+
+ case decl_string:
+ return NULL;
+ break;
+
+ case decl_const:
+ return n->constF.scope;
+ break;
+
+ case decl_literal:
+ return NULL;
+ break;
+
+ case decl_varparam:
+ return n->varparamF.scope;
+ break;
+
+ case decl_param:
+ return n->paramF.scope;
+ break;
+
+ case decl_optarg:
+ return n->optargF.scope;
+ break;
+
+ case decl_pointer:
+ return n->pointerF.scope;
+ break;
+
+ case decl_recordfield:
+ return n->recordfieldF.scope;
+ break;
+
+ case decl_varientfield:
+ return n->varientfieldF.scope;
+ break;
+
+ case decl_enumerationfield:
+ return n->enumerationfieldF.scope;
+ break;
+
+ case decl_set:
+ return n->setF.scope;
+ break;
+
+ case decl_proctype:
+ return n->proctypeF.scope;
+ break;
+
+ case decl_subscript:
+ return NULL;
+ break;
+
+ case decl_procedure:
+ /* blocks. */
+ return n->procedureF.scope;
+ break;
+
+ case decl_def:
+ case decl_imp:
+ case decl_module:
+ case decl_case:
+ case decl_loop:
+ case decl_while:
+ case decl_for:
+ case decl_repeat:
+ case decl_if:
+ case decl_elsif:
+ case decl_assignment:
+ /* statements. */
+ return NULL;
+ break;
+
+ case decl_componentref:
+ case decl_pointerref:
+ case decl_arrayref:
+ case decl_chr:
+ case decl_cap:
+ case decl_ord:
+ case decl_float:
+ case decl_trunc:
+ case decl_high:
+ case decl_cast:
+ case decl_val:
+ case decl_plus:
+ case decl_sub:
+ case decl_div:
+ case decl_mod:
+ case decl_mult:
+ case decl_divide:
+ case decl_in:
+ /* expressions. */
+ return NULL;
+ break;
+
+ case decl_neg:
+ return NULL;
+ break;
+
+ case decl_lsl:
+ case decl_lsr:
+ case decl_lor:
+ case decl_land:
+ case decl_lnot:
+ case decl_lxor:
+ case decl_and:
+ case decl_or:
+ case decl_not:
+ case decl_constexp:
+ case decl_deref:
+ case decl_equal:
+ case decl_notequal:
+ case decl_less:
+ case decl_greater:
+ case decl_greequal:
+ case decl_lessequal:
+ return NULL;
+ break;
+
+ case decl_adr:
+ case decl_size:
+ case decl_tsize:
+ case decl_throw:
+ return systemN;
+ break;
+
+ case decl_unreachable:
+ case decl_cmplx:
+ case decl_re:
+ case decl_im:
+ case decl_min:
+ case decl_max:
+ return NULL;
+ break;
+
+ case decl_vardecl:
+ return n->vardeclF.scope;
+ break;
+
+ case decl_funccall:
+ return NULL;
+ break;
+
+ case decl_explist:
+ return NULL;
+ break;
+
+ case decl_caselabellist:
+ return NULL;
+ break;
+
+ case decl_caselist:
+ return NULL;
+ break;
+
+ case decl_range:
+ return NULL;
+ break;
+
+ case decl_varargs:
+ return n->varargsF.scope;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isLiteral - returns TRUE if, n, is a literal.
+*/
+
+extern "C" unsigned int decl_isLiteral (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_literal;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isConstSet - returns TRUE if, n, is a constant set.
+*/
+
+extern "C" unsigned int decl_isConstSet (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ if ((decl_isLiteral (n)) || (decl_isConst (n)))
+ {
+ return decl_isSet (decl_skipType (decl_getType (n)));
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isEnumerationField - returns TRUE if, n, is an enumeration field.
+*/
+
+extern "C" unsigned int decl_isEnumerationField (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_enumerationfield;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isEnumeration - returns TRUE if node, n, is an enumeration type.
+*/
+
+extern "C" unsigned int decl_isEnumeration (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_enumeration;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isUnbounded - returns TRUE if, n, is an unbounded array.
+*/
+
+extern "C" unsigned int decl_isUnbounded (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return (n->kind == decl_array) && n->arrayF.isUnbounded;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isParameter - returns TRUE if, n, is a parameter.
+*/
+
+extern "C" unsigned int decl_isParameter (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return (n->kind == decl_param) || (n->kind == decl_varparam);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isVarParam - returns TRUE if, n, is a var parameter.
+*/
+
+extern "C" unsigned int decl_isVarParam (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_varparam;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isParam - returns TRUE if, n, is a non var parameter.
+*/
+
+extern "C" unsigned int decl_isParam (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_param;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isNonVarParam - is an alias to isParam.
+*/
+
+extern "C" unsigned int decl_isNonVarParam (decl_node n)
+{
+ return decl_isParam (n);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addOptParameter - returns an optarg which has been created and added to
+ procedure node, proc. It has a name, id, and, type,
+ and an initial value, init.
+*/
+
+extern "C" decl_node decl_addOptParameter (decl_node proc, nameKey_Name id, decl_node type, decl_node init)
+{
+ decl_node p;
+ decl_node l;
+
+ mcDebug_assert (decl_isProcedure (proc));
+ l = decl_makeIdentList ();
+ mcDebug_assert (decl_putIdent (l, id));
+ checkMakeVariables (proc, l, type, FALSE, TRUE);
+ if (! proc->procedureF.checking)
+ {
+ p = makeOptParameter (l, type, init);
+ decl_addParameter (proc, p);
+ }
+ return p;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isOptarg - returns TRUE if, n, is an optarg.
+*/
+
+extern "C" unsigned int decl_isOptarg (decl_node n)
+{
+ return n->kind == decl_optarg;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isRecord - returns TRUE if, n, is a record.
+*/
+
+extern "C" unsigned int decl_isRecord (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_record;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isRecordField - returns TRUE if, n, is a record field.
+*/
+
+extern "C" unsigned int decl_isRecordField (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_recordfield;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isVarientField - returns TRUE if, n, is a varient field.
+*/
+
+extern "C" unsigned int decl_isVarientField (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_varientfield;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isArray - returns TRUE if, n, is an array.
+*/
+
+extern "C" unsigned int decl_isArray (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_array;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isProcType - returns TRUE if, n, is a procedure type.
+*/
+
+extern "C" unsigned int decl_isProcType (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_proctype;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isPointer - returns TRUE if, n, is a pointer.
+*/
+
+extern "C" unsigned int decl_isPointer (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_pointer;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isProcedure - returns TRUE if, n, is a procedure.
+*/
+
+extern "C" unsigned int decl_isProcedure (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_procedure;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isVarient - returns TRUE if, n, is a varient record.
+*/
+
+extern "C" unsigned int decl_isVarient (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_varient;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isSet - returns TRUE if, n, is a set type.
+*/
+
+extern "C" unsigned int decl_isSet (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_set;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isSubrange - returns TRUE if, n, is a subrange type.
+*/
+
+extern "C" unsigned int decl_isSubrange (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_subrange;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isZtype - returns TRUE if, n, is the Z type.
+*/
+
+extern "C" unsigned int decl_isZtype (decl_node n)
+{
+ return n == ztypeN;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isRtype - returns TRUE if, n, is the R type.
+*/
+
+extern "C" unsigned int decl_isRtype (decl_node n)
+{
+ return n == rtypeN;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeConst - create, initialise and return a const node.
+*/
+
+extern "C" decl_node decl_makeConst (nameKey_Name n)
+{
+ decl_node d;
+
+ d = newNode (decl_const);
+ d->constF.name = n;
+ d->constF.type = NULL;
+ d->constF.scope = decl_getDeclScope ();
+ d->constF.value = NULL;
+ return addToScope (d);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putConst - places value, v, into node, n.
+*/
+
+extern "C" void decl_putConst (decl_node n, decl_node v)
+{
+ mcDebug_assert (decl_isConst (n));
+ n->constF.value = v;
+}
+
+
+/*
+ makeType - create, initialise and return a type node.
+*/
+
+extern "C" decl_node decl_makeType (nameKey_Name n)
+{
+ decl_node d;
+
+ d = newNode (decl_type);
+ d->typeF.name = n;
+ d->typeF.type = NULL;
+ d->typeF.scope = decl_getDeclScope ();
+ d->typeF.isHidden = FALSE;
+ d->typeF.isInternal = FALSE;
+ return addToScope (d);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeTypeImp - lookup a type in the definition module
+ and return it. Otherwise create a new type.
+*/
+
+extern "C" decl_node decl_makeTypeImp (nameKey_Name n)
+{
+ decl_node d;
+
+ d = decl_lookupSym (n);
+ if (d != NULL)
+ {
+ d->typeF.isHidden = FALSE;
+ return addToScope (d);
+ }
+ else
+ {
+ d = newNode (decl_type);
+ d->typeF.name = n;
+ d->typeF.type = NULL;
+ d->typeF.scope = decl_getDeclScope ();
+ d->typeF.isHidden = FALSE;
+ return addToScope (d);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeVar - create, initialise and return a var node.
+*/
+
+extern "C" decl_node decl_makeVar (nameKey_Name n)
+{
+ decl_node d;
+
+ d = newNode (decl_var);
+ d->varF.name = n;
+ d->varF.type = NULL;
+ d->varF.decl = NULL;
+ d->varF.scope = decl_getDeclScope ();
+ d->varF.isInitialised = FALSE;
+ d->varF.isParameter = FALSE;
+ d->varF.isVarParameter = FALSE;
+ initCname (&d->varF.cname);
+ return addToScope (d);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putVar - places, type, as the type for var.
+*/
+
+extern "C" void decl_putVar (decl_node var, decl_node type, decl_node decl)
+{
+ mcDebug_assert (var != NULL);
+ mcDebug_assert (decl_isVar (var));
+ var->varF.type = type;
+ var->varF.decl = decl;
+}
+
+
+/*
+ makeVarDecl - create a vardecl node and create a shadow variable in the
+ current scope.
+*/
+
+extern "C" decl_node decl_makeVarDecl (decl_node i, decl_node type)
+{
+ decl_node d;
+ decl_node v;
+ unsigned int j;
+ unsigned int n;
+
+ type = checkPtr (type);
+ d = newNode (decl_vardecl);
+ d->vardeclF.names = i->identlistF.names;
+ d->vardeclF.type = type;
+ d->vardeclF.scope = decl_getDeclScope ();
+ n = wlists_noOfItemsInList (d->vardeclF.names);
+ j = 1;
+ while (j <= n)
+ {
+ v = decl_lookupSym (wlists_getItemFromList (d->vardeclF.names, j));
+ mcDebug_assert (decl_isVar (v));
+ decl_putVar (v, type, d);
+ j += 1;
+ }
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeEnum - creates an enumerated type and returns the node.
+*/
+
+extern "C" decl_node decl_makeEnum (void)
+{
+ if ((currentModule != NULL) && (decl_getEnumsComplete (currentModule)))
+ {
+ return decl_getNextEnum ();
+ }
+ else
+ {
+ return doMakeEnum ();
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeEnumField - returns an enumeration field, named, n.
+*/
+
+extern "C" decl_node decl_makeEnumField (decl_node e, nameKey_Name n)
+{
+ if ((currentModule != NULL) && (decl_getEnumsComplete (currentModule)))
+ {
+ return decl_getNextEnum ();
+ }
+ else
+ {
+ return doMakeEnumField (e, n);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeSubrange - returns a subrange node, built from range: low..high.
+*/
+
+extern "C" decl_node decl_makeSubrange (decl_node low, decl_node high)
+{
+ decl_node n;
+
+ n = newNode (decl_subrange);
+ n->subrangeF.low = low;
+ n->subrangeF.high = high;
+ n->subrangeF.type = NULL;
+ n->subrangeF.scope = decl_getDeclScope ();
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putSubrangeType - assigns, type, to the subrange type, sub.
+*/
+
+extern "C" void decl_putSubrangeType (decl_node sub, decl_node type)
+{
+ mcDebug_assert (decl_isSubrange (sub));
+ sub->subrangeF.type = type;
+}
+
+
+/*
+ makePointer - returns a pointer of, type, node.
+*/
+
+extern "C" decl_node decl_makePointer (decl_node type)
+{
+ decl_node n;
+
+ n = newNode (decl_pointer);
+ n->pointerF.type = type;
+ n->pointerF.scope = decl_getDeclScope ();
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeSet - returns a set of, type, node.
+*/
+
+extern "C" decl_node decl_makeSet (decl_node type)
+{
+ decl_node n;
+
+ n = newNode (decl_set);
+ n->setF.type = type;
+ n->setF.scope = decl_getDeclScope ();
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeArray - returns a node representing ARRAY subr OF type.
+*/
+
+extern "C" decl_node decl_makeArray (decl_node subr, decl_node type)
+{
+ decl_node n;
+ decl_node s;
+
+ s = decl_skipType (subr);
+ mcDebug_assert (((decl_isSubrange (s)) || (isOrdinal (s))) || (decl_isEnumeration (s)));
+ n = newNode (decl_array);
+ n->arrayF.subr = subr;
+ n->arrayF.type = type;
+ n->arrayF.scope = decl_getDeclScope ();
+ n->arrayF.isUnbounded = FALSE;
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putUnbounded - sets array, n, as unbounded.
+*/
+
+extern "C" void decl_putUnbounded (decl_node n)
+{
+ mcDebug_assert (n->kind == decl_array);
+ n->arrayF.isUnbounded = TRUE;
+}
+
+
+/*
+ makeRecord - creates and returns a record node.
+*/
+
+extern "C" decl_node decl_makeRecord (void)
+{
+ decl_node n;
+
+ n = newNode (decl_record);
+ n->recordF.localSymbols = symbolKey_initTree ();
+ n->recordF.listOfSons = Indexing_InitIndex (1);
+ n->recordF.scope = decl_getDeclScope ();
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeVarient - creates a new symbol, a varient symbol for record or varient field
+ symbol, r.
+*/
+
+extern "C" decl_node decl_makeVarient (decl_node r)
+{
+ decl_node n;
+
+ n = newNode (decl_varient);
+ n->varientF.listOfSons = Indexing_InitIndex (1);
+ /* if so use this n^.varientF.parent := r */
+ if (decl_isRecord (r))
+ {
+ n->varientF.varient = NULL;
+ }
+ else
+ {
+ n->varientF.varient = r;
+ }
+ n->varientF.tag = NULL;
+ n->varientF.scope = decl_getDeclScope ();
+ switch (r->kind)
+ {
+ case decl_record:
+ /* now add, n, to the record/varient, r, field list */
+ Indexing_IncludeIndiceIntoIndex (r->recordF.listOfSons, reinterpret_cast<void *> (n));
+ break;
+
+ case decl_varientfield:
+ Indexing_IncludeIndiceIntoIndex (r->varientfieldF.listOfSons, reinterpret_cast<void *> (n));
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addFieldsToRecord - adds fields, i, of type, t, into a record, r.
+ It returns, r.
+*/
+
+extern "C" decl_node decl_addFieldsToRecord (decl_node r, decl_node v, decl_node i, decl_node t)
+{
+ decl_node p;
+ decl_node fj;
+ unsigned int j;
+ unsigned int n;
+ nameKey_Name fn;
+
+ if (decl_isRecord (r))
+ {
+ p = r;
+ v = NULL;
+ }
+ else
+ {
+ p = getRecord (getParent (r));
+ mcDebug_assert (decl_isVarientField (r));
+ mcDebug_assert (decl_isVarient (v));
+ putFieldVarient (r, v);
+ }
+ n = wlists_noOfItemsInList (i->identlistF.names);
+ j = 1;
+ while (j <= n)
+ {
+ fn = static_cast<nameKey_Name> (wlists_getItemFromList (i->identlistF.names, j));
+ fj = static_cast<decl_node> (symbolKey_getSymKey (p->recordF.localSymbols, n));
+ if (fj == NULL)
+ {
+ fj = putFieldRecord (r, fn, t, v);
+ }
+ else
+ {
+ mcMetaError_metaErrors2 ((const char *) "record field {%1ad} has already been declared inside a {%2Dd} {%2a}", 67, (const char *) "attempting to declare a duplicate record field", 46, (const unsigned char *) &fj, (sizeof (fj)-1), (const unsigned char *) &p, (sizeof (p)-1));
+ }
+ j += 1;
+ }
+ return r;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ buildVarientSelector - builds a field of name, tag, of, type onto:
+ record or varient field, r.
+ varient, v.
+*/
+
+extern "C" void decl_buildVarientSelector (decl_node r, decl_node v, nameKey_Name tag, decl_node type)
+{
+ decl_node f;
+
+ mcDebug_assert ((decl_isRecord (r)) || (decl_isVarientField (r)));
+ if ((decl_isRecord (r)) || (decl_isVarientField (r)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((type == NULL) && (tag == nameKey_NulName))
+ {
+ mcMetaError_metaError1 ((const char *) "expecting a tag field in the declaration of a varient record {%1Ua}", 67, (const unsigned char *) &r, (sizeof (r)-1));
+ }
+ else if (type == NULL)
+ {
+ /* avoid dangling else. */
+ f = decl_lookupSym (tag);
+ putVarientTag (v, f);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ f = putFieldRecord (r, tag, type, v);
+ mcDebug_assert (decl_isRecordField (f));
+ f->recordfieldF.tag = TRUE;
+ putVarientTag (v, f);
+ }
+ }
+}
+
+
+/*
+ buildVarientFieldRecord - builds a varient field into a varient symbol, v.
+ The varient field is returned.
+*/
+
+extern "C" decl_node decl_buildVarientFieldRecord (decl_node v, decl_node p)
+{
+ decl_node f;
+
+ mcDebug_assert (decl_isVarient (v));
+ f = makeVarientField (v, p);
+ mcDebug_assert (decl_isVarientField (f));
+ putFieldVarient (f, v);
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getSymName - returns the name of symbol, n.
+*/
+
+extern "C" nameKey_Name decl_getSymName (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_new:
+ return nameKey_makeKey ((const char *) "NEW", 3);
+ break;
+
+ case decl_dispose:
+ return nameKey_makeKey ((const char *) "DISPOSE", 7);
+ break;
+
+ case decl_length:
+ return nameKey_makeKey ((const char *) "LENGTH", 6);
+ break;
+
+ case decl_inc:
+ return nameKey_makeKey ((const char *) "INC", 3);
+ break;
+
+ case decl_dec:
+ return nameKey_makeKey ((const char *) "DEC", 3);
+ break;
+
+ case decl_incl:
+ return nameKey_makeKey ((const char *) "INCL", 4);
+ break;
+
+ case decl_excl:
+ return nameKey_makeKey ((const char *) "EXCL", 4);
+ break;
+
+ case decl_nil:
+ return nameKey_makeKey ((const char *) "NIL", 3);
+ break;
+
+ case decl_true:
+ return nameKey_makeKey ((const char *) "TRUE", 4);
+ break;
+
+ case decl_false:
+ return nameKey_makeKey ((const char *) "FALSE", 5);
+ break;
+
+ case decl_address:
+ return nameKey_makeKey ((const char *) "ADDRESS", 7);
+ break;
+
+ case decl_loc:
+ return nameKey_makeKey ((const char *) "LOC", 3);
+ break;
+
+ case decl_byte:
+ return nameKey_makeKey ((const char *) "BYTE", 4);
+ break;
+
+ case decl_word:
+ return nameKey_makeKey ((const char *) "WORD", 4);
+ break;
+
+ case decl_csizet:
+ return nameKey_makeKey ((const char *) "CSIZE_T", 7);
+ break;
+
+ case decl_cssizet:
+ return nameKey_makeKey ((const char *) "CSSIZE_T", 8);
+ break;
+
+ case decl_boolean:
+ /* base types. */
+ return nameKey_makeKey ((const char *) "BOOLEAN", 7);
+ break;
+
+ case decl_proc:
+ return nameKey_makeKey ((const char *) "PROC", 4);
+ break;
+
+ case decl_char:
+ return nameKey_makeKey ((const char *) "CHAR", 4);
+ break;
+
+ case decl_cardinal:
+ return nameKey_makeKey ((const char *) "CARDINAL", 8);
+ break;
+
+ case decl_longcard:
+ return nameKey_makeKey ((const char *) "LONGCARD", 8);
+ break;
+
+ case decl_shortcard:
+ return nameKey_makeKey ((const char *) "SHORTCARD", 9);
+ break;
+
+ case decl_integer:
+ return nameKey_makeKey ((const char *) "INTEGER", 7);
+ break;
+
+ case decl_longint:
+ return nameKey_makeKey ((const char *) "LONGINT", 7);
+ break;
+
+ case decl_shortint:
+ return nameKey_makeKey ((const char *) "SHORTINT", 8);
+ break;
+
+ case decl_real:
+ return nameKey_makeKey ((const char *) "REAL", 4);
+ break;
+
+ case decl_longreal:
+ return nameKey_makeKey ((const char *) "LONGREAL", 8);
+ break;
+
+ case decl_shortreal:
+ return nameKey_makeKey ((const char *) "SHORTREAL", 9);
+ break;
+
+ case decl_bitset:
+ return nameKey_makeKey ((const char *) "BITSET", 6);
+ break;
+
+ case decl_ztype:
+ return nameKey_makeKey ((const char *) "_ZTYPE", 6);
+ break;
+
+ case decl_rtype:
+ return nameKey_makeKey ((const char *) "_RTYPE", 6);
+ break;
+
+ case decl_complex:
+ return nameKey_makeKey ((const char *) "COMPLEX", 7);
+ break;
+
+ case decl_longcomplex:
+ return nameKey_makeKey ((const char *) "LONGCOMPLEX", 11);
+ break;
+
+ case decl_shortcomplex:
+ return nameKey_makeKey ((const char *) "SHORTCOMPLEX", 12);
+ break;
+
+ case decl_type:
+ /* language features and compound type attributes. */
+ return n->typeF.name;
+ break;
+
+ case decl_record:
+ return nameKey_NulName;
+ break;
+
+ case decl_varient:
+ return nameKey_NulName;
+ break;
+
+ case decl_var:
+ return n->varF.name;
+ break;
+
+ case decl_enumeration:
+ return nameKey_NulName;
+ break;
+
+ case decl_subrange:
+ return nameKey_NulName;
+ break;
+
+ case decl_pointer:
+ return nameKey_NulName;
+ break;
+
+ case decl_array:
+ return nameKey_NulName;
+ break;
+
+ case decl_string:
+ return n->stringF.name;
+ break;
+
+ case decl_const:
+ return n->constF.name;
+ break;
+
+ case decl_literal:
+ return n->literalF.name;
+ break;
+
+ case decl_varparam:
+ return nameKey_NulName;
+ break;
+
+ case decl_param:
+ return nameKey_NulName;
+ break;
+
+ case decl_optarg:
+ return nameKey_NulName;
+ break;
+
+ case decl_recordfield:
+ return n->recordfieldF.name;
+ break;
+
+ case decl_varientfield:
+ return n->varientfieldF.name;
+ break;
+
+ case decl_enumerationfield:
+ return n->enumerationfieldF.name;
+ break;
+
+ case decl_set:
+ return nameKey_NulName;
+ break;
+
+ case decl_proctype:
+ return nameKey_NulName;
+ break;
+
+ case decl_subscript:
+ return nameKey_NulName;
+ break;
+
+ case decl_procedure:
+ /* blocks. */
+ return n->procedureF.name;
+ break;
+
+ case decl_def:
+ return n->defF.name;
+ break;
+
+ case decl_imp:
+ return n->impF.name;
+ break;
+
+ case decl_module:
+ return n->moduleF.name;
+ break;
+
+ case decl_loop:
+ case decl_while:
+ case decl_for:
+ case decl_repeat:
+ case decl_if:
+ case decl_elsif:
+ case decl_assignment:
+ /* statements. */
+ return nameKey_NulName;
+ break;
+
+ case decl_constexp:
+ case decl_deref:
+ case decl_arrayref:
+ case decl_componentref:
+ case decl_cast:
+ case decl_val:
+ case decl_plus:
+ case decl_sub:
+ case decl_div:
+ case decl_mod:
+ case decl_mult:
+ case decl_divide:
+ case decl_in:
+ case decl_neg:
+ case decl_equal:
+ case decl_notequal:
+ case decl_less:
+ case decl_greater:
+ case decl_greequal:
+ case decl_lessequal:
+ /* expressions. */
+ return nameKey_NulName;
+ break;
+
+ case decl_adr:
+ return nameKey_makeKey ((const char *) "ADR", 3);
+ break;
+
+ case decl_size:
+ return nameKey_makeKey ((const char *) "SIZE", 4);
+ break;
+
+ case decl_tsize:
+ return nameKey_makeKey ((const char *) "TSIZE", 5);
+ break;
+
+ case decl_chr:
+ return nameKey_makeKey ((const char *) "CHR", 3);
+ break;
+
+ case decl_abs:
+ return nameKey_makeKey ((const char *) "ABS", 3);
+ break;
+
+ case decl_ord:
+ return nameKey_makeKey ((const char *) "ORD", 3);
+ break;
+
+ case decl_float:
+ return nameKey_makeKey ((const char *) "FLOAT", 5);
+ break;
+
+ case decl_trunc:
+ return nameKey_makeKey ((const char *) "TRUNC", 5);
+ break;
+
+ case decl_high:
+ return nameKey_makeKey ((const char *) "HIGH", 4);
+ break;
+
+ case decl_throw:
+ return nameKey_makeKey ((const char *) "THROW", 5);
+ break;
+
+ case decl_unreachable:
+ return nameKey_makeKey ((const char *) "builtin_unreachable", 19);
+ break;
+
+ case decl_cmplx:
+ return nameKey_makeKey ((const char *) "CMPLX", 5);
+ break;
+
+ case decl_re:
+ return nameKey_makeKey ((const char *) "RE", 2);
+ break;
+
+ case decl_im:
+ return nameKey_makeKey ((const char *) "IM", 2);
+ break;
+
+ case decl_max:
+ return nameKey_makeKey ((const char *) "MAX", 3);
+ break;
+
+ case decl_min:
+ return nameKey_makeKey ((const char *) "MIN", 3);
+ break;
+
+ case decl_funccall:
+ return nameKey_NulName;
+ break;
+
+ case decl_identlist:
+ return nameKey_NulName;
+ break;
+
+
+ default:
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ break;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ import - attempts to add node, n, into the scope of module, m.
+ It might fail due to a name clash in which case the
+ previous named symbol is returned. On success, n,
+ is returned.
+*/
+
+extern "C" decl_node decl_import (decl_node m, decl_node n)
+{
+ nameKey_Name name;
+ decl_node r;
+
+ mcDebug_assert (((decl_isDef (m)) || (decl_isModule (m))) || (decl_isImp (m)));
+ name = decl_getSymName (n);
+ r = decl_lookupInScope (m, name);
+ if (r == NULL)
+ {
+ switch (m->kind)
+ {
+ case decl_def:
+ symbolKey_putSymKey (m->defF.decls.symbols, name, reinterpret_cast<void *> (n));
+ break;
+
+ case decl_imp:
+ symbolKey_putSymKey (m->impF.decls.symbols, name, reinterpret_cast<void *> (n));
+ break;
+
+ case decl_module:
+ symbolKey_putSymKey (m->moduleF.decls.symbols, name, reinterpret_cast<void *> (n));
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ importEnumFields (m, n);
+ return n;
+ }
+ return r;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ lookupExported - attempts to lookup a node named, i, from definition
+ module, n. The node is returned if found.
+ NIL is returned if not found.
+*/
+
+extern "C" decl_node decl_lookupExported (decl_node n, nameKey_Name i)
+{
+ decl_node r;
+
+ mcDebug_assert (decl_isDef (n));
+ r = static_cast<decl_node> (symbolKey_getSymKey (n->defF.decls.symbols, i));
+ if ((r != NULL) && (decl_isExported (r)))
+ {
+ return r;
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ lookupSym - returns the symbol named, n, from the scope stack.
+*/
+
+extern "C" decl_node decl_lookupSym (nameKey_Name n)
+{
+ decl_node s;
+ decl_node m;
+ unsigned int l;
+ unsigned int h;
+
+ l = Indexing_LowIndice (scopeStack);
+ h = Indexing_HighIndice (scopeStack);
+ while (h >= l)
+ {
+ s = static_cast<decl_node> (Indexing_GetIndice (scopeStack, h));
+ m = decl_lookupInScope (s, n);
+ if (debugScopes && (m == NULL))
+ {
+ out3 ((const char *) " [%d] search for symbol name %s in scope %s\\n", 45, h, n, s);
+ }
+ if (m != NULL)
+ {
+ if (debugScopes)
+ {
+ out3 ((const char *) " [%d] search for symbol name %s in scope %s (found)\\n", 53, h, n, s);
+ }
+ return m;
+ }
+ h -= 1;
+ }
+ return lookupBase (n);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addImportedModule - add module, i, to be imported by, m.
+ If scoped then module, i, is added to the
+ module, m, scope.
+*/
+
+extern "C" void decl_addImportedModule (decl_node m, decl_node i, unsigned int scoped)
+{
+ mcDebug_assert ((decl_isDef (i)) || (decl_isModule (i)));
+ if (decl_isDef (m))
+ {
+ Indexing_IncludeIndiceIntoIndex (m->defF.importedModules, reinterpret_cast<void *> (i));
+ }
+ else if (decl_isImp (m))
+ {
+ /* avoid dangling else. */
+ Indexing_IncludeIndiceIntoIndex (m->impF.importedModules, reinterpret_cast<void *> (i));
+ }
+ else if (decl_isModule (m))
+ {
+ /* avoid dangling else. */
+ Indexing_IncludeIndiceIntoIndex (m->moduleF.importedModules, reinterpret_cast<void *> (i));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ if (scoped)
+ {
+ addModuleToScope (m, i);
+ }
+}
+
+
+/*
+ setSource - sets the source filename for module, n, to s.
+*/
+
+extern "C" void decl_setSource (decl_node n, nameKey_Name s)
+{
+ switch (n->kind)
+ {
+ case decl_def:
+ n->defF.source = s;
+ break;
+
+ case decl_module:
+ n->moduleF.source = s;
+ break;
+
+ case decl_imp:
+ n->impF.source = s;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ getSource - returns the source filename for module, n.
+*/
+
+extern "C" nameKey_Name decl_getSource (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_def:
+ return n->defF.source;
+ break;
+
+ case decl_module:
+ return n->moduleF.source;
+ break;
+
+ case decl_imp:
+ return n->impF.source;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getMainModule - returns the main module node.
+*/
+
+extern "C" decl_node decl_getMainModule (void)
+{
+ return mainModule;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getCurrentModule - returns the current module being compiled.
+*/
+
+extern "C" decl_node decl_getCurrentModule (void)
+{
+ return currentModule;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ foreachDefModuleDo - foreach definition node, n, in the module universe,
+ call p (n).
+*/
+
+extern "C" void decl_foreachDefModuleDo (symbolKey_performOperation p)
+{
+ Indexing_ForeachIndiceInIndexDo (defUniverseI, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) p.proc});
+}
+
+
+/*
+ foreachModModuleDo - foreach implementation or module node, n, in the module universe,
+ call p (n).
+*/
+
+extern "C" void decl_foreachModModuleDo (symbolKey_performOperation p)
+{
+ Indexing_ForeachIndiceInIndexDo (modUniverseI, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) p.proc});
+}
+
+
+/*
+ enterScope - pushes symbol, n, to the scope stack.
+*/
+
+extern "C" void decl_enterScope (decl_node n)
+{
+ if (Indexing_IsIndiceInIndex (scopeStack, reinterpret_cast<void *> (n)))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ Indexing_IncludeIndiceIntoIndex (scopeStack, reinterpret_cast<void *> (n));
+ }
+ if (debugScopes)
+ {
+ libc_printf ((const char *) "enter scope\\n", 13);
+ dumpScopes ();
+ }
+}
+
+
+/*
+ leaveScope - removes the top level scope.
+*/
+
+extern "C" void decl_leaveScope (void)
+{
+ unsigned int i;
+ decl_node n;
+
+ i = Indexing_HighIndice (scopeStack);
+ n = static_cast<decl_node> (Indexing_GetIndice (scopeStack, i));
+ Indexing_RemoveIndiceFromIndex (scopeStack, reinterpret_cast<void *> (n));
+ if (debugScopes)
+ {
+ libc_printf ((const char *) "leave scope\\n", 13);
+ dumpScopes ();
+ }
+}
+
+
+/*
+ makeProcedure - create, initialise and return a procedure node.
+*/
+
+extern "C" decl_node decl_makeProcedure (nameKey_Name n)
+{
+ decl_node d;
+
+ d = decl_lookupSym (n);
+ if (d == NULL)
+ {
+ d = newNode (decl_procedure);
+ d->procedureF.name = n;
+ initDecls (&d->procedureF.decls);
+ d->procedureF.scope = decl_getDeclScope ();
+ d->procedureF.parameters = Indexing_InitIndex (1);
+ d->procedureF.isForC = isDefForCNode (decl_getDeclScope ());
+ d->procedureF.built = FALSE;
+ d->procedureF.returnopt = FALSE;
+ d->procedureF.optarg_ = NULL;
+ d->procedureF.noreturnused = FALSE;
+ d->procedureF.noreturn = FALSE;
+ d->procedureF.vararg = FALSE;
+ d->procedureF.checking = FALSE;
+ d->procedureF.paramcount = 0;
+ d->procedureF.returnType = NULL;
+ d->procedureF.beginStatements = NULL;
+ initCname (&d->procedureF.cname);
+ d->procedureF.defComment = NULL;
+ d->procedureF.modComment = NULL;
+ }
+ return addProcedureToScope (d, n);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putCommentDefProcedure - remembers the procedure comment (if it exists) as a
+ definition module procedure heading. NIL is placed
+ if there is no procedure comment available.
+*/
+
+extern "C" void decl_putCommentDefProcedure (decl_node n)
+{
+ mcDebug_assert (decl_isProcedure (n));
+ if (mcComment_isProcedureComment (mcLexBuf_lastcomment))
+ {
+ n->procedureF.defComment = mcLexBuf_lastcomment;
+ }
+}
+
+
+/*
+ putCommentModProcedure - remembers the procedure comment (if it exists) as an
+ implementation/program module procedure heading. NIL is placed
+ if there is no procedure comment available.
+*/
+
+extern "C" void decl_putCommentModProcedure (decl_node n)
+{
+ mcDebug_assert (decl_isProcedure (n));
+ if (mcComment_isProcedureComment (mcLexBuf_lastcomment))
+ {
+ n->procedureF.modComment = mcLexBuf_lastcomment;
+ }
+}
+
+
+/*
+ makeProcType - returns a proctype node.
+*/
+
+extern "C" decl_node decl_makeProcType (void)
+{
+ decl_node d;
+
+ d = newNode (decl_proctype);
+ d->proctypeF.scope = decl_getDeclScope ();
+ d->proctypeF.parameters = Indexing_InitIndex (1);
+ d->proctypeF.returnopt = FALSE;
+ d->proctypeF.optarg_ = NULL;
+ d->proctypeF.vararg = FALSE;
+ d->proctypeF.returnType = NULL;
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putReturnType - sets the return type of procedure or proctype, proc, to, type.
+*/
+
+extern "C" void decl_putReturnType (decl_node proc, decl_node type)
+{
+ mcDebug_assert ((decl_isProcedure (proc)) || (decl_isProcType (proc)));
+ if (decl_isProcedure (proc))
+ {
+ proc->procedureF.returnType = type;
+ }
+ else
+ {
+ proc->proctypeF.returnType = type;
+ }
+}
+
+
+/*
+ putOptReturn - sets, proctype or procedure, proc, to have an optional return type.
+*/
+
+extern "C" void decl_putOptReturn (decl_node proc)
+{
+ mcDebug_assert ((decl_isProcedure (proc)) || (decl_isProcType (proc)));
+ if (decl_isProcedure (proc))
+ {
+ proc->procedureF.returnopt = TRUE;
+ }
+ else
+ {
+ proc->proctypeF.returnopt = TRUE;
+ }
+}
+
+
+/*
+ makeVarParameter - returns a var parameter node with, name: type.
+*/
+
+extern "C" decl_node decl_makeVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused)
+{
+ decl_node d;
+
+ mcDebug_assert ((l == NULL) || (isIdentList (l)));
+ d = newNode (decl_varparam);
+ d->varparamF.namelist = l;
+ d->varparamF.type = type;
+ d->varparamF.scope = proc;
+ d->varparamF.isUnbounded = FALSE;
+ d->varparamF.isForC = isDefForCNode (proc);
+ d->varparamF.isUsed = isused;
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeNonVarParameter - returns a non var parameter node with, name: type.
+*/
+
+extern "C" decl_node decl_makeNonVarParameter (decl_node l, decl_node type, decl_node proc, unsigned int isused)
+{
+ decl_node d;
+
+ mcDebug_assert ((l == NULL) || (isIdentList (l)));
+ d = newNode (decl_param);
+ d->paramF.namelist = l;
+ d->paramF.type = type;
+ d->paramF.scope = proc;
+ d->paramF.isUnbounded = FALSE;
+ d->paramF.isForC = isDefForCNode (proc);
+ d->paramF.isUsed = isused;
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ paramEnter - reset the parameter count.
+*/
+
+extern "C" void decl_paramEnter (decl_node n)
+{
+ mcDebug_assert (decl_isProcedure (n));
+ n->procedureF.paramcount = 0;
+}
+
+
+/*
+ paramLeave - set paramater checking to TRUE from now onwards.
+*/
+
+extern "C" void decl_paramLeave (decl_node n)
+{
+ mcDebug_assert (decl_isProcedure (n));
+ n->procedureF.checking = TRUE;
+ if ((decl_isImp (currentModule)) || (decl_isModule (currentModule)))
+ {
+ n->procedureF.built = TRUE;
+ }
+}
+
+
+/*
+ makeIdentList - returns a node which will be used to maintain an ident list.
+*/
+
+extern "C" decl_node decl_makeIdentList (void)
+{
+ decl_node n;
+
+ n = newNode (decl_identlist);
+ n->identlistF.names = wlists_initList ();
+ n->identlistF.cnamed = FALSE;
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putIdent - places ident, i, into identlist, n. It returns TRUE if
+ ident, i, is unique.
+*/
+
+extern "C" unsigned int decl_putIdent (decl_node n, nameKey_Name i)
+{
+ mcDebug_assert (isIdentList (n));
+ if (wlists_isItemInList (n->identlistF.names, i))
+ {
+ return FALSE;
+ }
+ else
+ {
+ wlists_putItemIntoList (n->identlistF.names, i);
+ return TRUE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addVarParameters - adds the identlist, i, of, type, to be VAR parameters
+ in procedure, n.
+*/
+
+extern "C" void decl_addVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused)
+{
+ decl_node p;
+
+ mcDebug_assert (isIdentList (i));
+ mcDebug_assert (decl_isProcedure (n));
+ checkMakeVariables (n, i, type, TRUE, isused);
+ if (n->procedureF.checking)
+ {
+ checkParameters (n, i, type, TRUE, isused); /* will destroy, i. */
+ }
+ else
+ {
+ p = decl_makeVarParameter (i, type, n, isused);
+ Indexing_IncludeIndiceIntoIndex (n->procedureF.parameters, reinterpret_cast<void *> (p));
+ }
+}
+
+
+/*
+ addNonVarParameters - adds the identlist, i, of, type, to be parameters
+ in procedure, n.
+*/
+
+extern "C" void decl_addNonVarParameters (decl_node n, decl_node i, decl_node type, unsigned int isused)
+{
+ decl_node p;
+
+ mcDebug_assert (isIdentList (i));
+ mcDebug_assert (decl_isProcedure (n));
+ checkMakeVariables (n, i, type, FALSE, isused);
+ if (n->procedureF.checking)
+ {
+ checkParameters (n, i, type, FALSE, isused); /* will destroy, i. */
+ }
+ else
+ {
+ p = decl_makeNonVarParameter (i, type, n, isused);
+ Indexing_IncludeIndiceIntoIndex (n->procedureF.parameters, reinterpret_cast<void *> (p));
+ }
+}
+
+
+/*
+ makeVarargs - returns a varargs node.
+*/
+
+extern "C" decl_node decl_makeVarargs (void)
+{
+ decl_node d;
+
+ d = newNode (decl_varargs);
+ d->varargsF.scope = NULL;
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isVarargs - returns TRUE if, n, is a varargs node.
+*/
+
+extern "C" unsigned int decl_isVarargs (decl_node n)
+{
+ return n->kind == decl_varargs;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addParameter - adds a parameter, param, to procedure or proctype, proc.
+*/
+
+extern "C" void decl_addParameter (decl_node proc, decl_node param)
+{
+ mcDebug_assert ((((decl_isVarargs (param)) || (decl_isParam (param))) || (decl_isVarParam (param))) || (decl_isOptarg (param)));
+ switch (proc->kind)
+ {
+ case decl_procedure:
+ Indexing_IncludeIndiceIntoIndex (proc->procedureF.parameters, reinterpret_cast<void *> (param));
+ if (decl_isVarargs (param))
+ {
+ proc->procedureF.vararg = TRUE;
+ }
+ if (decl_isOptarg (param))
+ {
+ proc->procedureF.optarg_ = param;
+ }
+ break;
+
+ case decl_proctype:
+ Indexing_IncludeIndiceIntoIndex (proc->proctypeF.parameters, reinterpret_cast<void *> (param));
+ if (decl_isVarargs (param))
+ {
+ proc->proctypeF.vararg = TRUE;
+ }
+ if (decl_isOptarg (param))
+ {
+ proc->proctypeF.optarg_ = param;
+ }
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ makeBinaryTok - creates and returns a boolean type node with,
+ l, and, r, nodes.
+*/
+
+extern "C" decl_node decl_makeBinaryTok (mcReserved_toktype op, decl_node l, decl_node r)
+{
+ if (op == mcReserved_equaltok)
+ {
+ return makeBinary (decl_equal, l, r, booleanN);
+ }
+ else if ((op == mcReserved_hashtok) || (op == mcReserved_lessgreatertok))
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_notequal, l, r, booleanN);
+ }
+ else if (op == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_less, l, r, booleanN);
+ }
+ else if (op == mcReserved_greatertok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_greater, l, r, booleanN);
+ }
+ else if (op == mcReserved_greaterequaltok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_greequal, l, r, booleanN);
+ }
+ else if (op == mcReserved_lessequaltok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_lessequal, l, r, booleanN);
+ }
+ else if (op == mcReserved_andtok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_and, l, r, booleanN);
+ }
+ else if (op == mcReserved_ortok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_or, l, r, booleanN);
+ }
+ else if (op == mcReserved_plustok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_plus, l, r, NULL);
+ }
+ else if (op == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_sub, l, r, NULL);
+ }
+ else if (op == mcReserved_divtok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_div, l, r, NULL);
+ }
+ else if (op == mcReserved_timestok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_mult, l, r, NULL);
+ }
+ else if (op == mcReserved_modtok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_mod, l, r, NULL);
+ }
+ else if (op == mcReserved_intok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_in, l, r, NULL);
+ }
+ else if (op == mcReserved_dividetok)
+ {
+ /* avoid dangling else. */
+ return makeBinary (decl_divide, l, r, NULL);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1); /* most likely op needs a clause as above. */
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeUnaryTok - creates and returns a boolean type node with,
+ e, node.
+*/
+
+extern "C" decl_node decl_makeUnaryTok (mcReserved_toktype op, decl_node e)
+{
+ if (op == mcReserved_nottok)
+ {
+ return makeUnary (decl_not, e, booleanN);
+ }
+ else if (op == mcReserved_plustok)
+ {
+ /* avoid dangling else. */
+ return makeUnary (decl_plus, e, NULL);
+ }
+ else if (op == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ return makeUnary (decl_neg, e, NULL);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ M2RTS_HALT (-1); /* most likely op needs a clause as above. */
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeComponentRef - build a componentref node which accesses, field,
+ within, record, rec.
+*/
+
+extern "C" decl_node decl_makeComponentRef (decl_node rec, decl_node field)
+{
+ decl_node n;
+ decl_node a;
+
+ /*
+ n := getLastOp (rec) ;
+ IF (n#NIL) AND (isDeref (n) OR isPointerRef (n)) AND
+ (skipType (getType (rec)) = skipType (getType (n)))
+ THEN
+ a := n^.unaryF.arg ;
+ n^.kind := pointerref ;
+ n^.pointerrefF.ptr := a ;
+ n^.pointerrefF.field := field ;
+ n^.pointerrefF.resultType := getType (field) ;
+ RETURN n
+ ELSE
+ RETURN doMakeComponentRef (rec, field)
+ END
+ */
+ if (isDeref (rec))
+ {
+ a = rec->unaryF.arg;
+ rec->kind = decl_pointerref;
+ rec->pointerrefF.ptr = a;
+ rec->pointerrefF.field = field;
+ rec->pointerrefF.resultType = decl_getType (field);
+ return rec;
+ }
+ else
+ {
+ return doMakeComponentRef (rec, field);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makePointerRef - build a pointerref node which accesses, field,
+ within, pointer to record, ptr.
+*/
+
+extern "C" decl_node decl_makePointerRef (decl_node ptr, decl_node field)
+{
+ decl_node n;
+
+ n = newNode (decl_pointerref);
+ n->pointerrefF.ptr = ptr;
+ n->pointerrefF.field = field;
+ n->pointerrefF.resultType = decl_getType (field);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isPointerRef - returns TRUE if, n, is a pointerref node.
+*/
+
+extern "C" unsigned int decl_isPointerRef (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_pointerref;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeDeRef - dereferences the pointer defined by, n.
+*/
+
+extern "C" decl_node decl_makeDeRef (decl_node n)
+{
+ decl_node t;
+
+ t = decl_skipType (decl_getType (n));
+ mcDebug_assert (decl_isPointer (t));
+ return makeUnary (decl_deref, n, decl_getType (t));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeArrayRef - build an arrayref node which access element,
+ index, in, array. array is a variable/expression/constant
+ which has a type array.
+*/
+
+extern "C" decl_node decl_makeArrayRef (decl_node array, decl_node index)
+{
+ decl_node n;
+ decl_node t;
+ unsigned int i;
+ unsigned int j;
+
+ n = newNode (decl_arrayref);
+ n->arrayrefF.array = array;
+ n->arrayrefF.index = index;
+ t = array;
+ j = expListLen (index);
+ i = 1;
+ t = decl_skipType (decl_getType (t));
+ do {
+ if (decl_isArray (t))
+ {
+ t = decl_skipType (decl_getType (t));
+ }
+ else
+ {
+ mcMetaError_metaError2 ((const char *) "cannot access {%1N} dimension of array {%2a}", 44, (const unsigned char *) &i, (sizeof (i)-1), (const unsigned char *) &t, (sizeof (t)-1));
+ }
+ i += 1;
+ } while (! (i > j));
+ n->arrayrefF.resultType = t;
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getLastOp - return the right most non leaf node.
+*/
+
+extern "C" decl_node decl_getLastOp (decl_node n)
+{
+ return doGetLastOp (n, n);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getCardinal - returns the cardinal type node.
+*/
+
+extern "C" decl_node decl_getCardinal (void)
+{
+ return cardinalN;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeLiteralInt - creates and returns a literal node based on an integer type.
+*/
+
+extern "C" decl_node decl_makeLiteralInt (nameKey_Name n)
+{
+ decl_node m;
+ DynamicStrings_String s;
+
+ m = newNode (decl_literal);
+ s = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n));
+ m->literalF.name = n;
+ if ((DynamicStrings_char (s, -1)) == 'C')
+ {
+ m->literalF.type = charN;
+ }
+ else
+ {
+ m->literalF.type = ztypeN;
+ }
+ s = DynamicStrings_KillString (s);
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeLiteralReal - creates and returns a literal node based on a real type.
+*/
+
+extern "C" decl_node decl_makeLiteralReal (nameKey_Name n)
+{
+ decl_node m;
+
+ m = newNode (decl_literal);
+ m->literalF.name = n;
+ m->literalF.type = rtypeN;
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeString - creates and returns a node containing string, n.
+*/
+
+extern "C" decl_node decl_makeString (nameKey_Name n)
+{
+ decl_node m;
+
+ m = newNode (decl_string);
+ m->stringF.name = n;
+ m->stringF.length = nameKey_lengthKey (n);
+ m->stringF.isCharCompatible = m->stringF.length <= 3;
+ m->stringF.cstring = toCstring (n);
+ m->stringF.clength = lenCstring (m->stringF.cstring);
+ if (m->stringF.isCharCompatible)
+ {
+ m->stringF.cchar = toCchar (n);
+ }
+ else
+ {
+ m->stringF.cchar = NULL;
+ }
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeSetValue - creates and returns a setvalue node.
+*/
+
+extern "C" decl_node decl_makeSetValue (void)
+{
+ decl_node n;
+
+ n = newNode (decl_setvalue);
+ n->setvalueF.type = bitsetN;
+ n->setvalueF.values = Indexing_InitIndex (1);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isSetValue - returns TRUE if, n, is a setvalue node.
+*/
+
+extern "C" unsigned int decl_isSetValue (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_setvalue;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putSetValue - assigns the type, t, to the set value, n. The
+ node, n, is returned.
+*/
+
+extern "C" decl_node decl_putSetValue (decl_node n, decl_node t)
+{
+ mcDebug_assert (decl_isSetValue (n));
+ n->setvalueF.type = t;
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ includeSetValue - includes the range l..h into the setvalue.
+ h might be NIL indicating that a single element
+ is to be included into the set.
+ n is returned.
+*/
+
+extern "C" decl_node decl_includeSetValue (decl_node n, decl_node l, decl_node h)
+{
+ mcDebug_assert (decl_isSetValue (n));
+ Indexing_IncludeIndiceIntoIndex (n->setvalueF.values, reinterpret_cast<void *> (l));
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getBuiltinConst - creates and returns a builtin const if available.
+*/
+
+extern "C" decl_node decl_getBuiltinConst (nameKey_Name n)
+{
+ if (n == (nameKey_makeKey ((const char *) "BITS_PER_UNIT", 13)))
+ {
+ return bitsperunitN;
+ }
+ else if (n == (nameKey_makeKey ((const char *) "BITS_PER_WORD", 13)))
+ {
+ /* avoid dangling else. */
+ return bitsperwordN;
+ }
+ else if (n == (nameKey_makeKey ((const char *) "BITS_PER_CHAR", 13)))
+ {
+ /* avoid dangling else. */
+ return bitspercharN;
+ }
+ else if (n == (nameKey_makeKey ((const char *) "UNITS_PER_WORD", 14)))
+ {
+ /* avoid dangling else. */
+ return unitsperwordN;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return NULL;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeExpList - creates and returns an expList node.
+*/
+
+extern "C" decl_node decl_makeExpList (void)
+{
+ decl_node n;
+
+ n = newNode (decl_explist);
+ n->explistF.exp = Indexing_InitIndex (1);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isExpList - returns TRUE if, n, is an explist node.
+*/
+
+extern "C" unsigned int decl_isExpList (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_explist;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putExpList - places, expression, e, within the explist, n.
+*/
+
+extern "C" void decl_putExpList (decl_node n, decl_node e)
+{
+ mcDebug_assert (n != NULL);
+ mcDebug_assert (decl_isExpList (n));
+ Indexing_PutIndice (n->explistF.exp, (Indexing_HighIndice (n->explistF.exp))+1, reinterpret_cast<void *> (e));
+}
+
+
+/*
+ makeConstExp - returns a constexp node.
+*/
+
+extern "C" decl_node decl_makeConstExp (void)
+{
+ if ((currentModule != NULL) && (getConstExpComplete (currentModule)))
+ {
+ return decl_getNextConstExp ();
+ }
+ else
+ {
+ return doMakeConstExp ();
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getNextConstExp - returns the next constexp node.
+*/
+
+extern "C" decl_node decl_getNextConstExp (void)
+{
+ decl_node n;
+
+ mcDebug_assert (((decl_isDef (currentModule)) || (decl_isImp (currentModule))) || (decl_isModule (currentModule)));
+ if (decl_isDef (currentModule))
+ {
+ return getNextFixup (¤tModule->defF.constFixup);
+ }
+ else if (decl_isImp (currentModule))
+ {
+ /* avoid dangling else. */
+ return getNextFixup (¤tModule->impF.constFixup);
+ }
+ else if (decl_isModule (currentModule))
+ {
+ /* avoid dangling else. */
+ return getNextFixup (¤tModule->moduleF.constFixup);
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ setConstExpComplete - sets the field inside the def or imp or module, n.
+*/
+
+extern "C" void decl_setConstExpComplete (decl_node n)
+{
+ switch (n->kind)
+ {
+ case decl_def:
+ n->defF.constsComplete = TRUE;
+ break;
+
+ case decl_imp:
+ n->impF.constsComplete = TRUE;
+ break;
+
+ case decl_module:
+ n->moduleF.constsComplete = TRUE;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ fixupConstExp - assign fixup expression, e, into the argument of, c.
+*/
+
+extern "C" decl_node decl_fixupConstExp (decl_node c, decl_node e)
+{
+ mcDebug_assert (isConstExp (c));
+ c->unaryF.arg = e;
+ return c;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ resetConstExpPos - resets the index into the saved list of constexps inside
+ module, n.
+*/
+
+extern "C" void decl_resetConstExpPos (decl_node n)
+{
+ mcDebug_assert (((decl_isDef (n)) || (decl_isImp (n))) || (decl_isModule (n)));
+ if (decl_isDef (n))
+ {
+ n->defF.constFixup.count = 0;
+ }
+ else if (decl_isImp (n))
+ {
+ /* avoid dangling else. */
+ n->impF.constFixup.count = 0;
+ }
+ else if (decl_isModule (n))
+ {
+ /* avoid dangling else. */
+ n->moduleF.constFixup.count = 0;
+ }
+}
+
+
+/*
+ makeFuncCall - builds a function call to c with param list, n.
+*/
+
+extern "C" decl_node decl_makeFuncCall (decl_node c, decl_node n)
+{
+ decl_node f;
+
+ mcDebug_assert ((n == NULL) || (decl_isExpList (n)));
+ if (((c == haltN) && ((decl_getMainModule ()) != (decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5))))) && ((decl_getMainModule ()) != (decl_lookupImp (nameKey_makeKey ((const char *) "M2RTS", 5)))))
+ {
+ decl_addImportedModule (decl_getMainModule (), decl_lookupDef (nameKey_makeKey ((const char *) "M2RTS", 5)), FALSE);
+ }
+ f = checkIntrinsic (c, n);
+ checkCHeaders (c);
+ if (f == NULL)
+ {
+ f = newNode (decl_funccall);
+ f->funccallF.function = c;
+ f->funccallF.args = n;
+ f->funccallF.type = NULL;
+ initPair (&f->funccallF.funccallComment);
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeStatementSequence - create and return a statement sequence node.
+*/
+
+extern "C" decl_node decl_makeStatementSequence (void)
+{
+ decl_node n;
+
+ n = newNode (decl_stmtseq);
+ n->stmtF.statements = Indexing_InitIndex (1);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isStatementSequence - returns TRUE if node, n, is a statement sequence.
+*/
+
+extern "C" unsigned int decl_isStatementSequence (decl_node n)
+{
+ return n->kind == decl_stmtseq;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addStatement - adds node, n, as a statement to statememt sequence, s.
+*/
+
+extern "C" void decl_addStatement (decl_node s, decl_node n)
+{
+ if (n != NULL)
+ {
+ mcDebug_assert (decl_isStatementSequence (s));
+ Indexing_PutIndice (s->stmtF.statements, (Indexing_HighIndice (s->stmtF.statements))+1, reinterpret_cast<void *> (n));
+ if ((isIntrinsic (n)) && n->intrinsicF.postUnreachable)
+ {
+ n->intrinsicF.postUnreachable = FALSE;
+ decl_addStatement (s, makeIntrinsicProc (decl_unreachable, 0, NULL));
+ }
+ }
+}
+
+
+/*
+ addCommentBody - adds a body comment to a statement sequence node.
+*/
+
+extern "C" void decl_addCommentBody (decl_node n)
+{
+ mcComment_commentDesc b;
+
+ if (n != NULL)
+ {
+ b = mcLexBuf_getBodyComment ();
+ if (b != NULL)
+ {
+ addGenericBody (n, decl_makeCommentS (b));
+ }
+ }
+}
+
+
+/*
+ addCommentAfter - adds an after comment to a statement sequence node.
+*/
+
+extern "C" void decl_addCommentAfter (decl_node n)
+{
+ mcComment_commentDesc a;
+
+ if (n != NULL)
+ {
+ a = mcLexBuf_getAfterComment ();
+ if (a != NULL)
+ {
+ addGenericAfter (n, decl_makeCommentS (a));
+ }
+ }
+}
+
+
+/*
+ addIfComments - adds the, body, and, after, comments to if node, n.
+*/
+
+extern "C" void decl_addIfComments (decl_node n, decl_node body, decl_node after)
+{
+ mcDebug_assert (decl_isIf (n));
+ n->ifF.ifComment.after = after;
+ n->ifF.ifComment.body = body;
+}
+
+
+/*
+ addElseComments - adds the, body, and, after, comments to an, if, or an elsif, node, n.
+*/
+
+extern "C" void decl_addElseComments (decl_node n, decl_node body, decl_node after)
+{
+ mcDebug_assert ((decl_isIf (n)) || (decl_isElsif (n)));
+ if (decl_isIf (n))
+ {
+ n->ifF.elseComment.after = after;
+ n->ifF.elseComment.body = body;
+ }
+ else
+ {
+ n->elsifF.elseComment.after = after;
+ n->elsifF.elseComment.body = body;
+ }
+}
+
+
+/*
+ addIfEndComments - adds the, body, and, after, comments to an, if, node, n.
+*/
+
+extern "C" void decl_addIfEndComments (decl_node n, decl_node body, decl_node after)
+{
+ mcDebug_assert (decl_isIf (n));
+ n->ifF.endComment.after = after;
+ n->ifF.endComment.body = body;
+}
+
+
+/*
+ makeReturn - creates and returns a return node.
+*/
+
+extern "C" decl_node decl_makeReturn (void)
+{
+ decl_node type;
+ decl_node n;
+
+ n = newNode (decl_return);
+ n->returnF.exp = NULL;
+ if (decl_isProcedure (decl_getDeclScope ()))
+ {
+ n->returnF.scope = decl_getDeclScope ();
+ }
+ else
+ {
+ n->returnF.scope = NULL;
+ }
+ initPair (&n->returnF.returnComment);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isReturn - returns TRUE if node, n, is a return.
+*/
+
+extern "C" unsigned int decl_isReturn (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_return;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putReturn - assigns node, e, as the expression on the return node.
+*/
+
+extern "C" void decl_putReturn (decl_node n, decl_node e)
+{
+ mcDebug_assert (decl_isReturn (n));
+ n->returnF.exp = e;
+}
+
+
+/*
+ makeWhile - creates and returns a while node.
+*/
+
+extern "C" decl_node decl_makeWhile (void)
+{
+ decl_node n;
+
+ n = newNode (decl_while);
+ n->whileF.expr = NULL;
+ n->whileF.statements = NULL;
+ initPair (&n->whileF.doComment);
+ initPair (&n->whileF.endComment);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putWhile - places an expression, e, and statement sequence, s, into the while
+ node, n.
+*/
+
+extern "C" void decl_putWhile (decl_node n, decl_node e, decl_node s)
+{
+ mcDebug_assert (decl_isWhile (n));
+ n->whileF.expr = e;
+ n->whileF.statements = s;
+}
+
+
+/*
+ isWhile - returns TRUE if node, n, is a while.
+*/
+
+extern "C" unsigned int decl_isWhile (decl_node n)
+{
+ return n->kind == decl_while;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addWhileDoComment - adds body and after comments to while node, w.
+*/
+
+extern "C" void decl_addWhileDoComment (decl_node w, decl_node body, decl_node after)
+{
+ mcDebug_assert (decl_isWhile (w));
+ w->whileF.doComment.after = after;
+ w->whileF.doComment.body = body;
+}
+
+
+/*
+ addWhileEndComment - adds body and after comments to the end of a while node, w.
+*/
+
+extern "C" void decl_addWhileEndComment (decl_node w, decl_node body, decl_node after)
+{
+ mcDebug_assert (decl_isWhile (w));
+ w->whileF.endComment.after = after;
+ w->whileF.endComment.body = body;
+}
+
+
+/*
+ makeAssignment - creates and returns an assignment node.
+ The designator is, d, and expression, e.
+*/
+
+extern "C" decl_node decl_makeAssignment (decl_node d, decl_node e)
+{
+ decl_node n;
+
+ n = newNode (decl_assignment);
+ n->assignmentF.des = d;
+ n->assignmentF.expr = e;
+ initPair (&n->assignmentF.assignComment);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putBegin - assigns statements, s, to be the normal part in
+ block, b. The block may be a procedure or module,
+ or implementation node.
+*/
+
+extern "C" void decl_putBegin (decl_node b, decl_node s)
+{
+ mcDebug_assert (((decl_isImp (b)) || (decl_isProcedure (b))) || (decl_isModule (b)));
+ switch (b->kind)
+ {
+ case decl_imp:
+ b->impF.beginStatements = s;
+ break;
+
+ case decl_module:
+ b->moduleF.beginStatements = s;
+ break;
+
+ case decl_procedure:
+ b->procedureF.beginStatements = s;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ putFinally - assigns statements, s, to be the final part in
+ block, b. The block may be a module
+ or implementation node.
+*/
+
+extern "C" void decl_putFinally (decl_node b, decl_node s)
+{
+ mcDebug_assert (((decl_isImp (b)) || (decl_isProcedure (b))) || (decl_isModule (b)));
+ switch (b->kind)
+ {
+ case decl_imp:
+ b->impF.finallyStatements = s;
+ break;
+
+ case decl_module:
+ b->moduleF.finallyStatements = s;
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ makeExit - creates and returns an exit node.
+*/
+
+extern "C" decl_node decl_makeExit (decl_node l, unsigned int n)
+{
+ decl_node e;
+
+ mcDebug_assert (decl_isLoop (l));
+ e = newNode (decl_exit);
+ e->exitF.loop = l;
+ l->loopF.labelno = n;
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isExit - returns TRUE if node, n, is an exit.
+*/
+
+extern "C" unsigned int decl_isExit (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_exit;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeLoop - creates and returns a loop node.
+*/
+
+extern "C" decl_node decl_makeLoop (void)
+{
+ decl_node l;
+
+ l = newNode (decl_loop);
+ l->loopF.statements = NULL;
+ l->loopF.labelno = 0;
+ return l;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isLoop - returns TRUE if, n, is a loop node.
+*/
+
+extern "C" unsigned int decl_isLoop (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_loop;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putLoop - places statement sequence, s, into loop, l.
+*/
+
+extern "C" void decl_putLoop (decl_node l, decl_node s)
+{
+ mcDebug_assert (decl_isLoop (l));
+ l->loopF.statements = s;
+}
+
+
+/*
+ makeComment - creates and returns a comment node.
+*/
+
+extern "C" decl_node decl_makeComment (const char *a_, unsigned int _a_high)
+{
+ mcComment_commentDesc c;
+ DynamicStrings_String s;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ c = mcComment_initComment (TRUE);
+ s = DynamicStrings_InitString ((const char *) a, _a_high);
+ mcComment_addText (c, DynamicStrings_string (s));
+ s = DynamicStrings_KillString (s);
+ return decl_makeCommentS (c);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeCommentS - creates and returns a comment node.
+*/
+
+extern "C" decl_node decl_makeCommentS (mcComment_commentDesc c)
+{
+ decl_node n;
+
+ if (c == NULL)
+ {
+ return NULL;
+ }
+ else
+ {
+ n = newNode (decl_comment);
+ n->commentF.content = c;
+ return n;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeIf - creates and returns an if node. The if node
+ will have expression, e, and statement sequence, s,
+ as the then component.
+*/
+
+extern "C" decl_node decl_makeIf (decl_node e, decl_node s)
+{
+ decl_node n;
+
+ n = newNode (decl_if);
+ n->ifF.expr = e;
+ n->ifF.then = s;
+ n->ifF.else_ = NULL;
+ n->ifF.elsif = NULL;
+ initPair (&n->ifF.ifComment);
+ initPair (&n->ifF.elseComment);
+ initPair (&n->ifF.endComment);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isIf - returns TRUE if, n, is an if node.
+*/
+
+extern "C" unsigned int decl_isIf (decl_node n)
+{
+ return n->kind == decl_if;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeElsif - creates and returns an elsif node.
+ This node has an expression, e, and statement
+ sequence, s.
+*/
+
+extern "C" decl_node decl_makeElsif (decl_node i, decl_node e, decl_node s)
+{
+ decl_node n;
+
+ n = newNode (decl_elsif);
+ n->elsifF.expr = e;
+ n->elsifF.then = s;
+ n->elsifF.elsif = NULL;
+ n->elsifF.else_ = NULL;
+ initPair (&n->elsifF.elseComment);
+ mcDebug_assert ((decl_isIf (i)) || (decl_isElsif (i)));
+ if (decl_isIf (i))
+ {
+ i->ifF.elsif = n;
+ mcDebug_assert (i->ifF.else_ == NULL);
+ }
+ else
+ {
+ i->elsifF.elsif = n;
+ mcDebug_assert (i->elsifF.else_ == NULL);
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isElsif - returns TRUE if node, n, is an elsif node.
+*/
+
+extern "C" unsigned int decl_isElsif (decl_node n)
+{
+ return n->kind == decl_elsif;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putElse - the else is grafted onto the if/elsif node, i,
+ and the statement sequence will be, s.
+*/
+
+extern "C" void decl_putElse (decl_node i, decl_node s)
+{
+ mcDebug_assert ((decl_isIf (i)) || (decl_isElsif (i)));
+ if (decl_isIf (i))
+ {
+ mcDebug_assert (i->ifF.elsif == NULL);
+ mcDebug_assert (i->ifF.else_ == NULL);
+ i->ifF.else_ = s;
+ }
+ else
+ {
+ mcDebug_assert (i->elsifF.elsif == NULL);
+ mcDebug_assert (i->elsifF.else_ == NULL);
+ i->elsifF.else_ = s;
+ }
+}
+
+
+/*
+ makeFor - creates and returns a for node.
+*/
+
+extern "C" decl_node decl_makeFor (void)
+{
+ decl_node n;
+
+ n = newNode (decl_for);
+ n->forF.des = NULL;
+ n->forF.start = NULL;
+ n->forF.end = NULL;
+ n->forF.increment = NULL;
+ n->forF.statements = NULL;
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isFor - returns TRUE if node, n, is a for node.
+*/
+
+extern "C" unsigned int decl_isFor (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_for;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putFor - assigns the fields of the for node with
+ ident, i,
+ start, s,
+ end, e,
+ increment, i,
+ statements, sq.
+*/
+
+extern "C" void decl_putFor (decl_node f, decl_node i, decl_node s, decl_node e, decl_node b, decl_node sq)
+{
+ mcDebug_assert (decl_isFor (f));
+ f->forF.des = i;
+ f->forF.start = s;
+ f->forF.end = e;
+ f->forF.increment = b;
+ f->forF.statements = sq;
+}
+
+
+/*
+ makeRepeat - creates and returns a repeat node.
+*/
+
+extern "C" decl_node decl_makeRepeat (void)
+{
+ decl_node n;
+
+ n = newNode (decl_repeat);
+ n->repeatF.expr = NULL;
+ n->repeatF.statements = NULL;
+ initPair (&n->repeatF.repeatComment);
+ initPair (&n->repeatF.untilComment);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isRepeat - returns TRUE if node, n, is a repeat node.
+*/
+
+extern "C" unsigned int decl_isRepeat (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_repeat;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putRepeat - places statements, s, and expression, e, into
+ repeat statement, n.
+*/
+
+extern "C" void decl_putRepeat (decl_node n, decl_node s, decl_node e)
+{
+ n->repeatF.expr = e;
+ n->repeatF.statements = s;
+}
+
+
+/*
+ addRepeatComment - adds body and after comments to repeat node, r.
+*/
+
+extern "C" void decl_addRepeatComment (decl_node r, decl_node body, decl_node after)
+{
+ mcDebug_assert (decl_isRepeat (r));
+ r->repeatF.repeatComment.after = after;
+ r->repeatF.repeatComment.body = body;
+}
+
+
+/*
+ addUntilComment - adds body and after comments to the until section of a repeat node, r.
+*/
+
+extern "C" void decl_addUntilComment (decl_node r, decl_node body, decl_node after)
+{
+ mcDebug_assert (decl_isRepeat (r));
+ r->repeatF.untilComment.after = after;
+ r->repeatF.untilComment.body = body;
+}
+
+
+/*
+ makeCase - builds and returns a case statement node.
+*/
+
+extern "C" decl_node decl_makeCase (void)
+{
+ decl_node n;
+
+ n = newNode (decl_case);
+ n->caseF.expression = NULL;
+ n->caseF.caseLabelList = Indexing_InitIndex (1);
+ n->caseF.else_ = NULL;
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isCase - returns TRUE if node, n, is a case statement.
+*/
+
+extern "C" unsigned int decl_isCase (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_case;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putCaseExpression - places expression, e, into case statement, n.
+ n is returned.
+*/
+
+extern "C" decl_node decl_putCaseExpression (decl_node n, decl_node e)
+{
+ mcDebug_assert (decl_isCase (n));
+ n->caseF.expression = e;
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putCaseElse - places else statement, e, into case statement, n.
+ n is returned.
+*/
+
+extern "C" decl_node decl_putCaseElse (decl_node n, decl_node e)
+{
+ mcDebug_assert (decl_isCase (n));
+ n->caseF.else_ = e;
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putCaseStatement - places a caselist, l, and associated
+ statement sequence, s, into case statement, n.
+ n is returned.
+*/
+
+extern "C" decl_node decl_putCaseStatement (decl_node n, decl_node l, decl_node s)
+{
+ mcDebug_assert (decl_isCase (n));
+ mcDebug_assert (decl_isCaseList (l));
+ Indexing_IncludeIndiceIntoIndex (n->caseF.caseLabelList, reinterpret_cast<void *> (decl_makeCaseLabelList (l, s)));
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeCaseLabelList - creates and returns a caselabellist node.
+*/
+
+extern "C" decl_node decl_makeCaseLabelList (decl_node l, decl_node s)
+{
+ decl_node n;
+
+ n = newNode (decl_caselabellist);
+ n->caselabellistF.caseList = l;
+ n->caselabellistF.statements = s;
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isCaseLabelList - returns TRUE if, n, is a caselabellist.
+*/
+
+extern "C" unsigned int decl_isCaseLabelList (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_caselabellist;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeCaseList - creates and returns a case statement node.
+*/
+
+extern "C" decl_node decl_makeCaseList (void)
+{
+ decl_node n;
+
+ n = newNode (decl_caselist);
+ n->caselistF.rangePairs = Indexing_InitIndex (1);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isCaseList - returns TRUE if, n, is a case list.
+*/
+
+extern "C" unsigned int decl_isCaseList (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_caselist;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ putCaseRange - places the case range lo..hi into caselist, n.
+*/
+
+extern "C" decl_node decl_putCaseRange (decl_node n, decl_node lo, decl_node hi)
+{
+ mcDebug_assert (decl_isCaseList (n));
+ Indexing_IncludeIndiceIntoIndex (n->caselistF.rangePairs, reinterpret_cast<void *> (decl_makeRange (lo, hi)));
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeRange - creates and returns a case range.
+*/
+
+extern "C" decl_node decl_makeRange (decl_node lo, decl_node hi)
+{
+ decl_node n;
+
+ n = newNode (decl_range);
+ n->rangeF.lo = lo;
+ n->rangeF.hi = hi;
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isRange - returns TRUE if node, n, is a range.
+*/
+
+extern "C" unsigned int decl_isRange (decl_node n)
+{
+ mcDebug_assert (n != NULL);
+ return n->kind == decl_range;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ setNoReturn - sets noreturn field inside procedure.
+*/
+
+extern "C" void decl_setNoReturn (decl_node n, unsigned int value)
+{
+ mcDebug_assert (n != NULL);
+ mcDebug_assert (decl_isProcedure (n));
+ if (n->procedureF.noreturnused && (n->procedureF.noreturn != value))
+ {
+ mcMetaError_metaError1 ((const char *) "{%1DMad} definition module and implementation module have different <* noreturn *> attributes", 93, (const unsigned char *) &n, (sizeof (n)-1));
+ }
+ n->procedureF.noreturn = value;
+ n->procedureF.noreturnused = TRUE;
+}
+
+
+/*
+ dupExpr - duplicate the expression nodes, it does not duplicate
+ variables, literals, constants but only the expression
+ operators (including function calls and parameter lists).
+*/
+
+extern "C" decl_node decl_dupExpr (decl_node n)
+{
+ if (n == NULL)
+ {
+ return NULL;
+ }
+ else
+ {
+ return doDupExpr (n);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ setLangC -
+*/
+
+extern "C" void decl_setLangC (void)
+{
+ lang = decl_ansiC;
+}
+
+
+/*
+ setLangCP -
+*/
+
+extern "C" void decl_setLangCP (void)
+{
+ lang = decl_ansiCP;
+ keyc_cp ();
+}
+
+
+/*
+ setLangM2 -
+*/
+
+extern "C" void decl_setLangM2 (void)
+{
+ lang = decl_pim4;
+}
+
+
+/*
+ out - walks the tree of node declarations for the main module
+ and writes the output to the outputFile specified in
+ mcOptions. It outputs the declarations in the language
+ specified above.
+*/
+
+extern "C" void decl_out (void)
+{
+ mcPretty_pretty p;
+
+ openOutput ();
+ p = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln});
+ switch (lang)
+ {
+ case decl_ansiC:
+ outC (p, decl_getMainModule ());
+ break;
+
+ case decl_ansiCP:
+ outC (p, decl_getMainModule ());
+ break;
+
+ case decl_pim4:
+ outM2 (p, decl_getMainModule ());
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ closeOutput ();
+}
+
+extern "C" void _M2_decl_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ init ();
+}
+
+extern "C" void _M2_decl_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from keyc. */
+/* keyc maintains the C name scope and avoids C/C++ name conflicts.
+ Copyright (C) 2016-2023 Free Software Foundation, Inc.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _keyc_H
+#define _keyc_C
+
+# include "GmcPretty.h"
+# include "GStorage.h"
+# include "GDynamicStrings.h"
+# include "GsymbolKey.h"
+# include "GnameKey.h"
+# include "GmcOptions.h"
+# include "GM2RTS.h"
+
+#if !defined (decl_node_D)
+# define decl_node_D
+ typedef void *decl_node;
+#endif
+
+typedef struct keyc__T1_r keyc__T1;
+
+typedef keyc__T1 *keyc_scope;
+
+struct keyc__T1_r {
+ decl_node scoped;
+ symbolKey_symbolTree symbols;
+ keyc_scope next;
+ };
+
+static keyc_scope stack;
+static keyc_scope freeList;
+static symbolKey_symbolTree keywords;
+static symbolKey_symbolTree macros;
+static unsigned int initializedCP;
+static unsigned int initializedGCC;
+static unsigned int seenIntMin;
+static unsigned int seenUIntMin;
+static unsigned int seenLongMin;
+static unsigned int seenULongMin;
+static unsigned int seenCharMin;
+static unsigned int seenUCharMin;
+static unsigned int seenIntMax;
+static unsigned int seenUIntMax;
+static unsigned int seenLongMax;
+static unsigned int seenULongMax;
+static unsigned int seenCharMax;
+static unsigned int seenUCharMax;
+static unsigned int seenLabs;
+static unsigned int seenAbs;
+static unsigned int seenFabs;
+static unsigned int seenFabsl;
+static unsigned int seenSize_t;
+static unsigned int seenSSize_t;
+static unsigned int seenUnistd;
+static unsigned int seenSysTypes;
+static unsigned int seenThrow;
+static unsigned int seenFree;
+static unsigned int seenMalloc;
+static unsigned int seenStorage;
+static unsigned int seenProc;
+static unsigned int seenTrue;
+static unsigned int seenFalse;
+static unsigned int seenNull;
+static unsigned int seenMemcpy;
+static unsigned int seenException;
+static unsigned int seenComplex;
+static unsigned int seenM2RTS;
+static unsigned int seenStrlen;
+static unsigned int seenCtype;
+
+/*
+ useUnistd - need to use unistd.h call using open/close/read/write require this header.
+*/
+
+extern "C" void keyc_useUnistd (void);
+
+/*
+ useThrow - use the throw function.
+*/
+
+extern "C" void keyc_useThrow (void);
+
+/*
+ useStorage - indicate we have used storage.
+*/
+
+extern "C" void keyc_useStorage (void);
+
+/*
+ useFree - indicate we have used free.
+*/
+
+extern "C" void keyc_useFree (void);
+
+/*
+ useMalloc - indicate we have used malloc.
+*/
+
+extern "C" void keyc_useMalloc (void);
+
+/*
+ useProc - indicate we have used proc.
+*/
+
+extern "C" void keyc_useProc (void);
+
+/*
+ useTrue - indicate we have used TRUE.
+*/
+
+extern "C" void keyc_useTrue (void);
+
+/*
+ useFalse - indicate we have used FALSE.
+*/
+
+extern "C" void keyc_useFalse (void);
+
+/*
+ useNull - indicate we have used NULL.
+*/
+
+extern "C" void keyc_useNull (void);
+
+/*
+ useMemcpy - indicate we have used memcpy.
+*/
+
+extern "C" void keyc_useMemcpy (void);
+
+/*
+ useIntMin - indicate we have used INT_MIN.
+*/
+
+extern "C" void keyc_useIntMin (void);
+
+/*
+ useUIntMin - indicate we have used UINT_MIN.
+*/
+
+extern "C" void keyc_useUIntMin (void);
+
+/*
+ useLongMin - indicate we have used LONG_MIN.
+*/
+
+extern "C" void keyc_useLongMin (void);
+
+/*
+ useULongMin - indicate we have used ULONG_MIN.
+*/
+
+extern "C" void keyc_useULongMin (void);
+
+/*
+ useCharMin - indicate we have used CHAR_MIN.
+*/
+
+extern "C" void keyc_useCharMin (void);
+
+/*
+ useUCharMin - indicate we have used UCHAR_MIN.
+*/
+
+extern "C" void keyc_useUCharMin (void);
+
+/*
+ useIntMax - indicate we have used INT_MAX.
+*/
+
+extern "C" void keyc_useIntMax (void);
+
+/*
+ useUIntMax - indicate we have used UINT_MAX.
+*/
+
+extern "C" void keyc_useUIntMax (void);
+
+/*
+ useLongMax - indicate we have used LONG_MAX.
+*/
+
+extern "C" void keyc_useLongMax (void);
+
+/*
+ useULongMax - indicate we have used ULONG_MAX.
+*/
+
+extern "C" void keyc_useULongMax (void);
+
+/*
+ useCharMax - indicate we have used CHAR_MAX.
+*/
+
+extern "C" void keyc_useCharMax (void);
+
+/*
+ useUCharMax - indicate we have used UChar_MAX.
+*/
+
+extern "C" void keyc_useUCharMax (void);
+
+/*
+ useSize_t - indicate we have used size_t.
+*/
+
+extern "C" void keyc_useSize_t (void);
+
+/*
+ useSSize_t - indicate we have used ssize_t.
+*/
+
+extern "C" void keyc_useSSize_t (void);
+
+/*
+ useLabs - indicate we have used labs.
+*/
+
+extern "C" void keyc_useLabs (void);
+
+/*
+ useAbs - indicate we have used abs.
+*/
+
+extern "C" void keyc_useAbs (void);
+
+/*
+ useFabs - indicate we have used fabs.
+*/
+
+extern "C" void keyc_useFabs (void);
+
+/*
+ useFabsl - indicate we have used fabsl.
+*/
+
+extern "C" void keyc_useFabsl (void);
+
+/*
+ useException - use the exceptions module, mcrts.
+*/
+
+extern "C" void keyc_useException (void);
+
+/*
+ useComplex - use the complex data type.
+*/
+
+extern "C" void keyc_useComplex (void);
+
+/*
+ useM2RTS - indicate we have used M2RTS in the converted code.
+*/
+
+extern "C" void keyc_useM2RTS (void);
+
+/*
+ useStrlen - indicate we have used strlen in the converted code.
+*/
+
+extern "C" void keyc_useStrlen (void);
+
+/*
+ useCtype - indicate we have used the toupper function.
+*/
+
+extern "C" void keyc_useCtype (void);
+
+/*
+ genDefs - generate definitions or includes for all
+ macros and prototypes used.
+*/
+
+extern "C" void keyc_genDefs (mcPretty_pretty p);
+
+/*
+ genConfigSystem - generate include files for config.h and system.h
+ within the GCC framework.
+*/
+
+extern "C" void keyc_genConfigSystem (mcPretty_pretty p);
+
+/*
+ enterScope - enter a scope defined by, n.
+*/
+
+extern "C" void keyc_enterScope (decl_node n);
+
+/*
+ leaveScope - leave the scope defined by, n.
+*/
+
+extern "C" void keyc_leaveScope (decl_node n);
+
+/*
+ cname - attempts to declare a symbol with name, n, in the
+ current scope. If there is no conflict with the
+ target language then NIL is returned, otherwise
+ a mangled name is returned as a String.
+ If scopes is FALSE then only the keywords and
+ macros are detected for a clash (all scoping
+ is ignored).
+*/
+
+extern "C" DynamicStrings_String keyc_cname (nameKey_Name n, unsigned int scopes);
+
+/*
+ cnamen - attempts to declare a symbol with name, n, in the
+ current scope. If there is no conflict with the
+ target language then NIL is returned, otherwise
+ a mangled name is returned as a Name
+ If scopes is FALSE then only the keywords and
+ macros are detected for a clash (all scoping
+ is ignored).
+*/
+
+extern "C" nameKey_Name keyc_cnamen (nameKey_Name n, unsigned int scopes);
+
+/*
+ cp - include C++ keywords and standard declarations to avoid.
+*/
+
+extern "C" void keyc_cp (void);
+
+/*
+ checkGccConfigSystem - issues the GCC include config.h, include system.h
+ instead of the standard host include.
+*/
+
+static void checkGccConfigSystem (mcPretty_pretty p);
+
+/*
+ checkCtype -
+*/
+
+static void checkCtype (mcPretty_pretty p);
+
+/*
+ checkAbs - check to see if the abs family, size_t or ssize_t have been used.
+*/
+
+static void checkAbs (mcPretty_pretty p);
+
+/*
+ checkLimits -
+*/
+
+static void checkLimits (mcPretty_pretty p);
+
+/*
+ checkFreeMalloc -
+*/
+
+static void checkFreeMalloc (mcPretty_pretty p);
+
+/*
+ checkStorage -
+*/
+
+static void checkStorage (mcPretty_pretty p);
+
+/*
+ checkProc -
+*/
+
+static void checkProc (mcPretty_pretty p);
+
+/*
+ checkTrue -
+*/
+
+static void checkTrue (mcPretty_pretty p);
+
+/*
+ checkFalse -
+*/
+
+static void checkFalse (mcPretty_pretty p);
+
+/*
+ checkNull -
+*/
+
+static void checkNull (mcPretty_pretty p);
+
+/*
+ checkMemcpy -
+*/
+
+static void checkMemcpy (mcPretty_pretty p);
+
+/*
+ checkM2RTS -
+*/
+
+static void checkM2RTS (mcPretty_pretty p);
+
+/*
+ checkException - check to see if exceptions were used.
+*/
+
+static void checkException (mcPretty_pretty p);
+
+/*
+ checkThrow - check to see if the throw function is used.
+*/
+
+static void checkThrow (mcPretty_pretty p);
+
+/*
+ checkUnistd - check to see if the unistd.h header file is required.
+*/
+
+static void checkUnistd (mcPretty_pretty p);
+
+/*
+ checkComplex - check to see if the type complex was used.
+*/
+
+static void checkComplex (mcPretty_pretty p);
+
+/*
+ checkSysTypes - emit header for sys/types.h if necessary.
+*/
+
+static void checkSysTypes (mcPretty_pretty p);
+
+/*
+ fixNullPointerConst - fixup for NULL on some C++11 systems.
+*/
+
+static void fixNullPointerConst (mcPretty_pretty p);
+
+/*
+ new -
+*/
+
+static keyc_scope new_ (decl_node n);
+
+/*
+ mangle1 - returns TRUE if name is unique if we add _
+ to its end.
+*/
+
+static unsigned int mangle1 (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes);
+
+/*
+ mangle2 - returns TRUE if name is unique if we prepend _
+ to, n.
+*/
+
+static unsigned int mangle2 (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes);
+
+/*
+ mangleN - keep adding '_' to the end of n until it
+ no longer clashes.
+*/
+
+static unsigned int mangleN (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes);
+
+/*
+ clash - returns TRUE if there is a clash with name, n,
+ in the current scope or C keywords or C macros.
+*/
+
+static unsigned int clash (nameKey_Name n, unsigned int scopes);
+
+/*
+ initCP - add the extra keywords and standard definitions used by C++.
+*/
+
+static void initCP (void);
+
+/*
+ add -
+*/
+
+static void add (symbolKey_symbolTree s, const char *a_, unsigned int _a_high);
+
+/*
+ initMacros - macros and library function names to avoid.
+*/
+
+static void initMacros (void);
+
+/*
+ initKeywords - keywords to avoid.
+*/
+
+static void initKeywords (void);
+
+/*
+ init -
+*/
+
+static void init (void);
+
+
+/*
+ checkGccConfigSystem - issues the GCC include config.h, include system.h
+ instead of the standard host include.
+*/
+
+static void checkGccConfigSystem (mcPretty_pretty p)
+{
+ if (mcOptions_getGccConfigSystem ())
+ {
+ if (! initializedGCC)
+ {
+ initializedGCC = TRUE;
+ mcPretty_print (p, (const char *) "#include \"config.h\"\\n", 21);
+ mcPretty_print (p, (const char *) "#include \"system.h\"\\n", 21);
+ }
+ }
+}
+
+
+/*
+ checkCtype -
+*/
+
+static void checkCtype (mcPretty_pretty p)
+{
+ if (seenCtype)
+ {
+ checkGccConfigSystem (p);
+ if (mcOptions_getGccConfigSystem ())
+ {
+ /* GCC header files use a safe variant. */
+ mcPretty_print (p, (const char *) "#include <safe-ctype.h>\\n", 25);
+ }
+ else
+ {
+ mcPretty_print (p, (const char *) "#include <ctype.h>\\n", 20);
+ }
+ }
+}
+
+
+/*
+ checkAbs - check to see if the abs family, size_t or ssize_t have been used.
+*/
+
+static void checkAbs (mcPretty_pretty p)
+{
+ if (((((seenLabs || seenAbs) || seenFabs) || seenFabsl) || seenSize_t) || seenSSize_t)
+ {
+ checkGccConfigSystem (p);
+ if (! (mcOptions_getGccConfigSystem ()))
+ {
+ mcPretty_print (p, (const char *) "#include <stdlib.h>\\n", 21);
+ }
+ }
+}
+
+
+/*
+ checkLimits -
+*/
+
+static void checkLimits (mcPretty_pretty p)
+{
+ if ((((((((((((seenMemcpy || seenIntMin) || seenUIntMin) || seenLongMin) || seenULongMin) || seenCharMin) || seenUCharMin) || seenIntMax) || seenUIntMax) || seenLongMax) || seenULongMax) || seenCharMax) || seenUCharMax) /* OR seenUIntMax */
+ {
+ checkGccConfigSystem (p);
+ if (! (mcOptions_getGccConfigSystem ()))
+ {
+ mcPretty_print (p, (const char *) "#include <limits.h>\\n", 21);
+ }
+ }
+}
+
+
+/*
+ checkFreeMalloc -
+*/
+
+static void checkFreeMalloc (mcPretty_pretty p)
+{
+ if (seenFree || seenMalloc)
+ {
+ checkGccConfigSystem (p);
+ if (! (mcOptions_getGccConfigSystem ()))
+ {
+ mcPretty_print (p, (const char *) "#include <stdlib.h>\\n", 21);
+ }
+ }
+}
+
+
+/*
+ checkStorage -
+*/
+
+static void checkStorage (mcPretty_pretty p)
+{
+ if (seenStorage)
+ {
+ mcPretty_print (p, (const char *) "# include \"", 13);
+ mcPretty_prints (p, mcOptions_getHPrefix ());
+ mcPretty_print (p, (const char *) "Storage.h\"\\n", 12);
+ }
+}
+
+
+/*
+ checkProc -
+*/
+
+static void checkProc (mcPretty_pretty p)
+{
+ if (seenProc)
+ {
+ mcPretty_print (p, (const char *) "# if !defined (PROC_D)\\n", 26);
+ mcPretty_print (p, (const char *) "# define PROC_D\\n", 22);
+ mcPretty_print (p, (const char *) " typedef void (*PROC_t) (void);\\n", 39);
+ mcPretty_print (p, (const char *) " typedef struct { PROC_t proc; } PROC;\\n", 46);
+ mcPretty_print (p, (const char *) "# endif\\n\\n", 13);
+ }
+}
+
+
+/*
+ checkTrue -
+*/
+
+static void checkTrue (mcPretty_pretty p)
+{
+ if (seenTrue)
+ {
+ mcPretty_print (p, (const char *) "# if !defined (TRUE)\\n", 24);
+ mcPretty_print (p, (const char *) "# define TRUE (1==1)\\n", 27);
+ mcPretty_print (p, (const char *) "# endif\\n\\n", 13);
+ }
+}
+
+
+/*
+ checkFalse -
+*/
+
+static void checkFalse (mcPretty_pretty p)
+{
+ if (seenFalse)
+ {
+ mcPretty_print (p, (const char *) "# if !defined (FALSE)\\n", 25);
+ mcPretty_print (p, (const char *) "# define FALSE (1==0)\\n", 28);
+ mcPretty_print (p, (const char *) "# endif\\n\\n", 13);
+ }
+}
+
+
+/*
+ checkNull -
+*/
+
+static void checkNull (mcPretty_pretty p)
+{
+ if (seenNull)
+ {
+ checkGccConfigSystem (p);
+ if (! (mcOptions_getGccConfigSystem ()))
+ {
+ mcPretty_print (p, (const char *) "#include <stddef.h>\\n", 21);
+ }
+ }
+}
+
+
+/*
+ checkMemcpy -
+*/
+
+static void checkMemcpy (mcPretty_pretty p)
+{
+ if (seenMemcpy || seenStrlen)
+ {
+ checkGccConfigSystem (p);
+ if (! (mcOptions_getGccConfigSystem ()))
+ {
+ mcPretty_print (p, (const char *) "#include <string.h>\\n", 21);
+ }
+ }
+}
+
+
+/*
+ checkM2RTS -
+*/
+
+static void checkM2RTS (mcPretty_pretty p)
+{
+ if (seenM2RTS)
+ {
+ mcPretty_print (p, (const char *) "# include \"", 13);
+ mcPretty_prints (p, mcOptions_getHPrefix ());
+ mcPretty_print (p, (const char *) "M2RTS.h\"\\n", 10);
+ }
+}
+
+
+/*
+ checkException - check to see if exceptions were used.
+*/
+
+static void checkException (mcPretty_pretty p)
+{
+ if (seenException)
+ {
+ mcPretty_print (p, (const char *) "# include \"Gmcrts.h\"\\n", 24);
+ }
+}
+
+
+/*
+ checkThrow - check to see if the throw function is used.
+*/
+
+static void checkThrow (mcPretty_pretty p)
+{
+ if (seenThrow)
+ {
+ /* print (p, '# include "sys/cdefs.h"
+ ') ; */
+ mcPretty_print (p, (const char *) "#ifndef __cplusplus\\n", 21);
+ mcPretty_print (p, (const char *) "extern void throw (unsigned int);\\n", 35);
+ mcPretty_print (p, (const char *) "#endif\\n", 8);
+ }
+}
+
+
+/*
+ checkUnistd - check to see if the unistd.h header file is required.
+*/
+
+static void checkUnistd (mcPretty_pretty p)
+{
+ if (seenUnistd)
+ {
+ checkGccConfigSystem (p);
+ if (! (mcOptions_getGccConfigSystem ()))
+ {
+ mcPretty_print (p, (const char *) "#include <unistd.h>\\n", 21);
+ }
+ }
+}
+
+
+/*
+ checkComplex - check to see if the type complex was used.
+*/
+
+static void checkComplex (mcPretty_pretty p)
+{
+ if (seenComplex)
+ {
+ checkGccConfigSystem (p);
+ if (! (mcOptions_getGccConfigSystem ()))
+ {
+ mcPretty_print (p, (const char *) "# include <complex.h>\\n", 25);
+ }
+ }
+}
+
+
+/*
+ checkSysTypes - emit header for sys/types.h if necessary.
+*/
+
+static void checkSysTypes (mcPretty_pretty p)
+{
+ if (seenSysTypes)
+ {
+ checkGccConfigSystem (p);
+ if (! (mcOptions_getGccConfigSystem ()))
+ {
+ mcPretty_print (p, (const char *) "# include <sys/types.h>\\n", 27);
+ }
+ }
+}
+
+
+/*
+ fixNullPointerConst - fixup for NULL on some C++11 systems.
+*/
+
+static void fixNullPointerConst (mcPretty_pretty p)
+{
+ if (seenNull)
+ {
+ mcPretty_print (p, (const char *) "#if defined(__cplusplus)\\n", 26);
+ mcPretty_print (p, (const char *) "# undef NULL\\n", 16);
+ mcPretty_print (p, (const char *) "# define NULL 0\\n", 19);
+ mcPretty_print (p, (const char *) "#endif\\n", 8);
+ }
+}
+
+
+/*
+ new -
+*/
+
+static keyc_scope new_ (decl_node n)
+{
+ keyc_scope s;
+
+ if (freeList == NULL)
+ {
+ Storage_ALLOCATE ((void **) &s, sizeof (keyc__T1));
+ }
+ else
+ {
+ s = freeList;
+ freeList = freeList->next;
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ mangle1 - returns TRUE if name is unique if we add _
+ to its end.
+*/
+
+static unsigned int mangle1 (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes)
+{
+ (*m) = DynamicStrings_KillString ((*m));
+ (*m) = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n));
+ (*m) = DynamicStrings_ConCatChar ((*m), '_');
+ return ! (clash (nameKey_makekey (DynamicStrings_string ((*m))), scopes));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ mangle2 - returns TRUE if name is unique if we prepend _
+ to, n.
+*/
+
+static unsigned int mangle2 (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes)
+{
+ (*m) = DynamicStrings_KillString ((*m));
+ (*m) = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n));
+ (*m) = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "_", 1), DynamicStrings_Mark ((*m)));
+ return ! (clash (nameKey_makekey (DynamicStrings_string ((*m))), scopes));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ mangleN - keep adding '_' to the end of n until it
+ no longer clashes.
+*/
+
+static unsigned int mangleN (nameKey_Name n, DynamicStrings_String *m, unsigned int scopes)
+{
+ (*m) = DynamicStrings_KillString ((*m));
+ (*m) = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n));
+ for (;;)
+ {
+ (*m) = DynamicStrings_ConCatChar ((*m), '_');
+ if (! (clash (nameKey_makekey (DynamicStrings_string ((*m))), scopes)))
+ {
+ return TRUE;
+ }
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/keyc.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ clash - returns TRUE if there is a clash with name, n,
+ in the current scope or C keywords or C macros.
+*/
+
+static unsigned int clash (nameKey_Name n, unsigned int scopes)
+{
+ if (((symbolKey_getSymKey (macros, n)) != NULL) || ((symbolKey_getSymKey (keywords, n)) != NULL))
+ {
+ return TRUE;
+ }
+ return scopes && ((symbolKey_getSymKey (stack->symbols, n)) != NULL);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ initCP - add the extra keywords and standard definitions used by C++.
+*/
+
+static void initCP (void)
+{
+ add (keywords, (const char *) "delete", 6);
+ add (keywords, (const char *) "try", 3);
+ add (keywords, (const char *) "catch", 5);
+ add (keywords, (const char *) "operator", 8);
+ add (keywords, (const char *) "complex", 7);
+ add (keywords, (const char *) "export", 6);
+ add (keywords, (const char *) "public", 6);
+}
+
+
+/*
+ add -
+*/
+
+static void add (symbolKey_symbolTree s, const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ symbolKey_putSymKey (s, nameKey_makeKey ((const char *) a, _a_high), reinterpret_cast<void *> (DynamicStrings_InitString ((const char *) a, _a_high)));
+}
+
+
+/*
+ initMacros - macros and library function names to avoid.
+*/
+
+static void initMacros (void)
+{
+ macros = symbolKey_initTree ();
+ add (macros, (const char *) "FILE", 4);
+ add (macros, (const char *) "EOF", 3);
+ add (macros, (const char *) "stdio", 5);
+ add (macros, (const char *) "stdout", 6);
+ add (macros, (const char *) "stderr", 6);
+ add (macros, (const char *) "write", 5);
+ add (macros, (const char *) "read", 4);
+ add (macros, (const char *) "exit", 4);
+ add (macros, (const char *) "abs", 3);
+ add (macros, (const char *) "optarg", 6);
+ add (macros, (const char *) "div", 3);
+ add (macros, (const char *) "sin", 3);
+ add (macros, (const char *) "cos", 3);
+ add (macros, (const char *) "tan", 3);
+ add (macros, (const char *) "log10", 5);
+ add (macros, (const char *) "trunc", 5);
+ add (macros, (const char *) "I", 1);
+ add (macros, (const char *) "csqrt", 5);
+ add (macros, (const char *) "strlen", 6);
+ add (macros, (const char *) "strcpy", 6);
+ add (macros, (const char *) "free", 4);
+ add (macros, (const char *) "malloc", 6);
+ add (macros, (const char *) "time", 4);
+ add (macros, (const char *) "main", 4);
+ add (macros, (const char *) "true", 4);
+ add (macros, (const char *) "false", 5);
+ add (macros, (const char *) "sigfpe", 6);
+}
+
+
+/*
+ initKeywords - keywords to avoid.
+*/
+
+static void initKeywords (void)
+{
+ keywords = symbolKey_initTree ();
+ add (keywords, (const char *) "auto", 4);
+ add (keywords, (const char *) "break", 5);
+ add (keywords, (const char *) "case", 4);
+ add (keywords, (const char *) "char", 4);
+ add (keywords, (const char *) "const", 5);
+ add (keywords, (const char *) "continue", 8);
+ add (keywords, (const char *) "default", 7);
+ add (keywords, (const char *) "do", 2);
+ add (keywords, (const char *) "double", 6);
+ add (keywords, (const char *) "else", 4);
+ add (keywords, (const char *) "enum", 4);
+ add (keywords, (const char *) "extern", 6);
+ add (keywords, (const char *) "float", 5);
+ add (keywords, (const char *) "for", 3);
+ add (keywords, (const char *) "goto", 4);
+ add (keywords, (const char *) "if", 2);
+ add (keywords, (const char *) "int", 3);
+ add (keywords, (const char *) "long", 4);
+ add (keywords, (const char *) "register", 8);
+ add (keywords, (const char *) "return", 6);
+ add (keywords, (const char *) "short", 5);
+ add (keywords, (const char *) "signed", 6);
+ add (keywords, (const char *) "sizeof", 6);
+ add (keywords, (const char *) "static", 6);
+ add (keywords, (const char *) "struct", 6);
+ add (keywords, (const char *) "switch", 6);
+ add (keywords, (const char *) "typedef", 7);
+ add (keywords, (const char *) "union", 5);
+ add (keywords, (const char *) "unsigned", 8);
+ add (keywords, (const char *) "void", 4);
+ add (keywords, (const char *) "volatile", 8);
+ add (keywords, (const char *) "while", 5);
+ add (keywords, (const char *) "and", 3);
+ add (keywords, (const char *) "or", 2);
+ add (keywords, (const char *) "not", 3);
+ add (keywords, (const char *) "throw", 5);
+ add (keywords, (const char *) "new", 3);
+}
+
+
+/*
+ init -
+*/
+
+static void init (void)
+{
+ seenUnistd = FALSE;
+ seenThrow = FALSE;
+ seenFree = FALSE;
+ seenMalloc = FALSE;
+ seenStorage = FALSE;
+ seenProc = FALSE;
+ seenTrue = FALSE;
+ seenFalse = FALSE;
+ seenNull = FALSE;
+ seenMemcpy = FALSE;
+ seenIntMin = FALSE;
+ seenUIntMin = FALSE;
+ seenLongMin = FALSE;
+ seenULongMin = FALSE;
+ seenCharMin = FALSE;
+ seenUCharMin = FALSE;
+ seenIntMax = FALSE;
+ seenUIntMax = FALSE;
+ seenLongMax = FALSE;
+ seenULongMax = FALSE;
+ seenCharMax = FALSE;
+ seenUCharMax = FALSE;
+ seenLabs = FALSE;
+ seenAbs = FALSE;
+ seenFabs = FALSE;
+ seenFabsl = FALSE;
+ seenException = FALSE;
+ seenComplex = FALSE;
+ seenM2RTS = FALSE;
+ seenStrlen = FALSE;
+ seenCtype = FALSE;
+ seenSize_t = FALSE;
+ seenSSize_t = FALSE;
+ seenSysTypes = FALSE;
+ initializedCP = FALSE;
+ initializedGCC = FALSE;
+ stack = NULL;
+ freeList = NULL;
+ initKeywords ();
+ initMacros ();
+}
+
+
+/*
+ useUnistd - need to use unistd.h call using open/close/read/write require this header.
+*/
+
+extern "C" void keyc_useUnistd (void)
+{
+ seenUnistd = TRUE;
+}
+
+
+/*
+ useThrow - use the throw function.
+*/
+
+extern "C" void keyc_useThrow (void)
+{
+ seenThrow = TRUE;
+}
+
+
+/*
+ useStorage - indicate we have used storage.
+*/
+
+extern "C" void keyc_useStorage (void)
+{
+ seenStorage = TRUE;
+}
+
+
+/*
+ useFree - indicate we have used free.
+*/
+
+extern "C" void keyc_useFree (void)
+{
+ seenFree = TRUE;
+}
+
+
+/*
+ useMalloc - indicate we have used malloc.
+*/
+
+extern "C" void keyc_useMalloc (void)
+{
+ seenMalloc = TRUE;
+}
+
+
+/*
+ useProc - indicate we have used proc.
+*/
+
+extern "C" void keyc_useProc (void)
+{
+ seenProc = TRUE;
+}
+
+
+/*
+ useTrue - indicate we have used TRUE.
+*/
+
+extern "C" void keyc_useTrue (void)
+{
+ seenTrue = TRUE;
+}
+
+
+/*
+ useFalse - indicate we have used FALSE.
+*/
+
+extern "C" void keyc_useFalse (void)
+{
+ seenFalse = TRUE;
+}
+
+
+/*
+ useNull - indicate we have used NULL.
+*/
+
+extern "C" void keyc_useNull (void)
+{
+ seenNull = TRUE;
+}
+
+
+/*
+ useMemcpy - indicate we have used memcpy.
+*/
+
+extern "C" void keyc_useMemcpy (void)
+{
+ seenMemcpy = TRUE;
+}
+
+
+/*
+ useIntMin - indicate we have used INT_MIN.
+*/
+
+extern "C" void keyc_useIntMin (void)
+{
+ seenIntMin = TRUE;
+}
+
+
+/*
+ useUIntMin - indicate we have used UINT_MIN.
+*/
+
+extern "C" void keyc_useUIntMin (void)
+{
+ seenUIntMin = TRUE;
+}
+
+
+/*
+ useLongMin - indicate we have used LONG_MIN.
+*/
+
+extern "C" void keyc_useLongMin (void)
+{
+ seenLongMin = TRUE;
+}
+
+
+/*
+ useULongMin - indicate we have used ULONG_MIN.
+*/
+
+extern "C" void keyc_useULongMin (void)
+{
+ seenULongMin = TRUE;
+}
+
+
+/*
+ useCharMin - indicate we have used CHAR_MIN.
+*/
+
+extern "C" void keyc_useCharMin (void)
+{
+ seenCharMin = TRUE;
+}
+
+
+/*
+ useUCharMin - indicate we have used UCHAR_MIN.
+*/
+
+extern "C" void keyc_useUCharMin (void)
+{
+ seenUCharMin = TRUE;
+}
+
+
+/*
+ useIntMax - indicate we have used INT_MAX.
+*/
+
+extern "C" void keyc_useIntMax (void)
+{
+ seenIntMax = TRUE;
+}
+
+
+/*
+ useUIntMax - indicate we have used UINT_MAX.
+*/
+
+extern "C" void keyc_useUIntMax (void)
+{
+ seenUIntMax = TRUE;
+}
+
+
+/*
+ useLongMax - indicate we have used LONG_MAX.
+*/
+
+extern "C" void keyc_useLongMax (void)
+{
+ seenLongMax = TRUE;
+}
+
+
+/*
+ useULongMax - indicate we have used ULONG_MAX.
+*/
+
+extern "C" void keyc_useULongMax (void)
+{
+ seenULongMax = TRUE;
+}
+
+
+/*
+ useCharMax - indicate we have used CHAR_MAX.
+*/
+
+extern "C" void keyc_useCharMax (void)
+{
+ seenCharMax = TRUE;
+}
+
+
+/*
+ useUCharMax - indicate we have used UChar_MAX.
+*/
+
+extern "C" void keyc_useUCharMax (void)
+{
+ seenUCharMax = TRUE;
+}
+
+
+/*
+ useSize_t - indicate we have used size_t.
+*/
+
+extern "C" void keyc_useSize_t (void)
+{
+ seenSize_t = TRUE;
+}
+
+
+/*
+ useSSize_t - indicate we have used ssize_t.
+*/
+
+extern "C" void keyc_useSSize_t (void)
+{
+ seenSSize_t = TRUE;
+ seenSysTypes = TRUE;
+}
+
+
+/*
+ useLabs - indicate we have used labs.
+*/
+
+extern "C" void keyc_useLabs (void)
+{
+ seenLabs = TRUE;
+}
+
+
+/*
+ useAbs - indicate we have used abs.
+*/
+
+extern "C" void keyc_useAbs (void)
+{
+ seenAbs = TRUE;
+}
+
+
+/*
+ useFabs - indicate we have used fabs.
+*/
+
+extern "C" void keyc_useFabs (void)
+{
+ seenFabs = TRUE;
+}
+
+
+/*
+ useFabsl - indicate we have used fabsl.
+*/
+
+extern "C" void keyc_useFabsl (void)
+{
+ seenFabsl = TRUE;
+}
+
+
+/*
+ useException - use the exceptions module, mcrts.
+*/
+
+extern "C" void keyc_useException (void)
+{
+ seenException = TRUE;
+}
+
+
+/*
+ useComplex - use the complex data type.
+*/
+
+extern "C" void keyc_useComplex (void)
+{
+ seenComplex = TRUE;
+}
+
+
+/*
+ useM2RTS - indicate we have used M2RTS in the converted code.
+*/
+
+extern "C" void keyc_useM2RTS (void)
+{
+ seenM2RTS = TRUE;
+}
+
+
+/*
+ useStrlen - indicate we have used strlen in the converted code.
+*/
+
+extern "C" void keyc_useStrlen (void)
+{
+ seenStrlen = TRUE;
+}
+
+
+/*
+ useCtype - indicate we have used the toupper function.
+*/
+
+extern "C" void keyc_useCtype (void)
+{
+ seenCtype = TRUE;
+}
+
+
+/*
+ genDefs - generate definitions or includes for all
+ macros and prototypes used.
+*/
+
+extern "C" void keyc_genDefs (mcPretty_pretty p)
+{
+ checkFreeMalloc (p);
+ checkProc (p);
+ checkTrue (p);
+ checkFalse (p);
+ checkNull (p);
+ checkMemcpy (p);
+ checkLimits (p);
+ checkAbs (p);
+ checkStorage (p);
+ checkException (p);
+ checkComplex (p);
+ checkCtype (p);
+ checkUnistd (p);
+ checkSysTypes (p);
+ checkM2RTS (p);
+ checkThrow (p);
+ fixNullPointerConst (p);
+}
+
+
+/*
+ genConfigSystem - generate include files for config.h and system.h
+ within the GCC framework.
+*/
+
+extern "C" void keyc_genConfigSystem (mcPretty_pretty p)
+{
+ checkGccConfigSystem (p);
+}
+
+
+/*
+ enterScope - enter a scope defined by, n.
+*/
+
+extern "C" void keyc_enterScope (decl_node n)
+{
+ keyc_scope s;
+
+ s = new_ (n);
+ s->scoped = n;
+ s->symbols = symbolKey_initTree ();
+ s->next = stack;
+ stack = s;
+}
+
+
+/*
+ leaveScope - leave the scope defined by, n.
+*/
+
+extern "C" void keyc_leaveScope (decl_node n)
+{
+ keyc_scope s;
+
+ if (n == stack->scoped)
+ {
+ s = stack;
+ stack = stack->next;
+ s->scoped = static_cast<decl_node> (NULL);
+ symbolKey_killTree (&s->symbols);
+ s->next = NULL;
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ cname - attempts to declare a symbol with name, n, in the
+ current scope. If there is no conflict with the
+ target language then NIL is returned, otherwise
+ a mangled name is returned as a String.
+ If scopes is FALSE then only the keywords and
+ macros are detected for a clash (all scoping
+ is ignored).
+*/
+
+extern "C" DynamicStrings_String keyc_cname (nameKey_Name n, unsigned int scopes)
+{
+ DynamicStrings_String m;
+
+ m = static_cast<DynamicStrings_String> (NULL);
+ if (clash (n, scopes))
+ {
+ if (((mangle1 (n, &m, scopes)) || (mangle2 (n, &m, scopes))) || (mangleN (n, &m, scopes)))
+ {
+ /* avoid dangling else. */
+ if (scopes)
+ {
+ /* no longer a clash with, m, so add it to the current scope. */
+ n = nameKey_makekey (DynamicStrings_string (m));
+ symbolKey_putSymKey (stack->symbols, n, reinterpret_cast<void *> (m));
+ }
+ }
+ else
+ {
+ /* mangleN must always succeed. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ }
+ else if (scopes)
+ {
+ /* avoid dangling else. */
+ /* no clash, add it to the current scope. */
+ symbolKey_putSymKey (stack->symbols, n, reinterpret_cast<void *> (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))));
+ }
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ cnamen - attempts to declare a symbol with name, n, in the
+ current scope. If there is no conflict with the
+ target language then NIL is returned, otherwise
+ a mangled name is returned as a Name
+ If scopes is FALSE then only the keywords and
+ macros are detected for a clash (all scoping
+ is ignored).
+*/
+
+extern "C" nameKey_Name keyc_cnamen (nameKey_Name n, unsigned int scopes)
+{
+ DynamicStrings_String m;
+
+ m = static_cast<DynamicStrings_String> (NULL);
+ if (clash (n, scopes))
+ {
+ if (((mangle1 (n, &m, scopes)) || (mangle2 (n, &m, scopes))) || (mangleN (n, &m, scopes)))
+ {
+ /* avoid dangling else. */
+ n = nameKey_makekey (DynamicStrings_string (m));
+ if (scopes)
+ {
+ /* no longer a clash with, m, so add it to the current scope. */
+ symbolKey_putSymKey (stack->symbols, n, reinterpret_cast<void *> (m));
+ }
+ }
+ else
+ {
+ /* mangleN must always succeed. */
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ }
+ else if (scopes)
+ {
+ /* avoid dangling else. */
+ /* no clash, add it to the current scope. */
+ symbolKey_putSymKey (stack->symbols, n, reinterpret_cast<void *> (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n))));
+ }
+ m = DynamicStrings_KillString (m);
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ cp - include C++ keywords and standard declarations to avoid.
+*/
+
+extern "C" void keyc_cp (void)
+{
+ if (! initializedCP)
+ {
+ initializedCP = TRUE;
+ initCP ();
+ }
+}
+
+extern "C" void _M2_keyc_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ init ();
+}
+
+extern "C" void _M2_keyc_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from lists. */
+/* Dynamic list library for pointers.
+ Copyright (C) 2015-2023 Free Software Foundation, Inc.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _lists_H
+#define _lists_C
+
+# include "GStorage.h"
+
+typedef struct symbolKey_performOperation_p symbolKey_performOperation;
+
+# define MaxnoOfelements 5
+typedef struct lists__T1_r lists__T1;
+
+typedef struct lists__T2_a lists__T2;
+
+typedef lists__T1 *lists_list;
+
+typedef void (*symbolKey_performOperation_t) (void *);
+struct symbolKey_performOperation_p { symbolKey_performOperation_t proc; };
+
+struct lists__T2_a { void * array[MaxnoOfelements-1+1]; };
+struct lists__T1_r {
+ unsigned int noOfelements;
+ lists__T2 elements;
+ lists_list next;
+ };
+
+
+/*
+ initList - creates a new list, l.
+*/
+
+extern "C" lists_list lists_initList (void);
+
+/*
+ killList - deletes the complete list, l.
+*/
+
+extern "C" void lists_killList (lists_list *l);
+
+/*
+ putItemIntoList - places an ADDRESS, c, into list, l.
+*/
+
+extern "C" void lists_putItemIntoList (lists_list l, void * c);
+
+/*
+ getItemFromList - retrieves the nth WORD from list, l.
+*/
+
+extern "C" void * lists_getItemFromList (lists_list l, unsigned int n);
+
+/*
+ getIndexOfList - returns the index for WORD, c, in list, l.
+ If more than one WORD, c, exists the index
+ for the first is returned.
+*/
+
+extern "C" unsigned int lists_getIndexOfList (lists_list l, void * c);
+
+/*
+ noOfItemsInList - returns the number of items in list, l.
+*/
+
+extern "C" unsigned int lists_noOfItemsInList (lists_list l);
+
+/*
+ includeItemIntoList - adds an ADDRESS, c, into a list providing
+ the value does not already exist.
+*/
+
+extern "C" void lists_includeItemIntoList (lists_list l, void * c);
+
+/*
+ removeItemFromList - removes a ADDRESS, c, from a list.
+ It assumes that this value only appears once.
+*/
+
+extern "C" void lists_removeItemFromList (lists_list l, void * c);
+
+/*
+ isItemInList - returns true if a ADDRESS, c, was found in list, l.
+*/
+
+extern "C" unsigned int lists_isItemInList (lists_list l, void * c);
+
+/*
+ foreachItemInListDo - calls procedure, P, foreach item in list, l.
+*/
+
+extern "C" void lists_foreachItemInListDo (lists_list l, symbolKey_performOperation p);
+
+/*
+ duplicateList - returns a duplicate list derived from, l.
+*/
+
+extern "C" lists_list lists_duplicateList (lists_list l);
+
+/*
+ removeItem - remove an element at index, i, from the list data type.
+*/
+
+static void removeItem (lists_list p, lists_list l, unsigned int i);
+
+
+/*
+ removeItem - remove an element at index, i, from the list data type.
+*/
+
+static void removeItem (lists_list p, lists_list l, unsigned int i)
+{
+ l->noOfelements -= 1;
+ while (i <= l->noOfelements)
+ {
+ l->elements.array[i-1] = l->elements.array[i+1-1];
+ i += 1;
+ }
+ if ((l->noOfelements == 0) && (p != NULL))
+ {
+ p->next = l->next;
+ Storage_DEALLOCATE ((void **) &l, sizeof (lists__T1));
+ }
+}
+
+
+/*
+ initList - creates a new list, l.
+*/
+
+extern "C" lists_list lists_initList (void)
+{
+ lists_list l;
+
+ Storage_ALLOCATE ((void **) &l, sizeof (lists__T1));
+ l->noOfelements = 0;
+ l->next = NULL;
+ return l;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ killList - deletes the complete list, l.
+*/
+
+extern "C" void lists_killList (lists_list *l)
+{
+ if ((*l) != NULL)
+ {
+ if ((*l)->next != NULL)
+ {
+ lists_killList (&(*l)->next);
+ }
+ Storage_DEALLOCATE ((void **) &(*l), sizeof (lists__T1));
+ }
+}
+
+
+/*
+ putItemIntoList - places an ADDRESS, c, into list, l.
+*/
+
+extern "C" void lists_putItemIntoList (lists_list l, void * c)
+{
+ if (l->noOfelements < MaxnoOfelements)
+ {
+ l->noOfelements += 1;
+ l->elements.array[l->noOfelements-1] = c;
+ }
+ else if (l->next != NULL)
+ {
+ /* avoid dangling else. */
+ lists_putItemIntoList (l->next, c);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ l->next = lists_initList ();
+ lists_putItemIntoList (l->next, c);
+ }
+}
+
+
+/*
+ getItemFromList - retrieves the nth WORD from list, l.
+*/
+
+extern "C" void * lists_getItemFromList (lists_list l, unsigned int n)
+{
+ while (l != NULL)
+ {
+ if (n <= l->noOfelements)
+ {
+ return l->elements.array[n-1];
+ }
+ else
+ {
+ n -= l->noOfelements;
+ }
+ l = l->next;
+ }
+ return reinterpret_cast<void *> (0);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getIndexOfList - returns the index for WORD, c, in list, l.
+ If more than one WORD, c, exists the index
+ for the first is returned.
+*/
+
+extern "C" unsigned int lists_getIndexOfList (lists_list l, void * c)
+{
+ unsigned int i;
+
+ if (l == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ i = 1;
+ while (i <= l->noOfelements)
+ {
+ if (l->elements.array[i-1] == c)
+ {
+ return i;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ return l->noOfelements+(lists_getIndexOfList (l->next, c));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ noOfItemsInList - returns the number of items in list, l.
+*/
+
+extern "C" unsigned int lists_noOfItemsInList (lists_list l)
+{
+ unsigned int t;
+
+ if (l == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ t = 0;
+ do {
+ t += l->noOfelements;
+ l = l->next;
+ } while (! (l == NULL));
+ return t;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ includeItemIntoList - adds an ADDRESS, c, into a list providing
+ the value does not already exist.
+*/
+
+extern "C" void lists_includeItemIntoList (lists_list l, void * c)
+{
+ if (! (lists_isItemInList (l, c)))
+ {
+ lists_putItemIntoList (l, c);
+ }
+}
+
+
+/*
+ removeItemFromList - removes a ADDRESS, c, from a list.
+ It assumes that this value only appears once.
+*/
+
+extern "C" void lists_removeItemFromList (lists_list l, void * c)
+{
+ lists_list p;
+ unsigned int i;
+ unsigned int found;
+
+ if (l != NULL)
+ {
+ found = FALSE;
+ p = NULL;
+ do {
+ i = 1;
+ while ((i <= l->noOfelements) && (l->elements.array[i-1] != c))
+ {
+ i += 1;
+ }
+ if ((i <= l->noOfelements) && (l->elements.array[i-1] == c))
+ {
+ found = TRUE;
+ }
+ else
+ {
+ p = l;
+ l = l->next;
+ }
+ } while (! ((l == NULL) || found));
+ if (found)
+ {
+ removeItem (p, l, i);
+ }
+ }
+}
+
+
+/*
+ isItemInList - returns true if a ADDRESS, c, was found in list, l.
+*/
+
+extern "C" unsigned int lists_isItemInList (lists_list l, void * c)
+{
+ unsigned int i;
+
+ do {
+ i = 1;
+ while (i <= l->noOfelements)
+ {
+ if (l->elements.array[i-1] == c)
+ {
+ return TRUE;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ l = l->next;
+ } while (! (l == NULL));
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ foreachItemInListDo - calls procedure, P, foreach item in list, l.
+*/
+
+extern "C" void lists_foreachItemInListDo (lists_list l, symbolKey_performOperation p)
+{
+ unsigned int i;
+ unsigned int n;
+
+ n = lists_noOfItemsInList (l);
+ i = 1;
+ while (i <= n)
+ {
+ (*p.proc) (lists_getItemFromList (l, i));
+ i += 1;
+ }
+}
+
+
+/*
+ duplicateList - returns a duplicate list derived from, l.
+*/
+
+extern "C" lists_list lists_duplicateList (lists_list l)
+{
+ lists_list m;
+ unsigned int n;
+ unsigned int i;
+
+ m = lists_initList ();
+ n = lists_noOfItemsInList (l);
+ i = 1;
+ while (i <= n)
+ {
+ lists_putItemIntoList (m, lists_getItemFromList (l, i));
+ i += 1;
+ }
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_lists_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_lists_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcComment. */
+/* mcComment.mod provides a module to remember the comments.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcComment_H
+#define _mcComment_C
+
+# include "GDynamicStrings.h"
+# include "GStorage.h"
+# include "GnameKey.h"
+# include "GmcDebug.h"
+# include "GASCII.h"
+# include "Glibc.h"
+
+typedef struct mcComment__T1_r mcComment__T1;
+
+typedef enum {mcComment_unknown, mcComment_procedureHeading, mcComment_inBody, mcComment_afterStatement} mcComment_commentType;
+
+typedef mcComment__T1 *mcComment_commentDesc;
+
+struct mcComment__T1_r {
+ mcComment_commentType type;
+ DynamicStrings_String content;
+ nameKey_Name procName;
+ unsigned int used;
+ };
+
+
+/*
+ initComment - the start of a new comment has been seen by the lexical analyser.
+ A new comment block is created and all addText contents are placed
+ in this block. onlySpaces indicates whether we have only seen
+ spaces on this line.
+*/
+
+extern "C" mcComment_commentDesc mcComment_initComment (unsigned int onlySpaces);
+
+/*
+ addText - cs is a C string (null terminated) which contains comment text.
+ This is appended to the comment, cd.
+*/
+
+extern "C" void mcComment_addText (mcComment_commentDesc cd, void * cs);
+
+/*
+ getContent - returns the content of comment, cd.
+*/
+
+extern "C" DynamicStrings_String mcComment_getContent (mcComment_commentDesc cd);
+
+/*
+ getCommentCharStar - returns the C string content of comment, cd.
+*/
+
+extern "C" void * mcComment_getCommentCharStar (mcComment_commentDesc cd);
+
+/*
+ setProcedureComment - changes the type of comment, cd, to a
+ procedure heading comment,
+ providing it has the procname as the first word.
+*/
+
+extern "C" void mcComment_setProcedureComment (mcComment_commentDesc cd, nameKey_Name procname);
+
+/*
+ getProcedureComment - returns the current procedure comment if available.
+*/
+
+extern "C" DynamicStrings_String mcComment_getProcedureComment (mcComment_commentDesc cd);
+
+/*
+ getAfterStatementComment - returns the current statement after comment if available.
+*/
+
+extern "C" DynamicStrings_String mcComment_getAfterStatementComment (mcComment_commentDesc cd);
+
+/*
+ getInbodyStatementComment - returns the current statement after comment if available.
+*/
+
+extern "C" DynamicStrings_String mcComment_getInbodyStatementComment (mcComment_commentDesc cd);
+
+/*
+ isProcedureComment - returns TRUE if, cd, is a procedure comment.
+*/
+
+extern "C" unsigned int mcComment_isProcedureComment (mcComment_commentDesc cd);
+
+/*
+ isBodyComment - returns TRUE if, cd, is a body comment.
+*/
+
+extern "C" unsigned int mcComment_isBodyComment (mcComment_commentDesc cd);
+
+/*
+ isAfterComment - returns TRUE if, cd, is an after comment.
+*/
+
+extern "C" unsigned int mcComment_isAfterComment (mcComment_commentDesc cd);
+
+/*
+ Min - returns the lower of, a, and, b.
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b);
+
+/*
+ RemoveNewlines -
+*/
+
+static DynamicStrings_String RemoveNewlines (DynamicStrings_String s);
+
+/*
+ seenProcedure - returns TRUE if the name, procName, appears as the first word
+ in the comment.
+*/
+
+static unsigned int seenProcedure (mcComment_commentDesc cd, nameKey_Name procName);
+
+/*
+ dumpComment -
+*/
+
+static void dumpComment (mcComment_commentDesc cd);
+
+
+/*
+ Min - returns the lower of, a, and, b.
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveNewlines -
+*/
+
+static DynamicStrings_String RemoveNewlines (DynamicStrings_String s)
+{
+ while ((DynamicStrings_Length (s)) > 0)
+ {
+ if ((DynamicStrings_char (s, 0)) == ASCII_nl)
+ {
+ s = DynamicStrings_RemoveWhitePrefix (DynamicStrings_Slice (s, 1, 0));
+ }
+ else
+ {
+ return DynamicStrings_RemoveWhitePrefix (s);
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ seenProcedure - returns TRUE if the name, procName, appears as the first word
+ in the comment.
+*/
+
+static unsigned int seenProcedure (mcComment_commentDesc cd, nameKey_Name procName)
+{
+ DynamicStrings_String s;
+ void * a;
+ unsigned int i;
+ unsigned int h;
+ unsigned int res;
+
+ a = nameKey_keyToCharStar (procName);
+ s = RemoveNewlines (cd->content);
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast<int> (Min (DynamicStrings_Length (s), nameKey_lengthKey (procName))));
+ res = DynamicStrings_EqualCharStar (s, a);
+ s = DynamicStrings_KillString (s);
+ return res;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dumpComment -
+*/
+
+static void dumpComment (mcComment_commentDesc cd)
+{
+ libc_printf ((const char *) "comment : ", 10);
+ switch (cd->type)
+ {
+ case mcComment_unknown:
+ libc_printf ((const char *) "unknown", 7);
+ break;
+
+ case mcComment_procedureHeading:
+ libc_printf ((const char *) "procedureheading", 16);
+ break;
+
+ case mcComment_inBody:
+ libc_printf ((const char *) "inbody", 6);
+ break;
+
+ case mcComment_afterStatement:
+ libc_printf ((const char *) "afterstatement", 14);
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/mc/mcComment.def", 20, 1);
+ __builtin_unreachable ();
+ }
+ if (cd->used)
+ {
+ libc_printf ((const char *) " used", 5);
+ }
+ else
+ {
+ libc_printf ((const char *) " unused", 7);
+ }
+ libc_printf ((const char *) " contents = %s\\n", 16, DynamicStrings_string (cd->content));
+}
+
+
+/*
+ initComment - the start of a new comment has been seen by the lexical analyser.
+ A new comment block is created and all addText contents are placed
+ in this block. onlySpaces indicates whether we have only seen
+ spaces on this line.
+*/
+
+extern "C" mcComment_commentDesc mcComment_initComment (unsigned int onlySpaces)
+{
+ mcComment_commentDesc cd;
+
+ Storage_ALLOCATE ((void **) &cd, sizeof (mcComment__T1));
+ mcDebug_assert (cd != NULL);
+ if (onlySpaces)
+ {
+ cd->type = mcComment_inBody;
+ }
+ else
+ {
+ cd->type = mcComment_afterStatement;
+ }
+ cd->content = DynamicStrings_InitString ((const char *) "", 0);
+ cd->procName = nameKey_NulName;
+ cd->used = FALSE;
+ return cd;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addText - cs is a C string (null terminated) which contains comment text.
+ This is appended to the comment, cd.
+*/
+
+extern "C" void mcComment_addText (mcComment_commentDesc cd, void * cs)
+{
+ if (cd != NULL)
+ {
+ cd->content = DynamicStrings_ConCat (cd->content, DynamicStrings_InitStringCharStar (cs));
+ }
+}
+
+
+/*
+ getContent - returns the content of comment, cd.
+*/
+
+extern "C" DynamicStrings_String mcComment_getContent (mcComment_commentDesc cd)
+{
+ if (cd != NULL)
+ {
+ return cd->content;
+ }
+ return static_cast<DynamicStrings_String> (NULL);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getCommentCharStar - returns the C string content of comment, cd.
+*/
+
+extern "C" void * mcComment_getCommentCharStar (mcComment_commentDesc cd)
+{
+ DynamicStrings_String s;
+
+ s = mcComment_getContent (cd);
+ if (s == NULL)
+ {
+ return NULL;
+ }
+ else
+ {
+ return DynamicStrings_string (s);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ setProcedureComment - changes the type of comment, cd, to a
+ procedure heading comment,
+ providing it has the procname as the first word.
+*/
+
+extern "C" void mcComment_setProcedureComment (mcComment_commentDesc cd, nameKey_Name procname)
+{
+ if (cd != NULL)
+ {
+ if (seenProcedure (cd, procname))
+ {
+ cd->type = mcComment_procedureHeading;
+ cd->procName = procname;
+ }
+ }
+}
+
+
+/*
+ getProcedureComment - returns the current procedure comment if available.
+*/
+
+extern "C" DynamicStrings_String mcComment_getProcedureComment (mcComment_commentDesc cd)
+{
+ if ((cd->type == mcComment_procedureHeading) && ! cd->used)
+ {
+ cd->used = TRUE;
+ return cd->content;
+ }
+ return static_cast<DynamicStrings_String> (NULL);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getAfterStatementComment - returns the current statement after comment if available.
+*/
+
+extern "C" DynamicStrings_String mcComment_getAfterStatementComment (mcComment_commentDesc cd)
+{
+ if ((cd->type == mcComment_afterStatement) && ! cd->used)
+ {
+ cd->used = TRUE;
+ return cd->content;
+ }
+ return static_cast<DynamicStrings_String> (NULL);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getInbodyStatementComment - returns the current statement after comment if available.
+*/
+
+extern "C" DynamicStrings_String mcComment_getInbodyStatementComment (mcComment_commentDesc cd)
+{
+ if ((cd->type == mcComment_inBody) && ! cd->used)
+ {
+ cd->used = TRUE;
+ return cd->content;
+ }
+ return static_cast<DynamicStrings_String> (NULL);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isProcedureComment - returns TRUE if, cd, is a procedure comment.
+*/
+
+extern "C" unsigned int mcComment_isProcedureComment (mcComment_commentDesc cd)
+{
+ return (cd != NULL) && (cd->type == mcComment_procedureHeading);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isBodyComment - returns TRUE if, cd, is a body comment.
+*/
+
+extern "C" unsigned int mcComment_isBodyComment (mcComment_commentDesc cd)
+{
+ return (cd != NULL) && (cd->type == mcComment_inBody);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isAfterComment - returns TRUE if, cd, is an after comment.
+*/
+
+extern "C" unsigned int mcComment_isAfterComment (mcComment_commentDesc cd)
+{
+ return (cd != NULL) && (cd->type == mcComment_afterStatement);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcComment_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcComment_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcComp. */
+/* Copyright (C) 2015-2023 Free Software Foundation, Inc.
+ This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcComp_H
+#define _mcComp_C
+
+# include "GFIO.h"
+# include "Glibc.h"
+# include "Gdecl.h"
+# include "GsymbolKey.h"
+# include "GSYSTEM.h"
+# include "GmcReserved.h"
+# include "GmcSearch.h"
+# include "GmcLexBuf.h"
+# include "GmcFileName.h"
+# include "GmcPreprocess.h"
+# include "GFormatStrings.h"
+# include "Gmcflex.h"
+# include "Gmcp1.h"
+# include "Gmcp2.h"
+# include "Gmcp3.h"
+# include "Gmcp4.h"
+# include "Gmcp5.h"
+# include "GmcComment.h"
+# include "GmcError.h"
+# include "GnameKey.h"
+# include "GmcPrintf.h"
+# include "GmcQuiet.h"
+# include "GDynamicStrings.h"
+# include "GmcOptions.h"
+
+# define Debugging FALSE
+typedef struct mcComp_parserFunction_p mcComp_parserFunction;
+
+typedef struct mcComp_openFunction_p mcComp_openFunction;
+
+typedef unsigned int (*mcComp_parserFunction_t) (void);
+struct mcComp_parserFunction_p { mcComp_parserFunction_t proc; };
+
+typedef unsigned int (*mcComp_openFunction_t) (decl_node, unsigned int);
+struct mcComp_openFunction_p { mcComp_openFunction_t proc; };
+
+static unsigned int currentPass;
+
+/*
+ compile - check, s, is non NIL before calling doCompile.
+*/
+
+extern "C" void mcComp_compile (DynamicStrings_String s);
+
+/*
+ getPassNo - return the pass no.
+*/
+
+extern "C" unsigned int mcComp_getPassNo (void);
+
+/*
+ doCompile - translate file, s, using a 6 pass technique.
+*/
+
+static void doCompile (DynamicStrings_String s);
+
+/*
+ examineCompilationUnit - opens the source file to obtain the module name and kind of module.
+*/
+
+static decl_node examineCompilationUnit (void);
+
+/*
+ peepInto - peeps into source, s, and initializes a definition/implementation or
+ program module accordingly.
+*/
+
+static decl_node peepInto (DynamicStrings_String s);
+
+/*
+ initParser - returns the node of the module found in the source file.
+*/
+
+static decl_node initParser (DynamicStrings_String s);
+
+/*
+ p1 - wrap the pass procedure with the correct parameter values.
+*/
+
+static void p1 (decl_node n);
+
+/*
+ p2 - wrap the pass procedure with the correct parameter values.
+*/
+
+static void p2 (decl_node n);
+
+/*
+ p3 - wrap the pass procedure with the correct parameter values.
+*/
+
+static void p3 (decl_node n);
+
+/*
+ p4 - wrap the pass procedure with the correct parameter values.
+*/
+
+static void p4 (decl_node n);
+
+/*
+ p5 - wrap the pass procedure with the correct parameter values.
+*/
+
+static void p5 (decl_node n);
+
+/*
+ doOpen -
+*/
+
+static unsigned int doOpen (decl_node n, DynamicStrings_String symName, DynamicStrings_String fileName, unsigned int exitOnFailure);
+
+/*
+ openDef - try and open the definition module source file.
+ Returns true/false if successful/unsuccessful or
+ exitOnFailure.
+*/
+
+static unsigned int openDef (decl_node n, unsigned int exitOnFailure);
+
+/*
+ openMod - try and open the implementation/program module source file.
+ Returns true/false if successful/unsuccessful or
+ exitOnFailure.
+*/
+
+static unsigned int openMod (decl_node n, unsigned int exitOnFailure);
+
+/*
+ pass -
+*/
+
+static void pass (unsigned int no, decl_node n, mcComp_parserFunction f, decl_isNodeF isnode, mcComp_openFunction open);
+
+/*
+ doPass -
+*/
+
+static void doPass (unsigned int parseDefs, unsigned int parseMain, unsigned int no, symbolKey_performOperation p, const char *desc_, unsigned int _desc_high);
+
+/*
+ setToPassNo -
+*/
+
+static void setToPassNo (unsigned int n);
+
+/*
+ init - initialise data structures for this module.
+*/
+
+static void init (void);
+
+
+/*
+ doCompile - translate file, s, using a 6 pass technique.
+*/
+
+static void doCompile (DynamicStrings_String s)
+{
+ decl_node n;
+
+ n = initParser (s);
+ doPass (TRUE, TRUE, 1, (symbolKey_performOperation) {(symbolKey_performOperation_t) p1}, (const char *) "lexical analysis, modules, root decls and C preprocessor", 56);
+ doPass (TRUE, TRUE, 2, (symbolKey_performOperation) {(symbolKey_performOperation_t) p2}, (const char *) "[all modules] type equivalence and enumeration types", 52);
+ doPass (TRUE, TRUE, 3, (symbolKey_performOperation) {(symbolKey_performOperation_t) p3}, (const char *) "[all modules] import lists, types, variables and procedure declarations", 71);
+ doPass (TRUE, TRUE, 4, (symbolKey_performOperation) {(symbolKey_performOperation_t) p4}, (const char *) "[all modules] constant expressions", 34);
+ if (! (decl_isDef (n)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (decl_isImp (n))
+ {
+ mcQuiet_qprintf0 ((const char *) "Parse implementation module\\n", 29);
+ doPass (FALSE, TRUE, 5, (symbolKey_performOperation) {(symbolKey_performOperation_t) p5}, (const char *) "[implementation module] build code tree for all procedures and module initializations", 85);
+ }
+ else
+ {
+ mcQuiet_qprintf0 ((const char *) "Parse program module\\n", 22);
+ doPass (FALSE, TRUE, 5, (symbolKey_performOperation) {(symbolKey_performOperation_t) p5}, (const char *) "[program module] build code tree for all procedures and module initializations", 78);
+ }
+ }
+ mcQuiet_qprintf0 ((const char *) "walk tree converting it to C/C++\\n", 34);
+ decl_out ();
+}
+
+
+/*
+ examineCompilationUnit - opens the source file to obtain the module name and kind of module.
+*/
+
+static decl_node examineCompilationUnit (void)
+{
+ /* stop if we see eof, ';' or '[' */
+ while (((mcLexBuf_currenttoken != mcReserved_eoftok) && (mcLexBuf_currenttoken != mcReserved_semicolontok)) && (mcLexBuf_currenttoken != mcReserved_lsbratok))
+ {
+ if (mcLexBuf_currenttoken == mcReserved_definitiontok)
+ {
+ mcLexBuf_getToken ();
+ if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ mcLexBuf_getToken ();
+ if (mcLexBuf_currenttoken == mcReserved_fortok)
+ {
+ mcLexBuf_getToken ();
+ if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ mcLexBuf_getToken ();
+ }
+ else
+ {
+ mcflex_mcError (DynamicStrings_string (DynamicStrings_InitString ((const char *) "expecting language string after FOR keyword", 43)));
+ libc_exit (1);
+ }
+ }
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ return decl_lookupDef (nameKey_makekey (mcLexBuf_currentstring));
+ }
+ }
+ else
+ {
+ mcflex_mcError (DynamicStrings_string (DynamicStrings_InitString ((const char *) "MODULE missing after DEFINITION keyword", 39)));
+ }
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_implementationtok)
+ {
+ /* avoid dangling else. */
+ mcLexBuf_getToken ();
+ if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ mcLexBuf_getToken ();
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ return decl_lookupImp (nameKey_makekey (mcLexBuf_currentstring));
+ }
+ }
+ else
+ {
+ mcflex_mcError (DynamicStrings_string (DynamicStrings_InitString ((const char *) "MODULE missing after IMPLEMENTATION keyword", 43)));
+ }
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ mcLexBuf_getToken ();
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ return decl_lookupModule (nameKey_makekey (mcLexBuf_currentstring));
+ }
+ }
+ mcLexBuf_getToken ();
+ }
+ mcflex_mcError (DynamicStrings_string (DynamicStrings_InitString ((const char *) "failed to find module name", 26)));
+ libc_exit (1);
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/mcComp.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ peepInto - peeps into source, s, and initializes a definition/implementation or
+ program module accordingly.
+*/
+
+static decl_node peepInto (DynamicStrings_String s)
+{
+ decl_node n;
+ DynamicStrings_String fileName;
+
+ fileName = mcPreprocess_preprocessModule (s);
+ if (mcLexBuf_openSource (fileName))
+ {
+ n = examineCompilationUnit ();
+ decl_setSource (n, nameKey_makekey (DynamicStrings_string (fileName)));
+ decl_setMainModule (n);
+ mcLexBuf_closeSource ();
+ mcLexBuf_reInitialize ();
+ return n;
+ }
+ else
+ {
+ mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to open %s\\n", 19, (const unsigned char *) &s, (sizeof (s)-1));
+ libc_exit (1);
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/mcComp.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ initParser - returns the node of the module found in the source file.
+*/
+
+static decl_node initParser (DynamicStrings_String s)
+{
+ mcQuiet_qprintf1 ((const char *) "Compiling: %s\\n", 15, (const unsigned char *) &s, (sizeof (s)-1));
+ return peepInto (s);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ p1 - wrap the pass procedure with the correct parameter values.
+*/
+
+static void p1 (decl_node n)
+{
+ if (decl_isDef (n))
+ {
+ /* avoid dangling else. */
+ pass (1, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp1_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isDef}, (mcComp_openFunction) {(mcComp_openFunction_t) openDef});
+ if ((decl_hasHidden (n)) && (mcOptions_getExtendedOpaque ()))
+ {
+ pass (1, decl_lookupImp (decl_getSymName (n)), (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp1_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImp}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod});
+ }
+ }
+ else
+ {
+ pass (1, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp1_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImpOrModule}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod});
+ }
+}
+
+
+/*
+ p2 - wrap the pass procedure with the correct parameter values.
+*/
+
+static void p2 (decl_node n)
+{
+ if (decl_isDef (n))
+ {
+ /* avoid dangling else. */
+ pass (2, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp2_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isDef}, (mcComp_openFunction) {(mcComp_openFunction_t) openDef});
+ if ((decl_hasHidden (n)) && (mcOptions_getExtendedOpaque ()))
+ {
+ pass (2, decl_lookupImp (decl_getSymName (n)), (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp2_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImp}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod});
+ }
+ }
+ else
+ {
+ pass (2, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp2_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImpOrModule}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod});
+ }
+}
+
+
+/*
+ p3 - wrap the pass procedure with the correct parameter values.
+*/
+
+static void p3 (decl_node n)
+{
+ if (decl_isDef (n))
+ {
+ /* avoid dangling else. */
+ pass (3, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp3_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isDef}, (mcComp_openFunction) {(mcComp_openFunction_t) openDef});
+ if ((decl_hasHidden (n)) && (mcOptions_getExtendedOpaque ()))
+ {
+ pass (3, decl_lookupImp (decl_getSymName (n)), (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp3_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImp}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod});
+ }
+ }
+ else
+ {
+ pass (3, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp3_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImpOrModule}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod});
+ }
+}
+
+
+/*
+ p4 - wrap the pass procedure with the correct parameter values.
+*/
+
+static void p4 (decl_node n)
+{
+ if (decl_isDef (n))
+ {
+ /* avoid dangling else. */
+ pass (4, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp4_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isDef}, (mcComp_openFunction) {(mcComp_openFunction_t) openDef});
+ if ((decl_hasHidden (n)) && (mcOptions_getExtendedOpaque ()))
+ {
+ pass (4, decl_lookupImp (decl_getSymName (n)), (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp4_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImp}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod});
+ }
+ }
+ else
+ {
+ pass (4, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp4_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImpOrModule}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod});
+ }
+}
+
+
+/*
+ p5 - wrap the pass procedure with the correct parameter values.
+*/
+
+static void p5 (decl_node n)
+{
+ pass (5, n, (mcComp_parserFunction) {(mcComp_parserFunction_t) mcp5_CompilationUnit}, (decl_isNodeF) {(decl_isNodeF_t) decl_isImpOrModule}, (mcComp_openFunction) {(mcComp_openFunction_t) openMod});
+}
+
+
+/*
+ doOpen -
+*/
+
+static unsigned int doOpen (decl_node n, DynamicStrings_String symName, DynamicStrings_String fileName, unsigned int exitOnFailure)
+{
+ DynamicStrings_String postProcessed;
+
+ mcQuiet_qprintf2 ((const char *) " Module %-20s : %s\\n", 22, (const unsigned char *) &symName, (sizeof (symName)-1), (const unsigned char *) &fileName, (sizeof (fileName)-1));
+ postProcessed = mcPreprocess_preprocessModule (fileName);
+ decl_setSource (n, nameKey_makekey (DynamicStrings_string (postProcessed)));
+ decl_setCurrentModule (n);
+ if (mcLexBuf_openSource (postProcessed))
+ {
+ return TRUE;
+ }
+ mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to open %s\\n", 19, (const unsigned char *) &fileName, (sizeof (fileName)-1));
+ if (exitOnFailure)
+ {
+ libc_exit (1);
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openDef - try and open the definition module source file.
+ Returns true/false if successful/unsuccessful or
+ exitOnFailure.
+*/
+
+static unsigned int openDef (decl_node n, unsigned int exitOnFailure)
+{
+ nameKey_Name sourceName;
+ DynamicStrings_String symName;
+ DynamicStrings_String fileName;
+
+ sourceName = decl_getSource (n);
+ symName = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ if (sourceName == nameKey_NulName)
+ {
+ /* avoid dangling else. */
+ if (! (mcSearch_findSourceDefFile (symName, &fileName)))
+ {
+ mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to find definition module %s.def\\n", 41, (const unsigned char *) &symName, (sizeof (symName)-1));
+ if (exitOnFailure)
+ {
+ libc_exit (1);
+ }
+ }
+ }
+ else
+ {
+ fileName = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (sourceName));
+ }
+ return doOpen (n, symName, fileName, exitOnFailure);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openMod - try and open the implementation/program module source file.
+ Returns true/false if successful/unsuccessful or
+ exitOnFailure.
+*/
+
+static unsigned int openMod (decl_node n, unsigned int exitOnFailure)
+{
+ nameKey_Name sourceName;
+ DynamicStrings_String symName;
+ DynamicStrings_String fileName;
+
+ sourceName = decl_getSource (n);
+ symName = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)));
+ if (sourceName == nameKey_NulName)
+ {
+ /* avoid dangling else. */
+ if (! (mcSearch_findSourceModFile (symName, &fileName)))
+ {
+ if (decl_isImp (n))
+ {
+ mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to find implementation module %s.mod\\n", 45, (const unsigned char *) &symName, (sizeof (symName)-1));
+ }
+ else
+ {
+ mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to find program module %s.mod\\n", 38, (const unsigned char *) &symName, (sizeof (symName)-1));
+ }
+ if (exitOnFailure)
+ {
+ libc_exit (1);
+ }
+ }
+ }
+ else
+ {
+ fileName = DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (sourceName));
+ }
+ return doOpen (n, symName, fileName, exitOnFailure);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ pass -
+*/
+
+static void pass (unsigned int no, decl_node n, mcComp_parserFunction f, decl_isNodeF isnode, mcComp_openFunction open)
+{
+ if (((*isnode.proc) (n)) && (! (decl_isVisited (n))))
+ {
+ decl_setVisited (n);
+ if ((*open.proc) (n, TRUE))
+ {
+ if (! ((*f.proc) ()))
+ {
+ mcError_writeFormat0 ((const char *) "compilation failed", 18);
+ mcLexBuf_closeSource ();
+ return ;
+ }
+ mcLexBuf_closeSource ();
+ }
+ }
+}
+
+
+/*
+ doPass -
+*/
+
+static void doPass (unsigned int parseDefs, unsigned int parseMain, unsigned int no, symbolKey_performOperation p, const char *desc_, unsigned int _desc_high)
+{
+ DynamicStrings_String descs;
+ char desc[_desc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (desc, desc_, _desc_high+1);
+
+ setToPassNo (no);
+ descs = DynamicStrings_InitString ((const char *) desc, _desc_high);
+ mcQuiet_qprintf2 ((const char *) "Pass %d: %s\\n", 13, (const unsigned char *) &no, (sizeof (no)-1), (const unsigned char *) &descs, (sizeof (descs)-1));
+ decl_foreachDefModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) decl_unsetVisited});
+ decl_foreachModModuleDo ((symbolKey_performOperation) {(symbolKey_performOperation_t) decl_unsetVisited});
+ if (parseMain)
+ {
+ decl_unsetVisited (decl_getMainModule ());
+ if (parseDefs && (decl_isImp (decl_getMainModule ())))
+ {
+ /* we need to parse the definition module of a corresponding implementation module. */
+ (*p.proc) (reinterpret_cast<void *> (decl_lookupDef (decl_getSymName (decl_getMainModule ()))));
+ }
+ (*p.proc) (reinterpret_cast<void *> (decl_getMainModule ()));
+ }
+ if (parseDefs)
+ {
+ decl_foreachDefModuleDo (p);
+ }
+ mcError_flushWarnings ();
+ mcError_flushErrors ();
+ setToPassNo (0);
+}
+
+
+/*
+ setToPassNo -
+*/
+
+static void setToPassNo (unsigned int n)
+{
+ currentPass = n;
+}
+
+
+/*
+ init - initialise data structures for this module.
+*/
+
+static void init (void)
+{
+ setToPassNo (0);
+}
+
+
+/*
+ compile - check, s, is non NIL before calling doCompile.
+*/
+
+extern "C" void mcComp_compile (DynamicStrings_String s)
+{
+ if (s != NULL)
+ {
+ doCompile (s);
+ }
+}
+
+
+/*
+ getPassNo - return the pass no.
+*/
+
+extern "C" unsigned int mcComp_getPassNo (void)
+{
+ return currentPass;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcComp_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ init ();
+}
+
+extern "C" void _M2_mcComp_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcDebug. */
+/* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _mcDebug_H
+#define _mcDebug_C
+
+# include "GStrIO.h"
+# include "GmcOptions.h"
+# include "GmcError.h"
+
+
+/*
+ assert - tests the boolean, q. If false then an error is reported
+ and the execution is terminated.
+*/
+
+extern "C" void mcDebug_assert (unsigned int q);
+
+/*
+ writeDebug - only writes a string if internal debugging is on.
+*/
+
+extern "C" void mcDebug_writeDebug (const char *a_, unsigned int _a_high);
+
+
+/*
+ assert - tests the boolean, q. If false then an error is reported
+ and the execution is terminated.
+*/
+
+extern "C" void mcDebug_assert (unsigned int q)
+{
+ if (! q)
+ {
+ mcError_internalError ((const char *) "assert failed", 13, (const char *) "../../gcc-read-write/gcc/m2/mc/mcDebug.mod", 42, 35);
+ }
+}
+
+
+/*
+ writeDebug - only writes a string if internal debugging is on.
+*/
+
+extern "C" void mcDebug_writeDebug (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ if (mcOptions_getInternalDebugging ())
+ {
+ StrIO_WriteString ((const char *) a, _a_high);
+ StrIO_WriteLn ();
+ }
+}
+
+extern "C" void _M2_mcDebug_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcDebug_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcError. */
+/* mcError.mod provides an interface between the string handling modules.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcError_H
+#define _mcError_C
+
+# include "GASCII.h"
+# include "GDynamicStrings.h"
+# include "GFIO.h"
+# include "GStrLib.h"
+# include "GFormatStrings.h"
+# include "GStorage.h"
+# include "GM2RTS.h"
+# include "GSYSTEM.h"
+# include "GStdIO.h"
+# include "GnameKey.h"
+# include "GmcLexBuf.h"
+# include "GmcPrintf.h"
+
+# define Debugging TRUE
+# define DebugTrace FALSE
+# define Xcode TRUE
+typedef struct mcError__T2_r mcError__T2;
+
+typedef mcError__T2 *mcError_error;
+
+struct mcError__T2_r {
+ mcError_error parent;
+ mcError_error child;
+ mcError_error next;
+ unsigned int fatal;
+ DynamicStrings_String s;
+ unsigned int token;
+ };
+
+static mcError_error head;
+static unsigned int inInternal;
+
+/*
+ internalError - displays an internal error message together with the compiler source
+ file and line number.
+ This function is not buffered and is used when the compiler is about
+ to give up.
+*/
+
+extern "C" void mcError_internalError (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ writeFormat0 - displays the source module and line together
+ with the encapsulated format string.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat0 (const char *a_, unsigned int _a_high);
+
+/*
+ writeFormat1 - displays the source module and line together
+ with the encapsulated format string.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ writeFormat2 - displays the module and line together with the encapsulated
+ format strings.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+
+/*
+ writeFormat3 - displays the module and line together with the encapsulated
+ format strings.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+
+/*
+ newError - creates and returns a new error handle.
+*/
+
+extern "C" mcError_error mcError_newError (unsigned int atTokenNo);
+
+/*
+ newWarning - creates and returns a new error handle suitable for a warning.
+ A warning will not stop compilation.
+*/
+
+extern "C" mcError_error mcError_newWarning (unsigned int atTokenNo);
+
+/*
+ chainError - creates and returns a new error handle, this new error
+ is associated with, e, and is chained onto the end of, e.
+ If, e, is NIL then the result to NewError is returned.
+*/
+
+extern "C" mcError_error mcError_chainError (unsigned int atTokenNo, mcError_error e);
+extern "C" void mcError_errorFormat0 (mcError_error e, const char *a_, unsigned int _a_high);
+extern "C" void mcError_errorFormat1 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+extern "C" void mcError_errorFormat2 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+extern "C" void mcError_errorFormat3 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+extern "C" void mcError_errorString (mcError_error e, DynamicStrings_String str);
+
+/*
+ errorStringAt - given an error string, s, it places this
+ string at token position, tok.
+ The string is consumed.
+*/
+
+extern "C" void mcError_errorStringAt (DynamicStrings_String s, unsigned int tok);
+
+/*
+ errorStringAt2 - given an error string, s, it places this
+ string at token positions, tok1 and tok2, respectively.
+ The string is consumed.
+*/
+
+extern "C" void mcError_errorStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2);
+
+/*
+ errorStringsAt2 - given error strings, s1, and, s2, it places these
+ strings at token positions, tok1 and tok2, respectively.
+ Both strings are consumed.
+*/
+
+extern "C" void mcError_errorStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2);
+
+/*
+ warnStringAt - given an error string, s, it places this
+ string at token position, tok.
+ The string is consumed.
+*/
+
+extern "C" void mcError_warnStringAt (DynamicStrings_String s, unsigned int tok);
+
+/*
+ warnStringAt2 - given an warning string, s, it places this
+ string at token positions, tok1 and tok2, respectively.
+ The string is consumed.
+*/
+
+extern "C" void mcError_warnStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2);
+
+/*
+ warnStringsAt2 - given warning strings, s1, and, s2, it places these
+ strings at token positions, tok1 and tok2, respectively.
+ Both strings are consumed.
+*/
+
+extern "C" void mcError_warnStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2);
+extern "C" void mcError_warnFormat0 (const char *a_, unsigned int _a_high);
+
+/*
+ warnFormat1 - displays the source module and line together
+ with the encapsulated format string.
+ Used for simple warning messages tied to the current token.
+*/
+
+extern "C" void mcError_warnFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ flushErrors - switches the output channel to the error channel
+ and then writes out all errors.
+*/
+
+extern "C" void mcError_flushErrors (void);
+
+/*
+ flushWarnings - switches the output channel to the error channel
+ and then writes out all warnings.
+ If an error is present the compilation is terminated,
+ if warnings only were emitted then compilation will
+ continue.
+*/
+
+extern "C" void mcError_flushWarnings (void);
+
+/*
+ errorAbort0 - aborts compiling, it flushes all warnings and errors before aborting.
+*/
+
+extern "C" void mcError_errorAbort0 (const char *a_, unsigned int _a_high);
+
+/*
+ cast - casts a := b
+*/
+
+static void cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high);
+static unsigned int translateNameToCharStar (char *a, unsigned int _a_high, unsigned int n);
+
+/*
+ outString - writes the contents of String to stdout.
+ The string, s, is destroyed.
+*/
+
+static void outString (DynamicStrings_String file, unsigned int line, unsigned int col, DynamicStrings_String s);
+static DynamicStrings_String doFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ doFormat2 -
+*/
+
+static DynamicStrings_String doFormat2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+
+/*
+ writeFormat2 - displays the module and line together with the encapsulated
+ format strings.
+ Used for simple error messages tied to the current token.
+*/
+
+static DynamicStrings_String doFormat3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+
+/*
+ init - initializes the error list.
+*/
+
+static void init (void);
+
+/*
+ checkIncludes - generates a sequence of error messages which determine the relevant
+ included file and line number.
+ For example:
+
+ gcc a.c
+ In file included from b.h:1,
+ from a.c:1:
+ c.h:1: parse error before `and'
+
+ where a.c is: #include "b.h"
+ b.h is: #include "c.h"
+ c.h is: and this and that
+
+ we attempt to follow the error messages that gcc issues.
+*/
+
+static void checkIncludes (unsigned int token, unsigned int depth);
+
+/*
+ flushAll - flushes all errors in list, e.
+*/
+
+static unsigned int flushAll (mcError_error e, unsigned int FatalStatus);
+
+
+/*
+ cast - casts a := b
+*/
+
+static void cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (b, b_, _b_high+1);
+
+ if (_a_high == _b_high)
+ {
+ for (i=0; i<=_a_high; i++)
+ {
+ a[i] = b[i];
+ }
+ }
+}
+
+static unsigned int translateNameToCharStar (char *a, unsigned int _a_high, unsigned int n)
+{
+ unsigned int argno;
+ unsigned int i;
+ unsigned int h;
+
+ /*
+ translateNameToString - takes a format specification string, a, and
+ if they consist of of %a then this is translated
+ into a String and %a is replaced by %s.
+ */
+ argno = 1;
+ i = 0;
+ h = StrLib_StrLen ((const char *) a, _a_high);
+ while (i < h)
+ {
+ if ((a[i] == '%') && ((i+1) < h))
+ {
+ if ((a[i+1] == 'a') && (argno == n))
+ {
+ a[i+1] = 's';
+ return TRUE;
+ }
+ argno += 1;
+ if (argno > n)
+ {
+ /* all done */
+ return FALSE;
+ }
+ }
+ i += 1;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ outString - writes the contents of String to stdout.
+ The string, s, is destroyed.
+*/
+
+static void outString (DynamicStrings_String file, unsigned int line, unsigned int col, DynamicStrings_String s)
+{
+ typedef char *outString__T1;
+
+ DynamicStrings_String leader;
+ outString__T1 p;
+ outString__T1 q;
+ unsigned int space;
+ unsigned int newline;
+
+ col += 1;
+ if (Xcode)
+ {
+ leader = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "%s:%d:", 6)), (const unsigned char *) &file, (sizeof (file)-1), (const unsigned char *) &line, (sizeof (line)-1));
+ }
+ else
+ {
+ leader = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "%s:%d:%d:", 9)), (const unsigned char *) &file, (sizeof (file)-1), (const unsigned char *) &line, (sizeof (line)-1), (const unsigned char *) &col, (sizeof (col)-1));
+ }
+ p = static_cast<outString__T1> (DynamicStrings_string (s));
+ newline = TRUE;
+ space = FALSE;
+ while ((p != NULL) && ((*p) != ASCII_nul))
+ {
+ if (newline)
+ {
+ q = static_cast<outString__T1> (DynamicStrings_string (leader));
+ while ((q != NULL) && ((*q) != ASCII_nul))
+ {
+ StdIO_Write ((*q));
+ q += 1;
+ }
+ }
+ newline = (*p) == ASCII_nl;
+ space = (*p) == ' ';
+ if (newline && Xcode)
+ {
+ mcPrintf_printf1 ((const char *) "(pos: %d)", 9, (const unsigned char *) &col, (sizeof (col)-1));
+ }
+ StdIO_Write ((*p));
+ p += 1;
+ }
+ if (! newline)
+ {
+ if (Xcode)
+ {
+ if (! space)
+ {
+ StdIO_Write (' ');
+ }
+ mcPrintf_printf1 ((const char *) "(pos: %d)", 9, (const unsigned char *) &col, (sizeof (col)-1));
+ }
+ StdIO_Write (ASCII_nl);
+ }
+ FIO_FlushBuffer (FIO_StdOut);
+ if (! Debugging)
+ {
+ s = DynamicStrings_KillString (s);
+ leader = DynamicStrings_KillString (leader);
+ }
+}
+
+static DynamicStrings_String doFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high)
+{
+ DynamicStrings_String s;
+ nameKey_Name n;
+ char a[_a_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ /*
+ DoFormat1 -
+ */
+ if (translateNameToCharStar ((char *) a, _a_high, 1))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w, _w_high);
+ s = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ s = FormatStrings_Sprintf1 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s, (sizeof (s)-1));
+ }
+ else
+ {
+ s = FormatStrings_Sprintf1 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w, _w_high);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doFormat2 -
+*/
+
+static DynamicStrings_String doFormat2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high)
+{
+ nameKey_Name n;
+ DynamicStrings_String s;
+ DynamicStrings_String s1;
+ DynamicStrings_String s2;
+ unsigned int b;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+
+ b = (unsigned int) 0;
+ if (translateNameToCharStar ((char *) a, _a_high, 1))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w1, _w1_high);
+ s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (1 ));
+ }
+ if (translateNameToCharStar ((char *) a, _a_high, 2))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w2, _w2_high);
+ s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (2 ));
+ }
+ switch (b)
+ {
+ case (unsigned int) 0:
+ s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high);
+ break;
+
+ case (unsigned int) ((1 << (1))):
+ s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high);
+ break;
+
+ case (unsigned int) ((1 << (2))):
+ s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1));
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (2))):
+ s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1));
+ break;
+
+
+ default:
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ break;
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ writeFormat2 - displays the module and line together with the encapsulated
+ format strings.
+ Used for simple error messages tied to the current token.
+*/
+
+static DynamicStrings_String doFormat3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high)
+{
+ nameKey_Name n;
+ DynamicStrings_String s;
+ DynamicStrings_String s1;
+ DynamicStrings_String s2;
+ DynamicStrings_String s3;
+ unsigned int b;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+
+ b = (unsigned int) 0;
+ if (translateNameToCharStar ((char *) a, _a_high, 1))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w1, _w1_high);
+ s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (1 ));
+ }
+ if (translateNameToCharStar ((char *) a, _a_high, 2))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w2, _w2_high);
+ s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (2 ));
+ }
+ if (translateNameToCharStar ((char *) a, _a_high, 3))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w3, _w3_high);
+ s3 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (3 ));
+ }
+ switch (b)
+ {
+ case (unsigned int) 0:
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high);
+ break;
+
+ case (unsigned int) ((1 << (1))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high);
+ break;
+
+ case (unsigned int) ((1 << (2))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high);
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (2))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high);
+ break;
+
+ case (unsigned int) ((1 << (3))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1));
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (3))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1));
+ break;
+
+ case (unsigned int) ((1 << (2)) | (1 << (3))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1));
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (2)) | (1 << (3))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1));
+ break;
+
+
+ default:
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ break;
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ init - initializes the error list.
+*/
+
+static void init (void)
+{
+ head = NULL;
+ inInternal = FALSE;
+}
+
+
+/*
+ checkIncludes - generates a sequence of error messages which determine the relevant
+ included file and line number.
+ For example:
+
+ gcc a.c
+ In file included from b.h:1,
+ from a.c:1:
+ c.h:1: parse error before `and'
+
+ where a.c is: #include "b.h"
+ b.h is: #include "c.h"
+ c.h is: and this and that
+
+ we attempt to follow the error messages that gcc issues.
+*/
+
+static void checkIncludes (unsigned int token, unsigned int depth)
+{
+ DynamicStrings_String included;
+ unsigned int lineno;
+
+ included = mcLexBuf_findFileNameFromToken (token, depth+1);
+ if (included != NULL)
+ {
+ lineno = mcLexBuf_tokenToLineNo (token, depth+1);
+ if (depth == 0)
+ {
+ mcPrintf_printf2 ((const char *) "In file included from %s:%d", 27, (const unsigned char *) &included, (sizeof (included)-1), (const unsigned char *) &lineno, (sizeof (lineno)-1));
+ }
+ else
+ {
+ mcPrintf_printf2 ((const char *) " from %s:%d", 27, (const unsigned char *) &included, (sizeof (included)-1), (const unsigned char *) &lineno, (sizeof (lineno)-1));
+ }
+ if ((mcLexBuf_findFileNameFromToken (token, depth+2)) == NULL)
+ {
+ mcPrintf_printf0 ((const char *) ":\\n", 3);
+ }
+ else
+ {
+ mcPrintf_printf0 ((const char *) ",\\n", 3);
+ }
+ checkIncludes (token, depth+1);
+ }
+}
+
+
+/*
+ flushAll - flushes all errors in list, e.
+*/
+
+static unsigned int flushAll (mcError_error e, unsigned int FatalStatus)
+{
+ mcError_error f;
+ unsigned int written;
+
+ written = FALSE;
+ if (e != NULL)
+ {
+ do {
+ if ((FatalStatus == e->fatal) && (e->s != NULL))
+ {
+ checkIncludes (e->token, 0);
+ if (e->fatal)
+ {
+ e->s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " error: ", 8), DynamicStrings_Mark (e->s));
+ }
+ else
+ {
+ e->s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " warning: ", 10), DynamicStrings_Mark (e->s));
+ }
+ outString (mcLexBuf_findFileNameFromToken (e->token, 0), mcLexBuf_tokenToLineNo (e->token, 0), mcLexBuf_tokenToColumnNo (e->token, 0), e->s);
+ if ((e->child != NULL) && (flushAll (e->child, FatalStatus)))
+ {} /* empty. */
+ e->s = static_cast<DynamicStrings_String> (NULL);
+ written = TRUE;
+ }
+ f = e;
+ e = e->next;
+ if (! Debugging)
+ {
+ f->s = DynamicStrings_KillString (f->s);
+ Storage_DEALLOCATE ((void **) &f, sizeof (mcError__T2));
+ }
+ } while (! (e == NULL));
+ }
+ return written;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ internalError - displays an internal error message together with the compiler source
+ file and line number.
+ This function is not buffered and is used when the compiler is about
+ to give up.
+*/
+
+extern "C" void mcError_internalError (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char a[_a_high+1];
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (file, file_, _file_high+1);
+
+ M2RTS_ExitOnHalt (1);
+ if (! inInternal)
+ {
+ inInternal = TRUE;
+ mcError_flushErrors ();
+ outString (mcLexBuf_findFileNameFromToken (mcLexBuf_getTokenNo (), 0), mcLexBuf_tokenToLineNo (mcLexBuf_getTokenNo (), 0), mcLexBuf_tokenToColumnNo (mcLexBuf_getTokenNo (), 0), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*** fatal error ***", 19)));
+ }
+ outString (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) file, _file_high)), line, 0, DynamicStrings_ConCat (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*** internal error *** ", 23)), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high))));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ writeFormat0 - displays the source module and line together
+ with the encapsulated format string.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat0 (const char *a_, unsigned int _a_high)
+{
+ mcError_error e;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ e = mcError_newError (mcLexBuf_getTokenNo ());
+ e->s = FormatStrings_Sprintf0 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)));
+}
+
+
+/*
+ writeFormat1 - displays the source module and line together
+ with the encapsulated format string.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high)
+{
+ mcError_error e;
+ char a[_a_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ e = mcError_newError (mcLexBuf_getTokenNo ());
+ e->s = doFormat1 ((const char *) a, _a_high, (const unsigned char *) w, _w_high);
+}
+
+
+/*
+ writeFormat2 - displays the module and line together with the encapsulated
+ format strings.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high)
+{
+ mcError_error e;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+
+ e = mcError_newError (mcLexBuf_getTokenNo ());
+ e->s = doFormat2 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high);
+}
+
+
+/*
+ writeFormat3 - displays the module and line together with the encapsulated
+ format strings.
+ Used for simple error messages tied to the current token.
+*/
+
+extern "C" void mcError_writeFormat3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high)
+{
+ mcError_error e;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+
+ e = mcError_newError (mcLexBuf_getTokenNo ());
+ e->s = doFormat3 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high);
+}
+
+
+/*
+ newError - creates and returns a new error handle.
+*/
+
+extern "C" mcError_error mcError_newError (unsigned int atTokenNo)
+{
+ mcError_error e;
+ mcError_error f;
+
+ Storage_ALLOCATE ((void **) &e, sizeof (mcError__T2));
+ e->s = static_cast<DynamicStrings_String> (NULL);
+ e->token = atTokenNo;
+ e->next = NULL;
+ e->parent = NULL;
+ e->child = NULL;
+ e->fatal = TRUE;
+ if ((head == NULL) || (head->token > atTokenNo))
+ {
+ e->next = head;
+ head = e;
+ }
+ else
+ {
+ f = head;
+ while ((f->next != NULL) && (f->next->token < atTokenNo))
+ {
+ f = f->next;
+ }
+ e->next = f->next;
+ f->next = e;
+ }
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ newWarning - creates and returns a new error handle suitable for a warning.
+ A warning will not stop compilation.
+*/
+
+extern "C" mcError_error mcError_newWarning (unsigned int atTokenNo)
+{
+ mcError_error e;
+
+ e = mcError_newError (atTokenNo);
+ e->fatal = FALSE;
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ chainError - creates and returns a new error handle, this new error
+ is associated with, e, and is chained onto the end of, e.
+ If, e, is NIL then the result to NewError is returned.
+*/
+
+extern "C" mcError_error mcError_chainError (unsigned int atTokenNo, mcError_error e)
+{
+ mcError_error f;
+
+ if (e == NULL)
+ {
+ return mcError_newError (atTokenNo);
+ }
+ else
+ {
+ Storage_ALLOCATE ((void **) &f, sizeof (mcError__T2));
+ f->s = static_cast<DynamicStrings_String> (NULL);
+ f->token = atTokenNo;
+ f->next = e->child;
+ f->parent = e;
+ f->child = NULL;
+ f->fatal = e->fatal;
+ e->child = f;
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void mcError_errorFormat0 (mcError_error e, const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ /*
+ errorFormat routines provide a printf capability for the error handle.
+ */
+ if (e->s == NULL)
+ {
+ e->s = FormatStrings_Sprintf0 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)));
+ }
+ else
+ {
+ e->s = DynamicStrings_ConCat (e->s, DynamicStrings_Mark (FormatStrings_Sprintf0 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)))));
+ }
+}
+
+extern "C" void mcError_errorFormat1 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high)
+{
+ DynamicStrings_String s1;
+ char a[_a_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ s1 = doFormat1 ((const char *) a, _a_high, (const unsigned char *) w, _w_high);
+ if (e->s == NULL)
+ {
+ e->s = s1;
+ }
+ else
+ {
+ e->s = DynamicStrings_ConCat (e->s, DynamicStrings_Mark (s1));
+ }
+}
+
+extern "C" void mcError_errorFormat2 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high)
+{
+ DynamicStrings_String s1;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+
+ s1 = doFormat2 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high);
+ if (e->s == NULL)
+ {
+ e->s = s1;
+ }
+ else
+ {
+ e->s = DynamicStrings_ConCat (e->s, DynamicStrings_Mark (s1));
+ }
+}
+
+extern "C" void mcError_errorFormat3 (mcError_error e, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high)
+{
+ DynamicStrings_String s1;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+
+ s1 = doFormat3 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high);
+ if (e->s == NULL)
+ {
+ e->s = s1;
+ }
+ else
+ {
+ e->s = DynamicStrings_ConCat (e->s, DynamicStrings_Mark (s1));
+ }
+}
+
+extern "C" void mcError_errorString (mcError_error e, DynamicStrings_String str)
+{
+ e->s = str;
+}
+
+
+/*
+ errorStringAt - given an error string, s, it places this
+ string at token position, tok.
+ The string is consumed.
+*/
+
+extern "C" void mcError_errorStringAt (DynamicStrings_String s, unsigned int tok)
+{
+ mcError_error e;
+
+ e = mcError_newError (tok);
+ mcError_errorString (e, s);
+}
+
+
+/*
+ errorStringAt2 - given an error string, s, it places this
+ string at token positions, tok1 and tok2, respectively.
+ The string is consumed.
+*/
+
+extern "C" void mcError_errorStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2)
+{
+ mcError_errorStringsAt2 (s, s, tok1, tok2);
+}
+
+
+/*
+ errorStringsAt2 - given error strings, s1, and, s2, it places these
+ strings at token positions, tok1 and tok2, respectively.
+ Both strings are consumed.
+*/
+
+extern "C" void mcError_errorStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2)
+{
+ mcError_error e;
+
+ if (s1 == s2)
+ {
+ s2 = DynamicStrings_Dup (s1);
+ }
+ e = mcError_newError (tok1);
+ mcError_errorString (e, s1);
+ mcError_errorString (mcError_chainError (tok2, e), s2);
+}
+
+
+/*
+ warnStringAt - given an error string, s, it places this
+ string at token position, tok.
+ The string is consumed.
+*/
+
+extern "C" void mcError_warnStringAt (DynamicStrings_String s, unsigned int tok)
+{
+ mcError_error e;
+
+ e = mcError_newWarning (tok);
+ mcError_errorString (e, s);
+}
+
+
+/*
+ warnStringAt2 - given an warning string, s, it places this
+ string at token positions, tok1 and tok2, respectively.
+ The string is consumed.
+*/
+
+extern "C" void mcError_warnStringAt2 (DynamicStrings_String s, unsigned int tok1, unsigned int tok2)
+{
+ mcError_warnStringsAt2 (s, s, tok1, tok2);
+}
+
+
+/*
+ warnStringsAt2 - given warning strings, s1, and, s2, it places these
+ strings at token positions, tok1 and tok2, respectively.
+ Both strings are consumed.
+*/
+
+extern "C" void mcError_warnStringsAt2 (DynamicStrings_String s1, DynamicStrings_String s2, unsigned int tok1, unsigned int tok2)
+{
+ mcError_error e;
+
+ if (s1 == s2)
+ {
+ s2 = DynamicStrings_Dup (s1);
+ }
+ e = mcError_newWarning (tok1);
+ mcError_errorString (e, s1);
+ mcError_errorString (mcError_chainError (tok2, e), s2);
+}
+
+extern "C" void mcError_warnFormat0 (const char *a_, unsigned int _a_high)
+{
+ mcError_error e;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ /*
+ WarnFormat0 - displays the source module and line together
+ with the encapsulated format string.
+ Used for simple warning messages tied to the current token.
+ */
+ e = mcError_newWarning (mcLexBuf_getTokenNo ());
+ e->s = FormatStrings_Sprintf0 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)));
+}
+
+
+/*
+ warnFormat1 - displays the source module and line together
+ with the encapsulated format string.
+ Used for simple warning messages tied to the current token.
+*/
+
+extern "C" void mcError_warnFormat1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high)
+{
+ mcError_error e;
+ char a[_a_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ e = mcError_newWarning (mcLexBuf_getTokenNo ());
+ e->s = doFormat1 ((const char *) a, _a_high, (const unsigned char *) w, _w_high);
+}
+
+
+/*
+ flushErrors - switches the output channel to the error channel
+ and then writes out all errors.
+*/
+
+extern "C" void mcError_flushErrors (void)
+{
+ if (DebugTrace)
+ {
+ mcPrintf_printf0 ((const char *) "\\nFlushing all errors\\n", 23);
+ mcPrintf_printf0 ((const char *) "===================\\n", 21);
+ }
+ if (flushAll (head, TRUE))
+ {
+ M2RTS_ExitOnHalt (1);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ flushWarnings - switches the output channel to the error channel
+ and then writes out all warnings.
+ If an error is present the compilation is terminated,
+ if warnings only were emitted then compilation will
+ continue.
+*/
+
+extern "C" void mcError_flushWarnings (void)
+{
+ if (flushAll (head, FALSE))
+ {} /* empty. */
+}
+
+
+/*
+ errorAbort0 - aborts compiling, it flushes all warnings and errors before aborting.
+*/
+
+extern "C" void mcError_errorAbort0 (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ mcError_flushWarnings ();
+ if (! (StrLib_StrEqual ((const char *) a, _a_high, (const char *) "", 0)))
+ {
+ mcError_writeFormat0 ((const char *) a, _a_high);
+ }
+ if (! (flushAll (head, TRUE)))
+ {
+ mcError_writeFormat0 ((const char *) "unidentified error", 18);
+ if (flushAll (head, TRUE))
+ {} /* empty. */
+ }
+ M2RTS_ExitOnHalt (1);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcError_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ init ();
+}
+
+extern "C" void _M2_mcError_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcFileName. */
+/* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _mcFileName_H
+#define _mcFileName_C
+
+# include "GASCII.h"
+# include "GDynamicStrings.h"
+
+# define MaxFileName 0
+# define MaxStemName 0
+# define Directory '/'
+
+/*
+ calculateFileName - calculates and returns a new string filename given a module
+ and an extension. String, Extension, is concatenated onto
+ Module and thus it is safe to `Mark' the extension for garbage
+ collection.
+*/
+
+extern "C" DynamicStrings_String mcFileName_calculateFileName (DynamicStrings_String module, DynamicStrings_String extension);
+
+/*
+ calculateStemName - calculates the stem name for given a module.
+ This name length will be operating system and
+ compiler specific.
+*/
+
+extern "C" DynamicStrings_String mcFileName_calculateStemName (DynamicStrings_String module);
+
+/*
+ extractExtension - given a, filename, return the filename without
+ the extension, Ext.
+*/
+
+extern "C" DynamicStrings_String mcFileName_extractExtension (DynamicStrings_String filename, DynamicStrings_String ext);
+
+/*
+ extractModule - given a, filename, return the module name including any
+ extension. A new string is returned.
+*/
+
+extern "C" DynamicStrings_String mcFileName_extractModule (DynamicStrings_String filename);
+
+
+/*
+ calculateFileName - calculates and returns a new string filename given a module
+ and an extension. String, Extension, is concatenated onto
+ Module and thus it is safe to `Mark' the extension for garbage
+ collection.
+*/
+
+extern "C" DynamicStrings_String mcFileName_calculateFileName (DynamicStrings_String module, DynamicStrings_String extension)
+{
+ if (MaxFileName == 0)
+ {
+ return DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (module, 0, MaxFileName), '.'), extension);
+ }
+ else
+ {
+ return DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (module, 0, (MaxFileName-(DynamicStrings_Length (extension)))-1), '.'), extension);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ calculateStemName - calculates the stem name for given a module.
+ This name length will be operating system and
+ compiler specific.
+*/
+
+extern "C" DynamicStrings_String mcFileName_calculateStemName (DynamicStrings_String module)
+{
+ return DynamicStrings_Slice (module, 0, MaxStemName);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ extractExtension - given a, filename, return the filename without
+ the extension, Ext.
+*/
+
+extern "C" DynamicStrings_String mcFileName_extractExtension (DynamicStrings_String filename, DynamicStrings_String ext)
+{
+ if (DynamicStrings_Equal (ext, DynamicStrings_Mark (DynamicStrings_Slice (filename, static_cast<int> (-(DynamicStrings_Length (ext))), 0))))
+ {
+ return DynamicStrings_Slice (filename, 0, static_cast<int> (-(DynamicStrings_Length (ext))));
+ }
+ else
+ {
+ return filename;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ extractModule - given a, filename, return the module name including any
+ extension. A new string is returned.
+*/
+
+extern "C" DynamicStrings_String mcFileName_extractModule (DynamicStrings_String filename)
+{
+ int i;
+
+ i = DynamicStrings_Index (filename, Directory, 0);
+ if (i == -1)
+ {
+ return DynamicStrings_Dup (filename);
+ }
+ else
+ {
+ return DynamicStrings_Slice (filename, i+1, 0);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcFileName_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcFileName_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcLexBuf. */
+/* mcLexBuf.mod provides a buffer for the all the tokens created by m2.lex.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcLexBuf_H
+#define _mcLexBuf_C
+
+# include "Gmcflex.h"
+# include "Glibc.h"
+# include "GSYSTEM.h"
+# include "GStorage.h"
+# include "GDynamicStrings.h"
+# include "GFormatStrings.h"
+# include "GnameKey.h"
+# include "GmcReserved.h"
+# include "GmcComment.h"
+# include "GmcPrintf.h"
+# include "GmcDebug.h"
+# include "GM2RTS.h"
+
+mcComment_commentDesc mcLexBuf_currentcomment;
+mcComment_commentDesc mcLexBuf_lastcomment;
+int mcLexBuf_currentinteger;
+unsigned int mcLexBuf_currentcolumn;
+void * mcLexBuf_currentstring;
+mcReserved_toktype mcLexBuf_currenttoken;
+# define MaxBucketSize 100
+# define Debugging FALSE
+typedef struct mcLexBuf_tokenDesc_r mcLexBuf_tokenDesc;
+
+typedef struct mcLexBuf_listDesc_r mcLexBuf_listDesc;
+
+typedef struct mcLexBuf__T1_r mcLexBuf__T1;
+
+typedef mcLexBuf__T1 *mcLexBuf_sourceList;
+
+typedef struct mcLexBuf__T2_r mcLexBuf__T2;
+
+typedef mcLexBuf__T2 *mcLexBuf_tokenBucket;
+
+typedef struct mcLexBuf__T3_a mcLexBuf__T3;
+
+struct mcLexBuf_tokenDesc_r {
+ mcReserved_toktype token;
+ nameKey_Name str;
+ int int_;
+ mcComment_commentDesc com;
+ unsigned int line;
+ unsigned int col;
+ mcLexBuf_sourceList file;
+ };
+
+struct mcLexBuf_listDesc_r {
+ mcLexBuf_tokenBucket head;
+ mcLexBuf_tokenBucket tail;
+ unsigned int lastBucketOffset;
+ };
+
+struct mcLexBuf__T1_r {
+ mcLexBuf_sourceList left;
+ mcLexBuf_sourceList right;
+ DynamicStrings_String name;
+ unsigned int line;
+ unsigned int col;
+ };
+
+struct mcLexBuf__T3_a { mcLexBuf_tokenDesc array[MaxBucketSize+1]; };
+struct mcLexBuf__T2_r {
+ mcLexBuf__T3 buf;
+ unsigned int len;
+ mcLexBuf_tokenBucket next;
+ };
+
+static mcComment_commentDesc procedureComment;
+static mcComment_commentDesc bodyComment;
+static mcComment_commentDesc afterComment;
+static mcLexBuf_sourceList currentSource;
+static unsigned int useBufferedTokens;
+static unsigned int currentUsed;
+static mcLexBuf_listDesc listOfTokens;
+static unsigned int nextTokNo;
+
+/*
+ getProcedureComment - returns the procedure comment if it exists,
+ or NIL otherwise.
+*/
+
+extern "C" mcComment_commentDesc mcLexBuf_getProcedureComment (void);
+
+/*
+ getBodyComment - returns the body comment if it exists,
+ or NIL otherwise. The body comment is
+ removed if found.
+*/
+
+extern "C" mcComment_commentDesc mcLexBuf_getBodyComment (void);
+
+/*
+ getAfterComment - returns the after comment if it exists,
+ or NIL otherwise. The after comment is
+ removed if found.
+*/
+
+extern "C" mcComment_commentDesc mcLexBuf_getAfterComment (void);
+
+/*
+ openSource - attempts to open the source file, s.
+ The success of the operation is returned.
+*/
+
+extern "C" unsigned int mcLexBuf_openSource (DynamicStrings_String s);
+
+/*
+ closeSource - closes the current open file.
+*/
+
+extern "C" void mcLexBuf_closeSource (void);
+
+/*
+ reInitialize - re-initialize the all the data structures.
+*/
+
+extern "C" void mcLexBuf_reInitialize (void);
+
+/*
+ resetForNewPass - reset the buffer pointers to the beginning ready for
+ a new pass
+*/
+
+extern "C" void mcLexBuf_resetForNewPass (void);
+
+/*
+ getToken - gets the next token into currenttoken.
+*/
+
+extern "C" void mcLexBuf_getToken (void);
+
+/*
+ insertToken - inserts a symbol, token, infront of the current token
+ ready for the next pass.
+*/
+
+extern "C" void mcLexBuf_insertToken (mcReserved_toktype token);
+
+/*
+ insertTokenAndRewind - inserts a symbol, token, infront of the current token
+ and then moves the token stream back onto the inserted token.
+*/
+
+extern "C" void mcLexBuf_insertTokenAndRewind (mcReserved_toktype token);
+
+/*
+ getPreviousTokenLineNo - returns the line number of the previous token.
+*/
+
+extern "C" unsigned int mcLexBuf_getPreviousTokenLineNo (void);
+
+/*
+ getLineNo - returns the current line number where the symbol occurs in
+ the source file.
+*/
+
+extern "C" unsigned int mcLexBuf_getLineNo (void);
+
+/*
+ getTokenNo - returns the current token number.
+*/
+
+extern "C" unsigned int mcLexBuf_getTokenNo (void);
+
+/*
+ tokenToLineNo - returns the line number of the current file for the
+ tokenNo. The depth refers to the include depth.
+ A depth of 0 is the current file, depth of 1 is the file
+ which included the current file. Zero is returned if the
+ depth exceeds the file nesting level.
+*/
+
+extern "C" unsigned int mcLexBuf_tokenToLineNo (unsigned int tokenNo, unsigned int depth);
+
+/*
+ getColumnNo - returns the current column where the symbol occurs in
+ the source file.
+*/
+
+extern "C" unsigned int mcLexBuf_getColumnNo (void);
+
+/*
+ tokenToColumnNo - returns the column number of the current file for the
+ tokenNo. The depth refers to the include depth.
+ A depth of 0 is the current file, depth of 1 is the file
+ which included the current file. Zero is returned if the
+ depth exceeds the file nesting level.
+*/
+
+extern "C" unsigned int mcLexBuf_tokenToColumnNo (unsigned int tokenNo, unsigned int depth);
+
+/*
+ findFileNameFromToken - returns the complete FileName for the appropriate
+ source file yields the token number, tokenNo.
+ The, Depth, indicates the include level: 0..n
+ Level 0 is the current. NIL is returned if n+1
+ is requested.
+*/
+
+extern "C" DynamicStrings_String mcLexBuf_findFileNameFromToken (unsigned int tokenNo, unsigned int depth);
+
+/*
+ getFileName - returns a String defining the current file.
+*/
+
+extern "C" DynamicStrings_String mcLexBuf_getFileName (void);
+
+/*
+ addTok - adds a token to the buffer.
+*/
+
+extern "C" void mcLexBuf_addTok (mcReserved_toktype t);
+
+/*
+ addTokCharStar - adds a token to the buffer and an additional string, s.
+ A copy of string, s, is made.
+*/
+
+extern "C" void mcLexBuf_addTokCharStar (mcReserved_toktype t, void * s);
+
+/*
+ addTokInteger - adds a token and an integer to the buffer.
+*/
+
+extern "C" void mcLexBuf_addTokInteger (mcReserved_toktype t, int i);
+
+/*
+ addTokComment - adds a token to the buffer and a comment descriptor, com.
+*/
+
+extern "C" void mcLexBuf_addTokComment (mcReserved_toktype t, mcComment_commentDesc com);
+
+/*
+ setFile - sets the current filename to, filename.
+*/
+
+extern "C" void mcLexBuf_setFile (void * filename);
+
+/*
+ pushFile - indicates that, filename, has just been included.
+*/
+
+extern "C" void mcLexBuf_pushFile (void * filename);
+
+/*
+ popFile - indicates that we are returning to, filename, having finished
+ an include.
+*/
+
+extern "C" void mcLexBuf_popFile (void * filename);
+
+/*
+ debugLex - display the last, n, tokens.
+*/
+
+static void debugLex (unsigned int n);
+
+/*
+ seekTo -
+*/
+
+static void seekTo (unsigned int t);
+
+/*
+ peeptokenBucket -
+*/
+
+static mcLexBuf_tokenBucket peeptokenBucket (unsigned int *t);
+
+/*
+ peepAfterComment - peeps ahead looking for an after statement comment. It stops at an END token
+ or if the line number changes.
+*/
+
+static void peepAfterComment (void);
+
+/*
+ init - initializes the token list and source list.
+*/
+
+static void init (void);
+
+/*
+ addTo - adds a new element to the end of sourceList, currentSource.
+*/
+
+static void addTo (mcLexBuf_sourceList l);
+
+/*
+ subFrom - subtracts, l, from the source list.
+*/
+
+static void subFrom (mcLexBuf_sourceList l);
+
+/*
+ newElement - returns a new sourceList
+*/
+
+static mcLexBuf_sourceList newElement (void * s);
+
+/*
+ newList - initializes an empty list with the classic dummy header element.
+*/
+
+static mcLexBuf_sourceList newList (void);
+
+/*
+ checkIfNeedToDuplicate - checks to see whether the currentSource has
+ been used, if it has then duplicate the list.
+*/
+
+static void checkIfNeedToDuplicate (void);
+
+/*
+ killList - kills the sourceList providing that it has not been used.
+*/
+
+static void killList (void);
+
+/*
+ displayToken -
+*/
+
+static void displayToken (mcReserved_toktype t);
+
+/*
+ updateFromBucket - updates the global variables: currenttoken,
+ currentstring, currentcolumn and currentinteger
+ from tokenBucket, b, and, offset.
+*/
+
+static void updateFromBucket (mcLexBuf_tokenBucket b, unsigned int offset);
+
+/*
+ doGetToken - fetch the next token into currenttoken.
+*/
+
+static void doGetToken (void);
+
+/*
+ syncOpenWithBuffer - synchronise the buffer with the start of a file.
+ Skips all the tokens to do with the previous file.
+*/
+
+static void syncOpenWithBuffer (void);
+
+/*
+ findtokenBucket - returns the tokenBucket corresponding to the tokenNo.
+*/
+
+static mcLexBuf_tokenBucket findtokenBucket (unsigned int *tokenNo);
+
+/*
+ getFileName - returns a String defining the current file.
+*/
+
+static void stop (void);
+
+/*
+ addTokToList - adds a token to a dynamic list.
+*/
+
+static void addTokToList (mcReserved_toktype t, nameKey_Name n, int i, mcComment_commentDesc comment, unsigned int l, unsigned int c, mcLexBuf_sourceList f);
+
+/*
+ isLastTokenEof - returns TRUE if the last token was an eoftok
+*/
+
+static unsigned int isLastTokenEof (void);
+
+
+/*
+ debugLex - display the last, n, tokens.
+*/
+
+static void debugLex (unsigned int n)
+{
+ unsigned int c;
+ unsigned int i;
+ unsigned int o;
+ unsigned int t;
+ mcLexBuf_tokenBucket b;
+
+ if (nextTokNo > n)
+ {
+ o = nextTokNo-n;
+ }
+ else
+ {
+ o = 0;
+ }
+ i = 0;
+ do {
+ t = o+i;
+ if (nextTokNo == t)
+ {
+ mcPrintf_printf0 ((const char *) "nextTokNo ", 10);
+ }
+ b = findtokenBucket (&t);
+ if (b == NULL)
+ {
+ t = o+i;
+ mcPrintf_printf1 ((const char *) "end of buf (%d is further ahead than the buffer contents)\\n", 60, (const unsigned char *) &t, (sizeof (t)-1));
+ }
+ else
+ {
+ c = o+i;
+ mcPrintf_printf2 ((const char *) "entry %d %d ", 13, (const unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) &t, (sizeof (t)-1));
+ displayToken (b->buf.array[t].token);
+ mcPrintf_printf0 ((const char *) "\\n", 2);
+ i += 1;
+ }
+ } while (! (b == NULL));
+}
+
+
+/*
+ seekTo -
+*/
+
+static void seekTo (unsigned int t)
+{
+ mcLexBuf_tokenBucket b;
+
+ nextTokNo = t;
+ if (t > 0)
+ {
+ t -= 1;
+ b = findtokenBucket (&t);
+ if (b == NULL)
+ {
+ updateFromBucket (b, t);
+ }
+ }
+}
+
+
+/*
+ peeptokenBucket -
+*/
+
+static mcLexBuf_tokenBucket peeptokenBucket (unsigned int *t)
+{
+ mcReserved_toktype ct;
+ unsigned int old;
+ unsigned int n;
+ mcLexBuf_tokenBucket b;
+ mcLexBuf_tokenBucket c;
+
+ ct = mcLexBuf_currenttoken;
+ if (Debugging)
+ {
+ debugLex (5);
+ }
+ old = mcLexBuf_getTokenNo ();
+ do {
+ n = (*t);
+ b = findtokenBucket (&n);
+ if (b == NULL)
+ {
+ doGetToken ();
+ n = (*t);
+ b = findtokenBucket (&n);
+ if ((b == NULL) || (mcLexBuf_currenttoken == mcReserved_eoftok))
+ {
+ /* bailing out. */
+ nextTokNo = old+1;
+ b = findtokenBucket (&old);
+ updateFromBucket (b, old);
+ return NULL;
+ }
+ }
+ } while (! ((b != NULL) || (mcLexBuf_currenttoken == mcReserved_eoftok)));
+ (*t) = n;
+ nextTokNo = old+1;
+ if (Debugging)
+ {
+ mcPrintf_printf2 ((const char *) "nextTokNo = %d, old = %d\\n", 26, (const unsigned char *) &nextTokNo, (sizeof (nextTokNo)-1), (const unsigned char *) &old, (sizeof (old)-1));
+ }
+ b = findtokenBucket (&old);
+ if (Debugging)
+ {
+ mcPrintf_printf1 ((const char *) " adjusted old = %d\\n", 21, (const unsigned char *) &old, (sizeof (old)-1));
+ }
+ if (b != NULL)
+ {
+ updateFromBucket (b, old);
+ }
+ if (Debugging)
+ {
+ debugLex (5);
+ }
+ mcDebug_assert (ct == mcLexBuf_currenttoken);
+ return b;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ peepAfterComment - peeps ahead looking for an after statement comment. It stops at an END token
+ or if the line number changes.
+*/
+
+static void peepAfterComment (void)
+{
+ unsigned int oldTokNo;
+ unsigned int t;
+ unsigned int peep;
+ unsigned int cno;
+ unsigned int nextline;
+ unsigned int curline;
+ mcLexBuf_tokenBucket b;
+ unsigned int finished;
+
+ oldTokNo = nextTokNo;
+ cno = mcLexBuf_getTokenNo ();
+ curline = mcLexBuf_tokenToLineNo (cno, 0);
+ nextline = curline;
+ peep = 0;
+ finished = FALSE;
+ do {
+ t = cno+peep;
+ b = peeptokenBucket (&t);
+ if ((b == NULL) || (mcLexBuf_currenttoken == mcReserved_eoftok))
+ {
+ finished = TRUE;
+ }
+ else
+ {
+ nextline = b->buf.array[t].line;
+ if (nextline == curline)
+ {
+ switch (b->buf.array[t].token)
+ {
+ case mcReserved_eoftok:
+ case mcReserved_endtok:
+ finished = TRUE;
+ break;
+
+ case mcReserved_commenttok:
+ if (mcComment_isAfterComment (b->buf.array[t].com))
+ {
+ afterComment = b->buf.array[t].com;
+ }
+ break;
+
+
+ default:
+ break;
+ }
+ }
+ else
+ {
+ finished = TRUE;
+ }
+ }
+ peep += 1;
+ } while (! (finished));
+ seekTo (oldTokNo);
+}
+
+
+/*
+ init - initializes the token list and source list.
+*/
+
+static void init (void)
+{
+ mcLexBuf_currenttoken = mcReserved_eoftok;
+ nextTokNo = 0;
+ currentSource = NULL;
+ listOfTokens.head = NULL;
+ listOfTokens.tail = NULL;
+ useBufferedTokens = FALSE;
+ procedureComment = static_cast<mcComment_commentDesc> (NULL);
+ bodyComment = static_cast<mcComment_commentDesc> (NULL);
+ afterComment = static_cast<mcComment_commentDesc> (NULL);
+ mcLexBuf_lastcomment = static_cast<mcComment_commentDesc> (NULL);
+}
+
+
+/*
+ addTo - adds a new element to the end of sourceList, currentSource.
+*/
+
+static void addTo (mcLexBuf_sourceList l)
+{
+ l->right = currentSource;
+ l->left = currentSource->left;
+ currentSource->left->right = l;
+ currentSource->left = l;
+ l->left->line = mcflex_getLineNo ();
+ l->left->col = mcflex_getColumnNo ();
+}
+
+
+/*
+ subFrom - subtracts, l, from the source list.
+*/
+
+static void subFrom (mcLexBuf_sourceList l)
+{
+ l->left->right = l->right;
+ l->right->left = l->left;
+}
+
+
+/*
+ newElement - returns a new sourceList
+*/
+
+static mcLexBuf_sourceList newElement (void * s)
+{
+ mcLexBuf_sourceList l;
+
+ Storage_ALLOCATE ((void **) &l, sizeof (mcLexBuf__T1));
+ if (l == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ l->name = DynamicStrings_InitStringCharStar (s);
+ l->left = NULL;
+ l->right = NULL;
+ }
+ return l;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ newList - initializes an empty list with the classic dummy header element.
+*/
+
+static mcLexBuf_sourceList newList (void)
+{
+ mcLexBuf_sourceList l;
+
+ Storage_ALLOCATE ((void **) &l, sizeof (mcLexBuf__T1));
+ l->left = l;
+ l->right = l;
+ l->name = static_cast<DynamicStrings_String> (NULL);
+ return l;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ checkIfNeedToDuplicate - checks to see whether the currentSource has
+ been used, if it has then duplicate the list.
+*/
+
+static void checkIfNeedToDuplicate (void)
+{
+ mcLexBuf_sourceList l;
+ mcLexBuf_sourceList h;
+
+ if (currentUsed)
+ {
+ l = currentSource->right;
+ h = currentSource;
+ currentSource = newList ();
+ while (l != h)
+ {
+ addTo (newElement (reinterpret_cast<void *> (l->name)));
+ l = l->right;
+ }
+ }
+}
+
+
+/*
+ killList - kills the sourceList providing that it has not been used.
+*/
+
+static void killList (void)
+{
+ mcLexBuf_sourceList l;
+ mcLexBuf_sourceList k;
+
+ if (! currentUsed && (currentSource != NULL))
+ {
+ l = currentSource;
+ do {
+ k = l;
+ l = l->right;
+ Storage_DEALLOCATE ((void **) &k, sizeof (mcLexBuf__T1));
+ } while (! (l == currentSource));
+ }
+}
+
+
+/*
+ displayToken -
+*/
+
+static void displayToken (mcReserved_toktype t)
+{
+ switch (t)
+ {
+ case mcReserved_eoftok:
+ mcPrintf_printf0 ((const char *) "eoftok\\n", 8);
+ break;
+
+ case mcReserved_plustok:
+ mcPrintf_printf0 ((const char *) "plustok\\n", 9);
+ break;
+
+ case mcReserved_minustok:
+ mcPrintf_printf0 ((const char *) "minustok\\n", 10);
+ break;
+
+ case mcReserved_timestok:
+ mcPrintf_printf0 ((const char *) "timestok\\n", 10);
+ break;
+
+ case mcReserved_dividetok:
+ mcPrintf_printf0 ((const char *) "dividetok\\n", 11);
+ break;
+
+ case mcReserved_becomestok:
+ mcPrintf_printf0 ((const char *) "becomestok\\n", 12);
+ break;
+
+ case mcReserved_ambersandtok:
+ mcPrintf_printf0 ((const char *) "ambersandtok\\n", 14);
+ break;
+
+ case mcReserved_periodtok:
+ mcPrintf_printf0 ((const char *) "periodtok\\n", 11);
+ break;
+
+ case mcReserved_commatok:
+ mcPrintf_printf0 ((const char *) "commatok\\n", 10);
+ break;
+
+ case mcReserved_commenttok:
+ mcPrintf_printf0 ((const char *) "commenttok\\n", 12);
+ break;
+
+ case mcReserved_semicolontok:
+ mcPrintf_printf0 ((const char *) "semicolontok\\n", 14);
+ break;
+
+ case mcReserved_lparatok:
+ mcPrintf_printf0 ((const char *) "lparatok\\n", 10);
+ break;
+
+ case mcReserved_rparatok:
+ mcPrintf_printf0 ((const char *) "rparatok\\n", 10);
+ break;
+
+ case mcReserved_lsbratok:
+ mcPrintf_printf0 ((const char *) "lsbratok\\n", 10);
+ break;
+
+ case mcReserved_rsbratok:
+ mcPrintf_printf0 ((const char *) "rsbratok\\n", 10);
+ break;
+
+ case mcReserved_lcbratok:
+ mcPrintf_printf0 ((const char *) "lcbratok\\n", 10);
+ break;
+
+ case mcReserved_rcbratok:
+ mcPrintf_printf0 ((const char *) "rcbratok\\n", 10);
+ break;
+
+ case mcReserved_uparrowtok:
+ mcPrintf_printf0 ((const char *) "uparrowtok\\n", 12);
+ break;
+
+ case mcReserved_singlequotetok:
+ mcPrintf_printf0 ((const char *) "singlequotetok\\n", 16);
+ break;
+
+ case mcReserved_equaltok:
+ mcPrintf_printf0 ((const char *) "equaltok\\n", 10);
+ break;
+
+ case mcReserved_hashtok:
+ mcPrintf_printf0 ((const char *) "hashtok\\n", 9);
+ break;
+
+ case mcReserved_lesstok:
+ mcPrintf_printf0 ((const char *) "lesstok\\n", 9);
+ break;
+
+ case mcReserved_greatertok:
+ mcPrintf_printf0 ((const char *) "greatertok\\n", 12);
+ break;
+
+ case mcReserved_lessgreatertok:
+ mcPrintf_printf0 ((const char *) "lessgreatertok\\n", 16);
+ break;
+
+ case mcReserved_lessequaltok:
+ mcPrintf_printf0 ((const char *) "lessequaltok\\n", 14);
+ break;
+
+ case mcReserved_greaterequaltok:
+ mcPrintf_printf0 ((const char *) "greaterequaltok\\n", 17);
+ break;
+
+ case mcReserved_periodperiodtok:
+ mcPrintf_printf0 ((const char *) "periodperiodtok\\n", 17);
+ break;
+
+ case mcReserved_colontok:
+ mcPrintf_printf0 ((const char *) "colontok\\n", 10);
+ break;
+
+ case mcReserved_doublequotestok:
+ mcPrintf_printf0 ((const char *) "doublequotestok\\n", 17);
+ break;
+
+ case mcReserved_bartok:
+ mcPrintf_printf0 ((const char *) "bartok\\n", 8);
+ break;
+
+ case mcReserved_andtok:
+ mcPrintf_printf0 ((const char *) "andtok\\n", 8);
+ break;
+
+ case mcReserved_arraytok:
+ mcPrintf_printf0 ((const char *) "arraytok\\n", 10);
+ break;
+
+ case mcReserved_begintok:
+ mcPrintf_printf0 ((const char *) "begintok\\n", 10);
+ break;
+
+ case mcReserved_bytok:
+ mcPrintf_printf0 ((const char *) "bytok\\n", 7);
+ break;
+
+ case mcReserved_casetok:
+ mcPrintf_printf0 ((const char *) "casetok\\n", 9);
+ break;
+
+ case mcReserved_consttok:
+ mcPrintf_printf0 ((const char *) "consttok\\n", 10);
+ break;
+
+ case mcReserved_definitiontok:
+ mcPrintf_printf0 ((const char *) "definitiontok\\n", 15);
+ break;
+
+ case mcReserved_divtok:
+ mcPrintf_printf0 ((const char *) "divtok\\n", 8);
+ break;
+
+ case mcReserved_dotok:
+ mcPrintf_printf0 ((const char *) "dotok\\n", 7);
+ break;
+
+ case mcReserved_elsetok:
+ mcPrintf_printf0 ((const char *) "elsetok\\n", 9);
+ break;
+
+ case mcReserved_elsiftok:
+ mcPrintf_printf0 ((const char *) "elsiftok\\n", 10);
+ break;
+
+ case mcReserved_endtok:
+ mcPrintf_printf0 ((const char *) "endtok\\n", 8);
+ break;
+
+ case mcReserved_exittok:
+ mcPrintf_printf0 ((const char *) "exittok\\n", 9);
+ break;
+
+ case mcReserved_exporttok:
+ mcPrintf_printf0 ((const char *) "exporttok\\n", 11);
+ break;
+
+ case mcReserved_fortok:
+ mcPrintf_printf0 ((const char *) "fortok\\n", 8);
+ break;
+
+ case mcReserved_fromtok:
+ mcPrintf_printf0 ((const char *) "fromtok\\n", 9);
+ break;
+
+ case mcReserved_iftok:
+ mcPrintf_printf0 ((const char *) "iftok\\n", 7);
+ break;
+
+ case mcReserved_implementationtok:
+ mcPrintf_printf0 ((const char *) "implementationtok\\n", 19);
+ break;
+
+ case mcReserved_importtok:
+ mcPrintf_printf0 ((const char *) "importtok\\n", 11);
+ break;
+
+ case mcReserved_intok:
+ mcPrintf_printf0 ((const char *) "intok\\n", 7);
+ break;
+
+ case mcReserved_looptok:
+ mcPrintf_printf0 ((const char *) "looptok\\n", 9);
+ break;
+
+ case mcReserved_modtok:
+ mcPrintf_printf0 ((const char *) "modtok\\n", 8);
+ break;
+
+ case mcReserved_moduletok:
+ mcPrintf_printf0 ((const char *) "moduletok\\n", 11);
+ break;
+
+ case mcReserved_nottok:
+ mcPrintf_printf0 ((const char *) "nottok\\n", 8);
+ break;
+
+ case mcReserved_oftok:
+ mcPrintf_printf0 ((const char *) "oftok\\n", 7);
+ break;
+
+ case mcReserved_ortok:
+ mcPrintf_printf0 ((const char *) "ortok\\n", 7);
+ break;
+
+ case mcReserved_pointertok:
+ mcPrintf_printf0 ((const char *) "pointertok\\n", 12);
+ break;
+
+ case mcReserved_proceduretok:
+ mcPrintf_printf0 ((const char *) "proceduretok\\n", 14);
+ break;
+
+ case mcReserved_qualifiedtok:
+ mcPrintf_printf0 ((const char *) "qualifiedtok\\n", 14);
+ break;
+
+ case mcReserved_unqualifiedtok:
+ mcPrintf_printf0 ((const char *) "unqualifiedtok\\n", 16);
+ break;
+
+ case mcReserved_recordtok:
+ mcPrintf_printf0 ((const char *) "recordtok\\n", 11);
+ break;
+
+ case mcReserved_repeattok:
+ mcPrintf_printf0 ((const char *) "repeattok\\n", 11);
+ break;
+
+ case mcReserved_returntok:
+ mcPrintf_printf0 ((const char *) "returntok\\n", 11);
+ break;
+
+ case mcReserved_settok:
+ mcPrintf_printf0 ((const char *) "settok\\n", 8);
+ break;
+
+ case mcReserved_thentok:
+ mcPrintf_printf0 ((const char *) "thentok\\n", 9);
+ break;
+
+ case mcReserved_totok:
+ mcPrintf_printf0 ((const char *) "totok\\n", 7);
+ break;
+
+ case mcReserved_typetok:
+ mcPrintf_printf0 ((const char *) "typetok\\n", 9);
+ break;
+
+ case mcReserved_untiltok:
+ mcPrintf_printf0 ((const char *) "untiltok\\n", 10);
+ break;
+
+ case mcReserved_vartok:
+ mcPrintf_printf0 ((const char *) "vartok\\n", 8);
+ break;
+
+ case mcReserved_whiletok:
+ mcPrintf_printf0 ((const char *) "whiletok\\n", 10);
+ break;
+
+ case mcReserved_withtok:
+ mcPrintf_printf0 ((const char *) "withtok\\n", 9);
+ break;
+
+ case mcReserved_asmtok:
+ mcPrintf_printf0 ((const char *) "asmtok\\n", 8);
+ break;
+
+ case mcReserved_volatiletok:
+ mcPrintf_printf0 ((const char *) "volatiletok\\n", 13);
+ break;
+
+ case mcReserved_periodperiodperiodtok:
+ mcPrintf_printf0 ((const char *) "periodperiodperiodtok\\n", 23);
+ break;
+
+ case mcReserved_datetok:
+ mcPrintf_printf0 ((const char *) "datetok\\n", 9);
+ break;
+
+ case mcReserved_linetok:
+ mcPrintf_printf0 ((const char *) "linetok\\n", 9);
+ break;
+
+ case mcReserved_filetok:
+ mcPrintf_printf0 ((const char *) "filetok\\n", 9);
+ break;
+
+ case mcReserved_integertok:
+ mcPrintf_printf0 ((const char *) "integertok\\n", 12);
+ break;
+
+ case mcReserved_identtok:
+ mcPrintf_printf0 ((const char *) "identtok\\n", 10);
+ break;
+
+ case mcReserved_realtok:
+ mcPrintf_printf0 ((const char *) "realtok\\n", 9);
+ break;
+
+ case mcReserved_stringtok:
+ mcPrintf_printf0 ((const char *) "stringtok\\n", 11);
+ break;
+
+
+ default:
+ mcPrintf_printf0 ((const char *) "unknown tok (--fixme--)\\n", 25);
+ break;
+ }
+}
+
+
+/*
+ updateFromBucket - updates the global variables: currenttoken,
+ currentstring, currentcolumn and currentinteger
+ from tokenBucket, b, and, offset.
+*/
+
+static void updateFromBucket (mcLexBuf_tokenBucket b, unsigned int offset)
+{
+ mcLexBuf_currenttoken = b->buf.array[offset].token;
+ mcLexBuf_currentstring = nameKey_keyToCharStar (b->buf.array[offset].str);
+ mcLexBuf_currentcolumn = b->buf.array[offset].col;
+ mcLexBuf_currentinteger = b->buf.array[offset].int_;
+ mcLexBuf_currentcomment = b->buf.array[offset].com;
+ if (mcLexBuf_currentcomment != NULL)
+ {
+ mcLexBuf_lastcomment = mcLexBuf_currentcomment;
+ }
+ if (Debugging)
+ {
+ mcPrintf_printf3 ((const char *) "line %d (# %d %d) ", 19, (const unsigned char *) &b->buf.array[offset].line, (sizeof (b->buf.array[offset].line)-1), (const unsigned char *) &offset, (sizeof (offset)-1), (const unsigned char *) &nextTokNo, (sizeof (nextTokNo)-1));
+ }
+}
+
+
+/*
+ doGetToken - fetch the next token into currenttoken.
+*/
+
+static void doGetToken (void)
+{
+ void * a;
+ unsigned int t;
+ mcLexBuf_tokenBucket b;
+
+ if (useBufferedTokens)
+ {
+ t = nextTokNo;
+ b = findtokenBucket (&t);
+ updateFromBucket (b, t);
+ }
+ else
+ {
+ if (listOfTokens.tail == NULL)
+ {
+ a = mcflex_getToken ();
+ if (listOfTokens.tail == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ }
+ if (nextTokNo >= listOfTokens.lastBucketOffset)
+ {
+ /* nextTokNo is in the last bucket or needs to be read. */
+ if ((nextTokNo-listOfTokens.lastBucketOffset) < listOfTokens.tail->len)
+ {
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "fetching token from buffer (updateFromBucket)\\n", 47);
+ }
+ updateFromBucket (listOfTokens.tail, nextTokNo-listOfTokens.lastBucketOffset);
+ }
+ else
+ {
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "calling flex to place token into buffer\\n", 41);
+ }
+ /* call the lexical phase to place a new token into the last bucket. */
+ a = mcflex_getToken ();
+ mcLexBuf_getToken (); /* and call ourselves again to collect the token from bucket. */
+ return ; /* and call ourselves again to collect the token from bucket. */
+ }
+ }
+ else
+ {
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "fetching token from buffer\\n", 28);
+ }
+ t = nextTokNo;
+ b = findtokenBucket (&t);
+ updateFromBucket (b, t);
+ }
+ }
+ if (Debugging)
+ {
+ displayToken (mcLexBuf_currenttoken);
+ }
+ nextTokNo += 1;
+}
+
+
+/*
+ syncOpenWithBuffer - synchronise the buffer with the start of a file.
+ Skips all the tokens to do with the previous file.
+*/
+
+static void syncOpenWithBuffer (void)
+{
+ if (listOfTokens.tail != NULL)
+ {
+ nextTokNo = listOfTokens.lastBucketOffset+listOfTokens.tail->len;
+ }
+}
+
+
+/*
+ findtokenBucket - returns the tokenBucket corresponding to the tokenNo.
+*/
+
+static mcLexBuf_tokenBucket findtokenBucket (unsigned int *tokenNo)
+{
+ mcLexBuf_tokenBucket b;
+
+ b = listOfTokens.head;
+ while (b != NULL)
+ {
+ if ((*tokenNo) < b->len)
+ {
+ return b;
+ }
+ else
+ {
+ (*tokenNo) -= b->len;
+ }
+ b = b->next;
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getFileName - returns a String defining the current file.
+*/
+
+static void stop (void)
+{
+}
+
+
+/*
+ addTokToList - adds a token to a dynamic list.
+*/
+
+static void addTokToList (mcReserved_toktype t, nameKey_Name n, int i, mcComment_commentDesc comment, unsigned int l, unsigned int c, mcLexBuf_sourceList f)
+{
+ mcLexBuf_tokenBucket b;
+
+ if (listOfTokens.head == NULL)
+ {
+ Storage_ALLOCATE ((void **) &listOfTokens.head, sizeof (mcLexBuf__T2));
+ if (listOfTokens.head == NULL)
+ {} /* empty. */
+ /* list error */
+ listOfTokens.tail = listOfTokens.head;
+ listOfTokens.tail->len = 0;
+ }
+ else if (listOfTokens.tail->len == MaxBucketSize)
+ {
+ /* avoid dangling else. */
+ mcDebug_assert (listOfTokens.tail->next == NULL);
+ Storage_ALLOCATE ((void **) &listOfTokens.tail->next, sizeof (mcLexBuf__T2));
+ if (listOfTokens.tail->next == NULL)
+ {} /* empty. */
+ else
+ {
+ /* list error */
+ listOfTokens.tail = listOfTokens.tail->next;
+ listOfTokens.tail->len = 0;
+ }
+ listOfTokens.lastBucketOffset += MaxBucketSize;
+ }
+ listOfTokens.tail->next = NULL;
+ mcDebug_assert (listOfTokens.tail->len != MaxBucketSize);
+ listOfTokens.tail->buf.array[listOfTokens.tail->len].token = t;
+ listOfTokens.tail->buf.array[listOfTokens.tail->len].str = n;
+ listOfTokens.tail->buf.array[listOfTokens.tail->len].int_ = i;
+ listOfTokens.tail->buf.array[listOfTokens.tail->len].com = comment;
+ listOfTokens.tail->buf.array[listOfTokens.tail->len].line = l;
+ listOfTokens.tail->buf.array[listOfTokens.tail->len].col = c;
+ listOfTokens.tail->buf.array[listOfTokens.tail->len].file = f;
+ listOfTokens.tail->len += 1;
+}
+
+
+/*
+ isLastTokenEof - returns TRUE if the last token was an eoftok
+*/
+
+static unsigned int isLastTokenEof (void)
+{
+ unsigned int t;
+ mcLexBuf_tokenBucket b;
+
+ if (listOfTokens.tail != NULL)
+ {
+ if (listOfTokens.tail->len == 0)
+ {
+ b = listOfTokens.head;
+ if (b == listOfTokens.tail)
+ {
+ return FALSE;
+ }
+ while (b->next != listOfTokens.tail)
+ {
+ b = b->next;
+ }
+ }
+ else
+ {
+ b = listOfTokens.tail;
+ }
+ mcDebug_assert (b->len > 0); /* len should always be >0 */
+ return b->buf.array[b->len-1].token == mcReserved_eoftok; /* len should always be >0 */
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getProcedureComment - returns the procedure comment if it exists,
+ or NIL otherwise.
+*/
+
+extern "C" mcComment_commentDesc mcLexBuf_getProcedureComment (void)
+{
+ return procedureComment;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getBodyComment - returns the body comment if it exists,
+ or NIL otherwise. The body comment is
+ removed if found.
+*/
+
+extern "C" mcComment_commentDesc mcLexBuf_getBodyComment (void)
+{
+ mcComment_commentDesc b;
+
+ b = bodyComment;
+ bodyComment = static_cast<mcComment_commentDesc> (NULL);
+ return b;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getAfterComment - returns the after comment if it exists,
+ or NIL otherwise. The after comment is
+ removed if found.
+*/
+
+extern "C" mcComment_commentDesc mcLexBuf_getAfterComment (void)
+{
+ mcComment_commentDesc a;
+
+ peepAfterComment ();
+ a = afterComment;
+ afterComment = static_cast<mcComment_commentDesc> (NULL);
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openSource - attempts to open the source file, s.
+ The success of the operation is returned.
+*/
+
+extern "C" unsigned int mcLexBuf_openSource (DynamicStrings_String s)
+{
+ if (useBufferedTokens)
+ {
+ mcLexBuf_getToken ();
+ return TRUE;
+ }
+ else
+ {
+ if (mcflex_openSource (DynamicStrings_string (s)))
+ {
+ mcLexBuf_setFile (DynamicStrings_string (s));
+ syncOpenWithBuffer ();
+ mcLexBuf_getToken ();
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ closeSource - closes the current open file.
+*/
+
+extern "C" void mcLexBuf_closeSource (void)
+{
+ if (useBufferedTokens)
+ {
+ while (mcLexBuf_currenttoken != mcReserved_eoftok)
+ {
+ mcLexBuf_getToken ();
+ }
+ }
+ /* a subsequent call to mcflex.OpenSource will really close the file */
+}
+
+
+/*
+ reInitialize - re-initialize the all the data structures.
+*/
+
+extern "C" void mcLexBuf_reInitialize (void)
+{
+ mcLexBuf_tokenBucket s;
+ mcLexBuf_tokenBucket t;
+
+ if (listOfTokens.head != NULL)
+ {
+ t = listOfTokens.head;
+ do {
+ s = t;
+ t = t->next;
+ Storage_DEALLOCATE ((void **) &s, sizeof (mcLexBuf__T2));
+ } while (! (t == NULL));
+ currentUsed = FALSE;
+ killList ();
+ }
+ init ();
+}
+
+
+/*
+ resetForNewPass - reset the buffer pointers to the beginning ready for
+ a new pass
+*/
+
+extern "C" void mcLexBuf_resetForNewPass (void)
+{
+ nextTokNo = 0;
+ useBufferedTokens = TRUE;
+}
+
+
+/*
+ getToken - gets the next token into currenttoken.
+*/
+
+extern "C" void mcLexBuf_getToken (void)
+{
+ do {
+ doGetToken ();
+ if (mcLexBuf_currenttoken == mcReserved_commenttok)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (mcComment_isProcedureComment (mcLexBuf_currentcomment))
+ {
+ procedureComment = mcLexBuf_currentcomment;
+ bodyComment = static_cast<mcComment_commentDesc> (NULL);
+ afterComment = static_cast<mcComment_commentDesc> (NULL);
+ }
+ else if (mcComment_isBodyComment (mcLexBuf_currentcomment))
+ {
+ /* avoid dangling else. */
+ bodyComment = mcLexBuf_currentcomment;
+ afterComment = static_cast<mcComment_commentDesc> (NULL);
+ }
+ else if (mcComment_isAfterComment (mcLexBuf_currentcomment))
+ {
+ /* avoid dangling else. */
+ procedureComment = static_cast<mcComment_commentDesc> (NULL);
+ bodyComment = static_cast<mcComment_commentDesc> (NULL);
+ afterComment = mcLexBuf_currentcomment;
+ }
+ }
+ } while (! (mcLexBuf_currenttoken != mcReserved_commenttok));
+}
+
+
+/*
+ insertToken - inserts a symbol, token, infront of the current token
+ ready for the next pass.
+*/
+
+extern "C" void mcLexBuf_insertToken (mcReserved_toktype token)
+{
+ if (listOfTokens.tail != NULL)
+ {
+ if (listOfTokens.tail->len > 0)
+ {
+ listOfTokens.tail->buf.array[listOfTokens.tail->len-1].token = token;
+ }
+ addTokToList (mcLexBuf_currenttoken, nameKey_NulName, 0, static_cast<mcComment_commentDesc> (NULL), mcLexBuf_getLineNo (), mcLexBuf_getColumnNo (), currentSource);
+ mcLexBuf_getToken ();
+ }
+}
+
+
+/*
+ insertTokenAndRewind - inserts a symbol, token, infront of the current token
+ and then moves the token stream back onto the inserted token.
+*/
+
+extern "C" void mcLexBuf_insertTokenAndRewind (mcReserved_toktype token)
+{
+ if (listOfTokens.tail != NULL)
+ {
+ if (listOfTokens.tail->len > 0)
+ {
+ listOfTokens.tail->buf.array[listOfTokens.tail->len-1].token = token;
+ }
+ addTokToList (mcLexBuf_currenttoken, nameKey_NulName, 0, static_cast<mcComment_commentDesc> (NULL), mcLexBuf_getLineNo (), mcLexBuf_getColumnNo (), currentSource);
+ mcLexBuf_currenttoken = token;
+ }
+}
+
+
+/*
+ getPreviousTokenLineNo - returns the line number of the previous token.
+*/
+
+extern "C" unsigned int mcLexBuf_getPreviousTokenLineNo (void)
+{
+ return mcLexBuf_getLineNo ();
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getLineNo - returns the current line number where the symbol occurs in
+ the source file.
+*/
+
+extern "C" unsigned int mcLexBuf_getLineNo (void)
+{
+ if (nextTokNo == 0)
+ {
+ return 0;
+ }
+ else
+ {
+ return mcLexBuf_tokenToLineNo (mcLexBuf_getTokenNo (), 0);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getTokenNo - returns the current token number.
+*/
+
+extern "C" unsigned int mcLexBuf_getTokenNo (void)
+{
+ if (nextTokNo == 0)
+ {
+ return 0;
+ }
+ else
+ {
+ return nextTokNo-1;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ tokenToLineNo - returns the line number of the current file for the
+ tokenNo. The depth refers to the include depth.
+ A depth of 0 is the current file, depth of 1 is the file
+ which included the current file. Zero is returned if the
+ depth exceeds the file nesting level.
+*/
+
+extern "C" unsigned int mcLexBuf_tokenToLineNo (unsigned int tokenNo, unsigned int depth)
+{
+ mcLexBuf_tokenBucket b;
+ mcLexBuf_sourceList l;
+
+ b = findtokenBucket (&tokenNo);
+ if (b == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ if (depth == 0)
+ {
+ return b->buf.array[tokenNo].line;
+ }
+ else
+ {
+ l = b->buf.array[tokenNo].file->left;
+ while (depth > 0)
+ {
+ l = l->left;
+ if (l == b->buf.array[tokenNo].file->left)
+ {
+ return 0;
+ }
+ depth -= 1;
+ }
+ return l->line;
+ }
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getColumnNo - returns the current column where the symbol occurs in
+ the source file.
+*/
+
+extern "C" unsigned int mcLexBuf_getColumnNo (void)
+{
+ if (nextTokNo == 0)
+ {
+ return 0;
+ }
+ else
+ {
+ return mcLexBuf_tokenToColumnNo (mcLexBuf_getTokenNo (), 0);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ tokenToColumnNo - returns the column number of the current file for the
+ tokenNo. The depth refers to the include depth.
+ A depth of 0 is the current file, depth of 1 is the file
+ which included the current file. Zero is returned if the
+ depth exceeds the file nesting level.
+*/
+
+extern "C" unsigned int mcLexBuf_tokenToColumnNo (unsigned int tokenNo, unsigned int depth)
+{
+ mcLexBuf_tokenBucket b;
+ mcLexBuf_sourceList l;
+
+ b = findtokenBucket (&tokenNo);
+ if (b == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ if (depth == 0)
+ {
+ return b->buf.array[tokenNo].col;
+ }
+ else
+ {
+ l = b->buf.array[tokenNo].file->left;
+ while (depth > 0)
+ {
+ l = l->left;
+ if (l == b->buf.array[tokenNo].file->left)
+ {
+ return 0;
+ }
+ depth -= 1;
+ }
+ return l->col;
+ }
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ findFileNameFromToken - returns the complete FileName for the appropriate
+ source file yields the token number, tokenNo.
+ The, Depth, indicates the include level: 0..n
+ Level 0 is the current. NIL is returned if n+1
+ is requested.
+*/
+
+extern "C" DynamicStrings_String mcLexBuf_findFileNameFromToken (unsigned int tokenNo, unsigned int depth)
+{
+ mcLexBuf_tokenBucket b;
+ mcLexBuf_sourceList l;
+
+ b = findtokenBucket (&tokenNo);
+ if (b == NULL)
+ {
+ return static_cast<DynamicStrings_String> (NULL);
+ }
+ else
+ {
+ l = b->buf.array[tokenNo].file->left;
+ while (depth > 0)
+ {
+ l = l->left;
+ if (l == b->buf.array[tokenNo].file->left)
+ {
+ return static_cast<DynamicStrings_String> (NULL);
+ }
+ depth -= 1;
+ }
+ return l->name;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getFileName - returns a String defining the current file.
+*/
+
+extern "C" DynamicStrings_String mcLexBuf_getFileName (void)
+{
+ return mcLexBuf_findFileNameFromToken (mcLexBuf_getTokenNo (), 0);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addTok - adds a token to the buffer.
+*/
+
+extern "C" void mcLexBuf_addTok (mcReserved_toktype t)
+{
+ if (! ((t == mcReserved_eoftok) && (isLastTokenEof ())))
+ {
+ addTokToList (t, nameKey_NulName, 0, static_cast<mcComment_commentDesc> (NULL), mcflex_getLineNo (), mcflex_getColumnNo (), currentSource);
+ currentUsed = TRUE;
+ }
+}
+
+
+/*
+ addTokCharStar - adds a token to the buffer and an additional string, s.
+ A copy of string, s, is made.
+*/
+
+extern "C" void mcLexBuf_addTokCharStar (mcReserved_toktype t, void * s)
+{
+ if ((libc_strlen (s)) > 80)
+ {
+ stop ();
+ }
+ addTokToList (t, nameKey_makekey (s), 0, static_cast<mcComment_commentDesc> (NULL), mcflex_getLineNo (), mcflex_getColumnNo (), currentSource);
+ currentUsed = TRUE;
+}
+
+
+/*
+ addTokInteger - adds a token and an integer to the buffer.
+*/
+
+extern "C" void mcLexBuf_addTokInteger (mcReserved_toktype t, int i)
+{
+ DynamicStrings_String s;
+ unsigned int c;
+ unsigned int l;
+
+ l = mcflex_getLineNo ();
+ c = mcflex_getColumnNo ();
+ s = FormatStrings_Sprintf1 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "%d", 2)), (const unsigned char *) &i, (sizeof (i)-1));
+ addTokToList (t, nameKey_makekey (DynamicStrings_string (s)), i, static_cast<mcComment_commentDesc> (NULL), l, c, currentSource);
+ s = DynamicStrings_KillString (s);
+ currentUsed = TRUE;
+}
+
+
+/*
+ addTokComment - adds a token to the buffer and a comment descriptor, com.
+*/
+
+extern "C" void mcLexBuf_addTokComment (mcReserved_toktype t, mcComment_commentDesc com)
+{
+ addTokToList (t, nameKey_NulName, 0, com, mcflex_getLineNo (), mcflex_getColumnNo (), currentSource);
+ currentUsed = TRUE;
+}
+
+
+/*
+ setFile - sets the current filename to, filename.
+*/
+
+extern "C" void mcLexBuf_setFile (void * filename)
+{
+ killList ();
+ currentUsed = FALSE;
+ currentSource = newList ();
+ addTo (newElement (filename));
+}
+
+
+/*
+ pushFile - indicates that, filename, has just been included.
+*/
+
+extern "C" void mcLexBuf_pushFile (void * filename)
+{
+ mcLexBuf_sourceList l;
+
+ checkIfNeedToDuplicate ();
+ addTo (newElement (filename));
+ if (Debugging)
+ {
+ if (currentSource->right != currentSource)
+ {
+ l = currentSource;
+ do {
+ mcPrintf_printf3 ((const char *) "name = %s, line = %d, col = %d\\n", 32, (const unsigned char *) &l->name, (sizeof (l->name)-1), (const unsigned char *) &l->line, (sizeof (l->line)-1), (const unsigned char *) &l->col, (sizeof (l->col)-1));
+ l = l->right;
+ } while (! (l == currentSource));
+ }
+ }
+}
+
+
+/*
+ popFile - indicates that we are returning to, filename, having finished
+ an include.
+*/
+
+extern "C" void mcLexBuf_popFile (void * filename)
+{
+ mcLexBuf_sourceList l;
+
+ checkIfNeedToDuplicate ();
+ if ((currentSource != NULL) && (currentSource->left != currentSource))
+ {
+ /* avoid dangling else. */
+ l = currentSource->left; /* last element */
+ subFrom (l); /* last element */
+ Storage_DEALLOCATE ((void **) &l, sizeof (mcLexBuf__T1));
+ if ((currentSource->left != currentSource) && (! (DynamicStrings_Equal (currentSource->name, DynamicStrings_Mark (DynamicStrings_InitStringCharStar (filename))))))
+ {} /* empty. */
+ /* mismatch in source file names after preprocessing files */
+ }
+ /* source file list is empty, cannot pop an include.. */
+}
+
+extern "C" void _M2_mcLexBuf_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ init ();
+}
+
+extern "C" void _M2_mcLexBuf_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcMetaError. */
+/* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcMetaError_H
+#define _mcMetaError_C
+
+# include "GnameKey.h"
+# include "GStrLib.h"
+# include "GmcLexBuf.h"
+# include "GmcError.h"
+# include "GFIO.h"
+# include "GSFIO.h"
+# include "GStringConvert.h"
+# include "Gvarargs.h"
+# include "GDynamicStrings.h"
+# include "Gdecl.h"
+
+typedef enum {mcMetaError_newerror, mcMetaError_newwarning, mcMetaError_chained} mcMetaError_errorType;
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaError1 (const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high);
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaError2 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaError3 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaError4 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrors1 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrors2 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrors3 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrors4 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorT1 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high);
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorT2 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorT3 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorT4 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorsT1 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorsT2 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorsT3 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorsT4 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorString1 (DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorString2 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorString3 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorString4 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorStringT1 (unsigned int tok, DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high);
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorStringT2 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high);
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorStringT3 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high);
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorStringT4 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high);
+
+/*
+ internalFormat - produces an informative internal error.
+*/
+
+static void internalFormat (DynamicStrings_String s, int i, const char *m_, unsigned int _m_high);
+
+/*
+ x - checks to see that a=b.
+*/
+
+static DynamicStrings_String x (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ isWhite - returns TRUE if, ch, is a space.
+*/
+
+static unsigned int isWhite (char ch);
+
+/*
+ then := [ ':' ebnf ] =:
+*/
+
+static void then (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, DynamicStrings_String o, unsigned int positive);
+
+/*
+ doNumber -
+*/
+
+static DynamicStrings_String doNumber (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes);
+
+/*
+ doCount -
+*/
+
+static DynamicStrings_String doCount (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes);
+
+/*
+ doCount -
+*/
+
+static DynamicStrings_String doAscii (unsigned int bol, varargs_vararg sym, DynamicStrings_String o);
+
+/*
+ doCount -
+*/
+
+static DynamicStrings_String doName (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes);
+
+/*
+ doCount -
+*/
+
+static DynamicStrings_String doQualified (unsigned int bol, varargs_vararg sym, DynamicStrings_String o);
+
+/*
+ doType - returns a string containing the type name of
+ sym. It will skip pseudonym types. It also
+ returns the type symbol found.
+*/
+
+static DynamicStrings_String doType (unsigned int bol, varargs_vararg *sym, DynamicStrings_String o);
+
+/*
+ doSkipType - will skip all pseudonym types. It also
+ returns the type symbol found and name.
+*/
+
+static DynamicStrings_String doSkipType (unsigned int bol, varargs_vararg *sym, DynamicStrings_String o);
+
+/*
+ doSkipType - will skip all pseudonym types. It also
+ returns the type symbol found and name.
+*/
+
+static DynamicStrings_String doKey (unsigned int bol, varargs_vararg sym, DynamicStrings_String o);
+
+/*
+ doError - creates and returns an error note.
+*/
+
+static mcError_error doError (mcError_error e, mcMetaError_errorType t, unsigned int tok);
+
+/*
+ doDeclaredDef - creates an error note where sym[bol] was declared.
+*/
+
+static mcError_error doDeclaredDef (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym);
+
+/*
+ doDeclaredMod - creates an error note where sym[bol] was declared.
+*/
+
+static mcError_error doDeclaredMod (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym);
+
+/*
+ doUsed - creates an error note where sym[bol] was first used.
+*/
+
+static mcError_error doUsed (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym);
+
+/*
+ ConCatWord - joins sentances, a, b, together.
+*/
+
+static DynamicStrings_String ConCatWord (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ symDesc -
+*/
+
+static DynamicStrings_String symDesc (decl_node n, DynamicStrings_String o);
+
+/*
+ doDesc -
+*/
+
+static DynamicStrings_String doDesc (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes);
+
+/*
+ addQuoted - if, o, is not empty then add it to, r.
+*/
+
+static DynamicStrings_String addQuoted (DynamicStrings_String r, DynamicStrings_String o, unsigned int quotes);
+
+/*
+ op := {'a'|'q'|'t'|'d'|'k'|'n'|'s'|'D'|'I'|'U'|'E'|'W'} then =:
+*/
+
+static void op (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, unsigned int bol, unsigned int positive);
+
+/*
+ percenttoken := '%' (
+ '1' % doOperand(1) %
+ op
+ | '2' % doOperand(2) %
+ op
+ | '3' % doOperand(3) %
+ op
+ | '4' % doOperand(4) %
+ op
+ )
+ } =:
+*/
+
+static void percenttoken (mcError_error *e, mcMetaError_errorType t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, unsigned int positive);
+
+/*
+ percent := '%' anych % copy anych %
+ =:
+*/
+
+static void percent (DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l);
+
+/*
+ lbra := '{' [ '!' ] percenttoken '}' =:
+*/
+
+static void lbra (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l);
+
+/*
+ lbra := '{' [ '!' ] percenttoken '}' =:
+*/
+
+static void stop (void);
+
+/*
+ ebnf := { percent
+ | lbra
+ | any % copy ch %
+ }
+ =:
+*/
+
+static void ebnf (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l);
+
+/*
+ doFormat -
+*/
+
+static DynamicStrings_String doFormat (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String s, varargs_vararg sym);
+
+/*
+ wrapErrors -
+*/
+
+static void wrapErrors (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, varargs_vararg sym);
+
+
+/*
+ internalFormat - produces an informative internal error.
+*/
+
+static void internalFormat (DynamicStrings_String s, int i, const char *m_, unsigned int _m_high)
+{
+ mcError_error e;
+ char m[_m_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m, m_, _m_high+1);
+
+ e = mcError_newError (mcLexBuf_getTokenNo ());
+ s = SFIO_WriteS (FIO_StdOut, s);
+ FIO_WriteLine (FIO_StdOut);
+ s = DynamicStrings_KillString (s);
+ if (i > 0)
+ {
+ i -= 1;
+ }
+ s = DynamicStrings_Mult (DynamicStrings_InitString ((const char *) " ", 1), static_cast<unsigned int> (i));
+ s = DynamicStrings_ConCatChar (s, '^');
+ s = SFIO_WriteS (FIO_StdOut, s);
+ FIO_WriteLine (FIO_StdOut);
+ mcError_internalError ((const char *) m, _m_high, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 97);
+}
+
+
+/*
+ x - checks to see that a=b.
+*/
+
+static DynamicStrings_String x (DynamicStrings_String a, DynamicStrings_String b)
+{
+ if (a != b)
+ {
+ mcError_internalError ((const char *) "different string returned", 25, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 109);
+ }
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isWhite - returns TRUE if, ch, is a space.
+*/
+
+static unsigned int isWhite (char ch)
+{
+ return ch == ' ';
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ then := [ ':' ebnf ] =:
+*/
+
+static void then (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, DynamicStrings_String o, unsigned int positive)
+{
+ if ((DynamicStrings_char (s, (*i))) == ':')
+ {
+ (*i) += 1;
+ ebnf (e, t, r, s, sym, i, l);
+ if (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}'))
+ {
+ internalFormat (s, (*i), (const char *) "expecting to see }", 18);
+ }
+ }
+}
+
+
+/*
+ doNumber -
+*/
+
+static DynamicStrings_String doNumber (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes)
+{
+ unsigned int c;
+
+ if ((DynamicStrings_Length (o)) > 0)
+ {
+ return o;
+ }
+ else
+ {
+ (*quotes) = FALSE;
+ varargs_next (sym, bol);
+ varargs_arg (sym, (unsigned char *) &c, (sizeof (c)-1));
+ return DynamicStrings_ConCat (o, StringConvert_ctos (c, 0, ' '));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doCount -
+*/
+
+static DynamicStrings_String doCount (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes)
+{
+ unsigned int c;
+
+ if ((DynamicStrings_Length (o)) > 0)
+ {
+ return o;
+ }
+ else
+ {
+ (*quotes) = FALSE;
+ varargs_next (sym, bol);
+ varargs_arg (sym, (unsigned char *) &c, (sizeof (c)-1));
+ o = DynamicStrings_ConCat (o, StringConvert_ctos (c, 0, ' '));
+ if (((c % 100) >= 11) && ((c % 100) <= 13))
+ {
+ o = DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "th", 2)));
+ }
+
+ else {
+ switch (c % 10)
+ {
+ case 1:
+ o = DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "st", 2)));
+ break;
+
+ case 2:
+ o = DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "nd", 2)));
+ break;
+
+ case 3:
+ o = DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "rd", 2)));
+ break;
+
+
+ default:
+ o = DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "th", 2)));
+ break;
+ }
+ }
+ return o;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doCount -
+*/
+
+static DynamicStrings_String doAscii (unsigned int bol, varargs_vararg sym, DynamicStrings_String o)
+{
+ decl_node n;
+
+ varargs_next (sym, bol);
+ varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1));
+ if (((DynamicStrings_Length (o)) > 0) || (decl_isTemporary (n)))
+ {
+ return o;
+ }
+ else
+ {
+ return DynamicStrings_ConCat (o, DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doCount -
+*/
+
+static DynamicStrings_String doName (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes)
+{
+ decl_node n;
+
+ varargs_next (sym, bol);
+ varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1));
+ if (((DynamicStrings_Length (o)) > 0) || (decl_isTemporary (n)))
+ {
+ return o;
+ }
+ else
+ {
+ if (decl_isZtype (n))
+ {
+ (*quotes) = FALSE;
+ return DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "the ZType", 9)));
+ }
+ else if (decl_isRtype (n))
+ {
+ /* avoid dangling else. */
+ (*quotes) = FALSE;
+ return DynamicStrings_ConCat (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "the RType", 9)));
+ }
+ else if ((decl_getSymName (n)) != nameKey_NulName)
+ {
+ /* avoid dangling else. */
+ return DynamicStrings_ConCat (o, DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return o;
+ }
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doCount -
+*/
+
+static DynamicStrings_String doQualified (unsigned int bol, varargs_vararg sym, DynamicStrings_String o)
+{
+ decl_node s;
+ decl_node n;
+ varargs_vararg mod;
+
+ varargs_next (sym, bol);
+ varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1));
+ if (((DynamicStrings_Length (o)) > 0) || (decl_isTemporary (n)))
+ {
+ return o;
+ }
+ else
+ {
+ s = decl_getScope (n);
+ mod = varargs_start1 ((const unsigned char *) &s, (sizeof (s)-1));
+ if ((decl_isDef (s)) && (decl_isExported (n)))
+ {
+ o = x (o, doAscii (0, mod, o));
+ o = x (o, DynamicStrings_ConCatChar (o, '.'));
+ o = x (o, DynamicStrings_ConCat (o, DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (decl_getSymName (n)))));
+ }
+ else
+ {
+ o = x (o, doAscii (bol, sym, o));
+ }
+ varargs_end (&mod);
+ return o;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doType - returns a string containing the type name of
+ sym. It will skip pseudonym types. It also
+ returns the type symbol found.
+*/
+
+static DynamicStrings_String doType (unsigned int bol, varargs_vararg *sym, DynamicStrings_String o)
+{
+ decl_node n;
+
+ varargs_next ((*sym), bol);
+ varargs_arg ((*sym), (unsigned char *) &n, (sizeof (n)-1));
+ if (((DynamicStrings_Length (o)) > 0) || ((decl_getType (n)) == NULL))
+ {
+ return o;
+ }
+ else
+ {
+ n = decl_skipType (decl_getType (n));
+ varargs_next ((*sym), bol);
+ varargs_replace ((*sym), (unsigned char *) &n, (sizeof (n)-1));
+ return x (o, doAscii (bol, (*sym), o));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doSkipType - will skip all pseudonym types. It also
+ returns the type symbol found and name.
+*/
+
+static DynamicStrings_String doSkipType (unsigned int bol, varargs_vararg *sym, DynamicStrings_String o)
+{
+ decl_node n;
+
+ varargs_next ((*sym), bol);
+ varargs_arg ((*sym), (unsigned char *) &n, (sizeof (n)-1));
+ if ((DynamicStrings_Length (o)) > 0)
+ {
+ return o;
+ }
+ else
+ {
+ n = decl_skipType (decl_getType (n));
+ varargs_next ((*sym), bol);
+ varargs_replace ((*sym), (unsigned char *) &n, (sizeof (n)-1));
+ if ((decl_getSymName (n)) == nameKey_NulName)
+ {
+ return o;
+ }
+ else
+ {
+ return x (o, doAscii (bol, (*sym), o));
+ }
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doSkipType - will skip all pseudonym types. It also
+ returns the type symbol found and name.
+*/
+
+static DynamicStrings_String doKey (unsigned int bol, varargs_vararg sym, DynamicStrings_String o)
+{
+ nameKey_Name n;
+
+ if ((DynamicStrings_Length (o)) > 0)
+ {
+ return o;
+ }
+ else
+ {
+ varargs_next (sym, bol);
+ varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1));
+ return DynamicStrings_ConCat (o, DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doError - creates and returns an error note.
+*/
+
+static mcError_error doError (mcError_error e, mcMetaError_errorType t, unsigned int tok)
+{
+ switch (t)
+ {
+ case mcMetaError_chained:
+ if (e == NULL)
+ {
+ mcError_internalError ((const char *) "should not be chaining an error onto an empty error note", 56, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 355);
+ }
+ else
+ {
+ e = mcError_chainError (tok, e);
+ }
+ break;
+
+ case mcMetaError_newerror:
+ if (e == NULL)
+ {
+ e = mcError_newError (tok);
+ }
+ break;
+
+ case mcMetaError_newwarning:
+ if (e == NULL)
+ {
+ e = mcError_newWarning (tok);
+ }
+ break;
+
+
+ default:
+ mcError_internalError ((const char *) "unexpected enumeration value", 28, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 369);
+ break;
+ }
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doDeclaredDef - creates an error note where sym[bol] was declared.
+*/
+
+static mcError_error doDeclaredDef (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym)
+{
+ decl_node n;
+
+ if (bol <= (varargs_nargs (sym)))
+ {
+ varargs_next (sym, bol);
+ varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1));
+ e = doError (e, t, decl_getDeclaredDef (n));
+ }
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doDeclaredMod - creates an error note where sym[bol] was declared.
+*/
+
+static mcError_error doDeclaredMod (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym)
+{
+ decl_node n;
+
+ if (bol <= (varargs_nargs (sym)))
+ {
+ varargs_next (sym, bol);
+ varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1));
+ e = doError (e, t, decl_getDeclaredMod (n));
+ }
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doUsed - creates an error note where sym[bol] was first used.
+*/
+
+static mcError_error doUsed (mcError_error e, mcMetaError_errorType t, unsigned int bol, varargs_vararg sym)
+{
+ decl_node n;
+
+ if (bol <= (varargs_nargs (sym)))
+ {
+ varargs_next (sym, bol);
+ varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1));
+ e = doError (e, t, decl_getFirstUsed (n));
+ }
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConCatWord - joins sentances, a, b, together.
+*/
+
+static DynamicStrings_String ConCatWord (DynamicStrings_String a, DynamicStrings_String b)
+{
+ if (((DynamicStrings_Length (a)) == 1) && ((DynamicStrings_char (a, 0)) == 'a'))
+ {
+ a = x (a, DynamicStrings_ConCatChar (a, 'n'));
+ }
+ else if ((((DynamicStrings_Length (a)) > 1) && ((DynamicStrings_char (a, -1)) == 'a')) && (isWhite (DynamicStrings_char (a, -2))))
+ {
+ /* avoid dangling else. */
+ a = x (a, DynamicStrings_ConCatChar (a, 'n'));
+ }
+ if (((DynamicStrings_Length (a)) > 0) && (! (isWhite (DynamicStrings_char (a, -1)))))
+ {
+ a = x (a, DynamicStrings_ConCatChar (a, ' '));
+ }
+ return x (a, DynamicStrings_ConCat (a, b));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ symDesc -
+*/
+
+static DynamicStrings_String symDesc (decl_node n, DynamicStrings_String o)
+{
+ if (decl_isLiteral (n))
+ {
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "literal", 7)));
+ }
+ else if (decl_isConstSet (n))
+ {
+ /* avoid dangling else. */
+ /*
+ ELSIF IsConstructor(n)
+ THEN
+ RETURN( ConCatWord (o, Mark (InitString ('constructor'))) )
+ */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "constant set", 12)));
+ }
+ else if (decl_isConst (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "constant", 8)));
+ }
+ else if (decl_isArray (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "array", 5)));
+ }
+ else if (decl_isVar (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "variable", 8)));
+ }
+ else if (decl_isEnumeration (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "enumeration type", 16)));
+ }
+ else if (decl_isEnumerationField (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "enumeration field", 17)));
+ }
+ else if (decl_isUnbounded (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "unbounded parameter", 19)));
+ }
+ else if (decl_isProcType (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "procedure type", 14)));
+ }
+ else if (decl_isProcedure (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "procedure", 9)));
+ }
+ else if (decl_isPointer (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "pointer", 7)));
+ }
+ else if (decl_isParameter (n))
+ {
+ /* avoid dangling else. */
+ if (decl_isVarParam (n))
+ {
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "var parameter", 13)));
+ }
+ else
+ {
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "parameter", 9)));
+ }
+ }
+ else if (decl_isType (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "type", 4)));
+ }
+ else if (decl_isRecord (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "record", 6)));
+ }
+ else if (decl_isRecordField (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "record field", 12)));
+ }
+ else if (decl_isVarient (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "varient record", 14)));
+ }
+ else if (decl_isModule (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "module", 6)));
+ }
+ else if (decl_isDef (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "definition module", 17)));
+ }
+ else if (decl_isImp (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "implementation module", 21)));
+ }
+ else if (decl_isSet (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "set", 3)));
+ }
+ else if (decl_isSubrange (n))
+ {
+ /* avoid dangling else. */
+ return ConCatWord (o, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "subrange", 8)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return o;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doDesc -
+*/
+
+static DynamicStrings_String doDesc (unsigned int bol, varargs_vararg sym, DynamicStrings_String o, unsigned int *quotes)
+{
+ decl_node n;
+
+ if ((DynamicStrings_Length (o)) == 0)
+ {
+ varargs_next (sym, bol);
+ varargs_arg (sym, (unsigned char *) &n, (sizeof (n)-1));
+ o = symDesc (n, o);
+ if ((DynamicStrings_Length (o)) > 0)
+ {
+ (*quotes) = FALSE;
+ }
+ }
+ return o;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addQuoted - if, o, is not empty then add it to, r.
+*/
+
+static DynamicStrings_String addQuoted (DynamicStrings_String r, DynamicStrings_String o, unsigned int quotes)
+{
+ if ((DynamicStrings_Length (o)) > 0)
+ {
+ if (! (isWhite (DynamicStrings_char (r, -1))))
+ {
+ r = x (r, DynamicStrings_ConCatChar (r, ' '));
+ }
+ if (quotes)
+ {
+ r = x (r, DynamicStrings_ConCatChar (r, '\''));
+ }
+ r = x (r, DynamicStrings_ConCat (r, o));
+ if (quotes)
+ {
+ r = x (r, DynamicStrings_ConCatChar (r, '\''));
+ }
+ }
+ return r;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ op := {'a'|'q'|'t'|'d'|'k'|'n'|'s'|'D'|'I'|'U'|'E'|'W'} then =:
+*/
+
+static void op (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, unsigned int bol, unsigned int positive)
+{
+ DynamicStrings_String o;
+ varargs_vararg c;
+ unsigned int quotes;
+
+ c = varargs_copy (sym);
+ o = DynamicStrings_InitString ((const char *) "", 0);
+ quotes = TRUE;
+ while (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}'))
+ {
+ switch (DynamicStrings_char (s, (*i)))
+ {
+ case 'a':
+ o = x (o, doName (bol, sym, o, "es));
+ break;
+
+ case 'q':
+ o = x (o, doQualified (bol, sym, o));
+ break;
+
+ case 't':
+ o = x (o, doType (bol, &sym, o));
+ break;
+
+ case 'd':
+ o = x (o, doDesc (bol, sym, o, "es));
+ break;
+
+ case 'n':
+ o = x (o, doNumber (bol, sym, o, "es));
+ break;
+
+ case 'N':
+ o = x (o, doCount (bol, sym, o, "es));
+ break;
+
+ case 's':
+ o = x (o, doSkipType (bol, &sym, o));
+ break;
+
+ case 'k':
+ o = x (o, doKey (bol, sym, o));
+ break;
+
+ case 'D':
+ (*e) = doDeclaredDef ((*e), (*t), bol, sym);
+ break;
+
+ case 'M':
+ (*e) = doDeclaredMod ((*e), (*t), bol, sym);
+ break;
+
+ case 'U':
+ (*e) = doUsed ((*e), (*t), bol, sym);
+ break;
+
+ case 'E':
+ (*t) = mcMetaError_newerror;
+ break;
+
+ case 'W':
+ (*t) = mcMetaError_newwarning;
+ break;
+
+ case ':':
+ varargs_end (&sym);
+ sym = varargs_copy (c);
+ then (e, t, r, s, sym, i, l, o, positive);
+ o = DynamicStrings_KillString (o);
+ o = DynamicStrings_InitString ((const char *) "", 0);
+ if (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}'))
+ {
+ internalFormat (s, (*i), (const char *) "expecting to see }", 18);
+ }
+ (*i) -= 1;
+ break;
+
+
+ default:
+ internalFormat (s, (*i), (const char *) "expecting one of [aqtdnNsDUEW:]", 31);
+ break;
+ }
+ (*i) += 1;
+ }
+ (*r) = x ((*r), addQuoted ((*r), o, quotes));
+ o = DynamicStrings_KillString (o);
+}
+
+
+/*
+ percenttoken := '%' (
+ '1' % doOperand(1) %
+ op
+ | '2' % doOperand(2) %
+ op
+ | '3' % doOperand(3) %
+ op
+ | '4' % doOperand(4) %
+ op
+ )
+ } =:
+*/
+
+static void percenttoken (mcError_error *e, mcMetaError_errorType t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l, unsigned int positive)
+{
+ if ((DynamicStrings_char (s, (*i))) == '%')
+ {
+ (*i) += 1;
+ switch (DynamicStrings_char (s, (*i)))
+ {
+ case '1':
+ (*i) += 1;
+ op (e, &t, r, s, sym, i, l, 0, positive);
+ break;
+
+ case '2':
+ (*i) += 1;
+ op (e, &t, r, s, sym, i, l, 1, positive);
+ break;
+
+ case '3':
+ (*i) += 1;
+ op (e, &t, r, s, sym, i, l, 2, positive);
+ break;
+
+ case '4':
+ (*i) += 1;
+ op (e, &t, r, s, sym, i, l, 3, positive);
+ break;
+
+
+ default:
+ internalFormat (s, (*i), (const char *) "expecting one of [123]", 22);
+ break;
+ }
+ if (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}'))
+ {
+ internalFormat (s, (*i), (const char *) "expecting to see }", 18);
+ }
+ }
+}
+
+
+/*
+ percent := '%' anych % copy anych %
+ =:
+*/
+
+static void percent (DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l)
+{
+ if ((DynamicStrings_char (s, (*i))) == '%')
+ {
+ (*i) += 1;
+ if ((*i) < l)
+ {
+ (*r) = x ((*r), DynamicStrings_ConCatChar ((*r), DynamicStrings_char (s, (*i))));
+ (*i) += 1;
+ }
+ }
+}
+
+
+/*
+ lbra := '{' [ '!' ] percenttoken '}' =:
+*/
+
+static void lbra (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l)
+{
+ unsigned int positive;
+
+ if ((DynamicStrings_char (s, (*i))) == '{')
+ {
+ positive = TRUE;
+ (*i) += 1;
+ if ((DynamicStrings_char (s, (*i))) == '!')
+ {
+ positive = FALSE;
+ (*i) += 1;
+ }
+ if ((DynamicStrings_char (s, (*i))) != '%')
+ {
+ internalFormat (s, (*i), (const char *) "expecting to see %", 18);
+ }
+ percenttoken (e, (*t), r, s, sym, i, l, positive);
+ if (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}'))
+ {
+ internalFormat (s, (*i), (const char *) "expecting to see }", 18);
+ }
+ }
+}
+
+
+/*
+ lbra := '{' [ '!' ] percenttoken '}' =:
+*/
+
+static void stop (void)
+{
+}
+
+
+/*
+ ebnf := { percent
+ | lbra
+ | any % copy ch %
+ }
+ =:
+*/
+
+static void ebnf (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String *r, DynamicStrings_String s, varargs_vararg sym, int *i, int l)
+{
+ while ((*i) < l)
+ {
+ switch (DynamicStrings_char (s, (*i)))
+ {
+ case '%':
+ percent (r, s, sym, i, l);
+ break;
+
+ case '{':
+ lbra (e, t, r, s, sym, i, l);
+ if (((*i) < l) && ((DynamicStrings_char (s, (*i))) != '}'))
+ {
+ internalFormat (s, (*i), (const char *) "expecting to see }", 18);
+ }
+ break;
+
+ case '}':
+ return ;
+ break;
+
+
+ default:
+ if ((((isWhite (DynamicStrings_char (s, (*i)))) && ((DynamicStrings_Length ((*r))) > 0)) && (! (isWhite (DynamicStrings_char ((*r), -1))))) || (! (isWhite (DynamicStrings_char (s, (*i))))))
+ {
+ (*r) = x ((*r), DynamicStrings_ConCatChar ((*r), DynamicStrings_char (s, (*i))));
+ }
+ break;
+ }
+ (*i) += 1;
+ }
+}
+
+
+/*
+ doFormat -
+*/
+
+static DynamicStrings_String doFormat (mcError_error *e, mcMetaError_errorType *t, DynamicStrings_String s, varargs_vararg sym)
+{
+ DynamicStrings_String r;
+ int i;
+ int l;
+
+ r = DynamicStrings_InitString ((const char *) "", 0);
+ i = 0;
+ l = DynamicStrings_Length (s);
+ ebnf (e, t, &r, s, sym, &i, l);
+ s = DynamicStrings_KillString (s);
+ return r;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ wrapErrors -
+*/
+
+static void wrapErrors (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, varargs_vararg sym)
+{
+ mcError_error e;
+ mcError_error f;
+ DynamicStrings_String str;
+ mcMetaError_errorType t;
+ char m1[_m1_high+1];
+ char m2[_m2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m1, m1_, _m1_high+1);
+ memcpy (m2, m2_, _m2_high+1);
+
+ e = static_cast<mcError_error> (NULL);
+ t = mcMetaError_newerror;
+ str = doFormat (&e, &t, DynamicStrings_InitString ((const char *) m1, _m1_high), sym);
+ e = doError (e, t, tok);
+ mcError_errorString (e, str);
+ f = e;
+ t = mcMetaError_chained;
+ str = doFormat (&f, &t, DynamicStrings_InitString ((const char *) m2, _m2_high), sym);
+ if (e == f)
+ {
+ t = mcMetaError_chained;
+ f = doError (e, t, tok);
+ }
+ mcError_errorString (f, str);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaError1 (const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high)
+{
+ char m[_m_high+1];
+ unsigned char s[_s_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m, m_, _m_high+1);
+ memcpy (s, s_, _s_high+1);
+
+ mcMetaError_metaErrorT1 (mcLexBuf_getTokenNo (), (const char *) m, _m_high, (const unsigned char *) s, _s_high);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaError2 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high)
+{
+ char m[_m_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m, m_, _m_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+
+ mcMetaError_metaErrorT2 (mcLexBuf_getTokenNo (), (const char *) m, _m_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaError3 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high)
+{
+ char m[_m_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m, m_, _m_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+
+ mcMetaError_metaErrorT3 (mcLexBuf_getTokenNo (), (const char *) m, _m_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaError4 (const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high)
+{
+ char m[_m_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+ unsigned char s4[_s4_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m, m_, _m_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+ memcpy (s4, s4_, _s4_high+1);
+
+ mcMetaError_metaErrorT4 (mcLexBuf_getTokenNo (), (const char *) m, _m_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrors1 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high)
+{
+ char m1[_m1_high+1];
+ char m2[_m2_high+1];
+ unsigned char s[_s_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m1, m1_, _m1_high+1);
+ memcpy (m2, m2_, _m2_high+1);
+ memcpy (s, s_, _s_high+1);
+
+ mcMetaError_metaErrorsT1 (mcLexBuf_getTokenNo (), (const char *) m1, _m1_high, (const char *) m2, _m2_high, (const unsigned char *) s, _s_high);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrors2 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high)
+{
+ char m1[_m1_high+1];
+ char m2[_m2_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m1, m1_, _m1_high+1);
+ memcpy (m2, m2_, _m2_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+
+ mcMetaError_metaErrorsT2 (mcLexBuf_getTokenNo (), (const char *) m1, _m1_high, (const char *) m2, _m2_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrors3 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high)
+{
+ char m1[_m1_high+1];
+ char m2[_m2_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m1, m1_, _m1_high+1);
+ memcpy (m2, m2_, _m2_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+
+ mcMetaError_metaErrorsT3 (mcLexBuf_getTokenNo (), (const char *) m1, _m1_high, (const char *) m2, _m2_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrors4 (const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high)
+{
+ char m1[_m1_high+1];
+ char m2[_m2_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+ unsigned char s4[_s4_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m1, m1_, _m1_high+1);
+ memcpy (m2, m2_, _m2_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+ memcpy (s4, s4_, _s4_high+1);
+
+ mcMetaError_metaErrorsT4 (mcLexBuf_getTokenNo (), (const char *) m1, _m1_high, (const char *) m2, _m2_high, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorT1 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s_, unsigned int _s_high)
+{
+ char m[_m_high+1];
+ unsigned char s[_s_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m, m_, _m_high+1);
+ memcpy (s, s_, _s_high+1);
+
+ mcMetaError_metaErrorStringT1 (tok, DynamicStrings_InitString ((const char *) m, _m_high), (const unsigned char *) s, _s_high);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorT2 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high)
+{
+ char m[_m_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m, m_, _m_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+
+ mcMetaError_metaErrorStringT2 (tok, DynamicStrings_InitString ((const char *) m, _m_high), (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorT3 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high)
+{
+ char m[_m_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m, m_, _m_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+
+ mcMetaError_metaErrorStringT3 (tok, DynamicStrings_InitString ((const char *) m, _m_high), (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorT4 (unsigned int tok, const char *m_, unsigned int _m_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high)
+{
+ char m[_m_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+ unsigned char s4[_s4_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m, m_, _m_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+ memcpy (s4, s4_, _s4_high+1);
+
+ mcMetaError_metaErrorStringT4 (tok, DynamicStrings_InitString ((const char *) m, _m_high), (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorsT1 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s_, unsigned int _s_high)
+{
+ varargs_vararg sym;
+ char m1[_m1_high+1];
+ char m2[_m2_high+1];
+ unsigned char s[_s_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m1, m1_, _m1_high+1);
+ memcpy (m2, m2_, _m2_high+1);
+ memcpy (s, s_, _s_high+1);
+
+ sym = varargs_start1 ((const unsigned char *) s, _s_high);
+ wrapErrors (tok, (const char *) m1, _m1_high, (const char *) m2, _m2_high, sym);
+ varargs_end (&sym);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorsT2 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high)
+{
+ varargs_vararg sym;
+ char m1[_m1_high+1];
+ char m2[_m2_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m1, m1_, _m1_high+1);
+ memcpy (m2, m2_, _m2_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+
+ sym = varargs_start2 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high);
+ wrapErrors (tok, (const char *) m1, _m1_high, (const char *) m2, _m2_high, sym);
+ varargs_end (&sym);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorsT3 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high)
+{
+ varargs_vararg sym;
+ char m1[_m1_high+1];
+ char m2[_m2_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m1, m1_, _m1_high+1);
+ memcpy (m2, m2_, _m2_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+
+ sym = varargs_start3 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high);
+ wrapErrors (tok, (const char *) m1, _m1_high, (const char *) m2, _m2_high, sym);
+ varargs_end (&sym);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorsT4 (unsigned int tok, const char *m1_, unsigned int _m1_high, const char *m2_, unsigned int _m2_high, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high)
+{
+ varargs_vararg sym;
+ char m1[_m1_high+1];
+ char m2[_m2_high+1];
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+ unsigned char s4[_s4_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (m1, m1_, _m1_high+1);
+ memcpy (m2, m2_, _m2_high+1);
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+ memcpy (s4, s4_, _s4_high+1);
+
+ sym = varargs_start4 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high);
+ wrapErrors (tok, (const char *) m1, _m1_high, (const char *) m2, _m2_high, sym);
+ varargs_end (&sym);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorString1 (DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high)
+{
+ unsigned char s[_s_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (s, s_, _s_high+1);
+
+ mcMetaError_metaErrorStringT1 (mcLexBuf_getTokenNo (), m, (const unsigned char *) s, _s_high);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorString2 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high)
+{
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+
+ mcMetaError_metaErrorStringT2 (mcLexBuf_getTokenNo (), m, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorString3 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high)
+{
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+
+ mcMetaError_metaErrorStringT3 (mcLexBuf_getTokenNo (), m, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high);
+}
+
+
+/*
+ wrapErrors -
+*/
+
+extern "C" void mcMetaError_metaErrorString4 (DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high)
+{
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+ unsigned char s4[_s4_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+ memcpy (s4, s4_, _s4_high+1);
+
+ mcMetaError_metaErrorStringT4 (mcLexBuf_getTokenNo (), m, (const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorStringT1 (unsigned int tok, DynamicStrings_String m, const unsigned char *s_, unsigned int _s_high)
+{
+ DynamicStrings_String str;
+ mcError_error e;
+ varargs_vararg sym;
+ mcMetaError_errorType t;
+ unsigned char s[_s_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (s, s_, _s_high+1);
+
+ e = static_cast<mcError_error> (NULL);
+ sym = varargs_start1 ((const unsigned char *) s, _s_high);
+ t = mcMetaError_newerror;
+ str = doFormat (&e, &t, m, sym);
+ e = doError (e, t, tok);
+ mcError_errorString (e, str);
+ varargs_end (&sym);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorStringT2 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high)
+{
+ DynamicStrings_String str;
+ mcError_error e;
+ varargs_vararg sym;
+ mcMetaError_errorType t;
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+
+ e = static_cast<mcError_error> (NULL);
+ sym = varargs_start2 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high);
+ t = mcMetaError_newerror;
+ str = doFormat (&e, &t, m, sym);
+ e = doError (e, t, tok);
+ mcError_errorString (e, str);
+ varargs_end (&sym);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorStringT3 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high)
+{
+ DynamicStrings_String str;
+ mcError_error e;
+ varargs_vararg sym;
+ mcMetaError_errorType t;
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+
+ e = static_cast<mcError_error> (NULL);
+ sym = varargs_start3 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high);
+ t = mcMetaError_newerror;
+ str = doFormat (&e, &t, m, sym);
+ e = doError (e, t, tok);
+ mcError_errorString (e, str);
+ varargs_end (&sym);
+}
+
+
+/*
+ doFormat -
+*/
+
+extern "C" void mcMetaError_metaErrorStringT4 (unsigned int tok, DynamicStrings_String m, const unsigned char *s1_, unsigned int _s1_high, const unsigned char *s2_, unsigned int _s2_high, const unsigned char *s3_, unsigned int _s3_high, const unsigned char *s4_, unsigned int _s4_high)
+{
+ DynamicStrings_String str;
+ mcError_error e;
+ varargs_vararg sym;
+ mcMetaError_errorType t;
+ unsigned char s1[_s1_high+1];
+ unsigned char s2[_s2_high+1];
+ unsigned char s3[_s3_high+1];
+ unsigned char s4[_s4_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (s1, s1_, _s1_high+1);
+ memcpy (s2, s2_, _s2_high+1);
+ memcpy (s3, s3_, _s3_high+1);
+ memcpy (s4, s4_, _s4_high+1);
+
+ e = static_cast<mcError_error> (NULL);
+ sym = varargs_start4 ((const unsigned char *) s1, _s1_high, (const unsigned char *) s2, _s2_high, (const unsigned char *) s3, _s3_high, (const unsigned char *) s4, _s4_high);
+ t = mcMetaError_newerror;
+ str = doFormat (&e, &t, m, sym);
+ e = doError (e, t, tok);
+ mcError_errorString (e, str);
+ varargs_end (&sym);
+}
+
+extern "C" void _M2_mcMetaError_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcMetaError_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcOptions. */
+/* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcOptions_H
+#define _mcOptions_C
+
+# include "GSArgs.h"
+# include "GmcSearch.h"
+# include "Glibc.h"
+# include "GmcPrintf.h"
+# include "GDebug.h"
+# include "GStrLib.h"
+# include "Gdecl.h"
+# include "GDynamicStrings.h"
+# include "GFIO.h"
+# include "GSFIO.h"
+
+static unsigned int langC;
+static unsigned int langCPP;
+static unsigned int langM2;
+static unsigned int gplHeader;
+static unsigned int glplHeader;
+static unsigned int summary;
+static unsigned int contributed;
+static unsigned int scaffoldMain;
+static unsigned int scaffoldDynamic;
+static unsigned int caseRuntime;
+static unsigned int arrayRuntime;
+static unsigned int returnRuntime;
+static unsigned int suppressNoReturn;
+static unsigned int gccConfigSystem;
+static unsigned int ignoreFQ;
+static unsigned int debugTopological;
+static unsigned int extendedOpaque;
+static unsigned int internalDebugging;
+static unsigned int verbose;
+static unsigned int quiet;
+static DynamicStrings_String projectContents;
+static DynamicStrings_String summaryContents;
+static DynamicStrings_String contributedContents;
+static DynamicStrings_String hPrefix;
+static DynamicStrings_String outputFile;
+static DynamicStrings_String cppArgs;
+static DynamicStrings_String cppProgram;
+
+/*
+ handleOptions - iterates over all options setting appropriate
+ values and returns the single source file
+ if found at the end of the arguments.
+*/
+
+extern "C" DynamicStrings_String mcOptions_handleOptions (void);
+
+/*
+ getQuiet - return the value of quiet.
+*/
+
+extern "C" unsigned int mcOptions_getQuiet (void);
+
+/*
+ getVerbose - return the value of verbose.
+*/
+
+extern "C" unsigned int mcOptions_getVerbose (void);
+
+/*
+ getInternalDebugging - return the value of internalDebugging.
+*/
+
+extern "C" unsigned int mcOptions_getInternalDebugging (void);
+
+/*
+ getCppCommandLine - returns the Cpp command line and all arguments.
+*/
+
+extern "C" DynamicStrings_String mcOptions_getCppCommandLine (void);
+
+/*
+ getOutputFile - sets the output filename to output.
+*/
+
+extern "C" DynamicStrings_String mcOptions_getOutputFile (void);
+
+/*
+ getExtendedOpaque - return the extendedOpaque value.
+*/
+
+extern "C" unsigned int mcOptions_getExtendedOpaque (void);
+
+/*
+ setDebugTopological - sets the flag debugTopological to value.
+*/
+
+extern "C" void mcOptions_setDebugTopological (unsigned int value);
+
+/*
+ getDebugTopological - returns the flag value of the command
+ line option --debug-top.
+*/
+
+extern "C" unsigned int mcOptions_getDebugTopological (void);
+
+/*
+ getHPrefix - saves the H file prefix.
+*/
+
+extern "C" DynamicStrings_String mcOptions_getHPrefix (void);
+
+/*
+ getIgnoreFQ - returns the ignorefq flag.
+*/
+
+extern "C" unsigned int mcOptions_getIgnoreFQ (void);
+
+/*
+ getGccConfigSystem - return the value of the gccConfigSystem flag.
+*/
+
+extern "C" unsigned int mcOptions_getGccConfigSystem (void);
+
+/*
+ getScaffoldDynamic - return true if the --scaffold-dynamic option was present.
+*/
+
+extern "C" unsigned int mcOptions_getScaffoldDynamic (void);
+
+/*
+ getScaffoldMain - return true if the --scaffold-main option was present.
+*/
+
+extern "C" unsigned int mcOptions_getScaffoldMain (void);
+
+/*
+ writeGPLheader - writes out the GPL or the LGPL as a comment.
+*/
+
+extern "C" void mcOptions_writeGPLheader (FIO_File f);
+
+/*
+ setSuppressNoReturn - set suppressNoReturn to value.
+*/
+
+extern "C" void mcOptions_setSuppressNoReturn (unsigned int value);
+
+/*
+ getSuppressNoReturn - return the suppressNoReturn value.
+*/
+
+extern "C" unsigned int mcOptions_getSuppressNoReturn (void);
+
+/*
+ getYear - return the year.
+*/
+
+static unsigned int getYear (void);
+
+/*
+ displayVersion - displays the version of the compiler.
+*/
+
+static void displayVersion (unsigned int mustExit);
+
+/*
+ displayHelp - display the mc help summary.
+*/
+
+static void displayHelp (void);
+
+/*
+ commentBegin - issue a start of comment for the appropriate language.
+*/
+
+static void commentBegin (FIO_File f);
+
+/*
+ commentEnd - issue an end of comment for the appropriate language.
+*/
+
+static void commentEnd (FIO_File f);
+
+/*
+ comment - write a comment to file, f, and also a newline.
+*/
+
+static void comment (FIO_File f, const char *a_, unsigned int _a_high);
+
+/*
+ commentS - write a comment to file, f, and also a newline.
+*/
+
+static void commentS (FIO_File f, DynamicStrings_String s);
+
+/*
+ gplBody -
+*/
+
+static void gplBody (FIO_File f);
+
+/*
+ glplBody -
+*/
+
+static void glplBody (FIO_File f);
+
+/*
+ issueGPL - writes out the summary, GPL/LGPL and/or contributed as a single comment.
+*/
+
+static void issueGPL (FIO_File f);
+
+/*
+ setOutputFile - sets the output filename to output.
+*/
+
+static void setOutputFile (DynamicStrings_String output);
+
+/*
+ setQuiet - sets the quiet flag to, value.
+*/
+
+static void setQuiet (unsigned int value);
+
+/*
+ setVerbose - sets the verbose flag to, value.
+*/
+
+static void setVerbose (unsigned int value);
+
+/*
+ setExtendedOpaque - set extendedOpaque to value.
+*/
+
+static void setExtendedOpaque (unsigned int value);
+
+/*
+ setSearchPath - set the search path for the module sources.
+*/
+
+static void setSearchPath (DynamicStrings_String arg);
+
+/*
+ setInternalDebugging - turn on/off internal debugging.
+*/
+
+static void setInternalDebugging (unsigned int value);
+
+/*
+ setHPrefix - saves the H file prefix.
+*/
+
+static void setHPrefix (DynamicStrings_String s);
+
+/*
+ setIgnoreFQ - sets the ignorefq flag.
+*/
+
+static void setIgnoreFQ (unsigned int value);
+
+/*
+ optionIs - returns TRUE if the first len (right) characters
+ match left.
+*/
+
+static unsigned int optionIs (const char *left_, unsigned int _left_high, DynamicStrings_String right);
+
+/*
+ setLang - set the appropriate output language.
+*/
+
+static void setLang (DynamicStrings_String arg);
+
+/*
+ handleOption -
+*/
+
+static void handleOption (DynamicStrings_String arg);
+
+
+/*
+ getYear - return the year.
+*/
+
+static unsigned int getYear (void)
+{
+ libc_time_t epoch;
+ libc_ptrToTM localTime;
+
+ epoch = libc_time (NULL);
+ localTime = static_cast<libc_ptrToTM> (libc_localtime (&epoch));
+ return localTime->tm_year+1900;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ displayVersion - displays the version of the compiler.
+*/
+
+static void displayVersion (unsigned int mustExit)
+{
+ unsigned int year;
+
+ year = getYear ();
+ /* These first three calls to printf hide the first line of text away from the year change script. */
+ mcPrintf_printf0 ((const char *) "Copyright ", 10);
+ mcPrintf_printf0 ((const char *) "(C)", 3); /* A unicode char here would be good. */
+ mcPrintf_printf1 ((const char *) " %d Free Software Foundation, Inc.\\n", 36, (const unsigned char *) &year, (sizeof (year)-1)); /* A unicode char here would be good. */
+ mcPrintf_printf0 ((const char *) "License GPLv3: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>\\n", 78);
+ mcPrintf_printf0 ((const char *) "This is free software: you are free to change and redistribute it.\\n", 68);
+ mcPrintf_printf0 ((const char *) "There is NO WARRANTY, to the extent permitted by law.\\n", 55);
+ if (mustExit)
+ {
+ libc_exit (0);
+ }
+}
+
+
+/*
+ displayHelp - display the mc help summary.
+*/
+
+static void displayHelp (void)
+{
+ mcPrintf_printf0 ((const char *) "usage: mc [--cpp] [-g] [--quiet] [--extended-opaque] [-q] [-v]", 62);
+ mcPrintf_printf0 ((const char *) " [--verbose] [--version] [--help] [-h] [-Ipath] [--olang=c]", 59);
+ mcPrintf_printf0 ((const char *) " [--olang=c++] [--olang=m2] [--debug-top]", 41);
+ mcPrintf_printf0 ((const char *) " [--gpl-header] [--glpl-header] [--summary=\"foo\"]", 49);
+ mcPrintf_printf0 ((const char *) " [--contributed=\"foo\"] [--project=\"foo\"]", 40);
+ mcPrintf_printf0 ((const char *) " [--h-file-prefix=foo] [--automatic] [-o=foo] filename\\n", 56);
+ mcPrintf_printf0 ((const char *) " --cpp preprocess through the C preprocessor\\n", 61);
+ mcPrintf_printf0 ((const char *) " -g emit debugging directives in the output language", 70);
+ mcPrintf_printf0 ((const char *) " so that the debugger will refer to the source\\n", 69);
+ mcPrintf_printf0 ((const char *) " -q --quiet no output unless an error occurs\\n", 56);
+ mcPrintf_printf0 ((const char *) " -v --verbose display preprocessor if invoked\\n", 55);
+ mcPrintf_printf0 ((const char *) " --version display version and exit\\n", 48);
+ mcPrintf_printf0 ((const char *) " -h --help display this help message\\n", 49);
+ mcPrintf_printf0 ((const char *) " -Ipath set the module search path\\n", 50);
+ mcPrintf_printf0 ((const char *) " --olang=c generate ansi C output\\n", 46);
+ mcPrintf_printf0 ((const char *) " --olang=c++ generate ansi C++ output\\n", 48);
+ mcPrintf_printf0 ((const char *) " --olang=m2 generate PIM4 output\\n", 44);
+ mcPrintf_printf0 ((const char *) " --extended-opaque parse definition and implementation modules to\\n", 70);
+ mcPrintf_printf0 ((const char *) " generate full type debugging of opaque types\\n", 68);
+ mcPrintf_printf0 ((const char *) " --debug-top debug topological data structure resolving (internal)\\n", 77);
+ mcPrintf_printf0 ((const char *) " --h-file-prefix=foo set the h file prefix to foo\\n", 52);
+ mcPrintf_printf0 ((const char *) " -o=foo set the output file to foo\\n", 50);
+ mcPrintf_printf0 ((const char *) " --ignore-fq do not generate fully qualified idents\\n", 62);
+ mcPrintf_printf0 ((const char *) " --gcc-config-system do not use standard host include files, use gcc config and system instead\\n", 97);
+ mcPrintf_printf0 ((const char *) " --gpl-header generate a GPL3 header comment at the top of the file\\n", 77);
+ mcPrintf_printf0 ((const char *) " --glpl-header generate a GLPL3 header comment at the top of the file\\n", 78);
+ mcPrintf_printf0 ((const char *) " --summary=\"foo\" generate a one line summary comment at the top of the file\\n", 82);
+ mcPrintf_printf0 ((const char *) " --contributed=\"foo\" generate a one line contribution comment near the top of the file\\n", 89);
+ mcPrintf_printf0 ((const char *) " --project=\"foo\" include the project name within the GPL3 or GLPL3 header\\n", 80);
+ mcPrintf_printf0 ((const char *) " --automatic generate a comment at the start of the file warning not to edit as it was automatically generated\\n", 121);
+ mcPrintf_printf0 ((const char *) " --scaffold-dynamic generate dynamic module initialization code for C++\\n", 75);
+ mcPrintf_printf0 ((const char *) " --scaffold-main generate main function which calls upon the dynamic initialization support in M2RTS\\n", 107);
+ mcPrintf_printf0 ((const char *) " --suppress-noreturn suppress the emission of any attribute noreturn\\n", 71);
+ mcPrintf_printf0 ((const char *) " filename the source file must be the last option\\n", 63);
+ libc_exit (0);
+}
+
+
+/*
+ commentBegin - issue a start of comment for the appropriate language.
+*/
+
+static void commentBegin (FIO_File f)
+{
+ if (langC || langCPP)
+ {
+ FIO_WriteString (f, (const char *) "/* ", 3);
+ }
+ else if (langM2)
+ {
+ /* avoid dangling else. */
+ FIO_WriteString (f, (const char *) "(* ", 3);
+ }
+}
+
+
+/*
+ commentEnd - issue an end of comment for the appropriate language.
+*/
+
+static void commentEnd (FIO_File f)
+{
+ if (langC || langCPP)
+ {
+ FIO_WriteString (f, (const char *) " */", 3);
+ FIO_WriteLine (f);
+ }
+ else if (langM2)
+ {
+ /* avoid dangling else. */
+ FIO_WriteString (f, (const char *) " *)", 3);
+ FIO_WriteLine (f);
+ }
+}
+
+
+/*
+ comment - write a comment to file, f, and also a newline.
+*/
+
+static void comment (FIO_File f, const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ FIO_WriteString (f, (const char *) a, _a_high);
+ FIO_WriteLine (f);
+}
+
+
+/*
+ commentS - write a comment to file, f, and also a newline.
+*/
+
+static void commentS (FIO_File f, DynamicStrings_String s)
+{
+ s = SFIO_WriteS (f, s);
+ FIO_WriteLine (f);
+}
+
+
+/*
+ gplBody -
+*/
+
+static void gplBody (FIO_File f)
+{
+ unsigned int year;
+
+ year = getYear ();
+ mcPrintf_printf1 ((const char *) "Copyright (C) %d Free Software Foundation, Inc.\\n", 49, (const unsigned char *) &year, (sizeof (year)-1));
+ if (contributed)
+ {
+ FIO_WriteString (f, (const char *) "Contributed by ", 15);
+ contributedContents = SFIO_WriteS (f, contributedContents);
+ FIO_WriteString (f, (const char *) ".", 1);
+ FIO_WriteLine (f);
+ }
+ FIO_WriteLine (f);
+ FIO_WriteString (f, (const char *) "This file is part of ", 21);
+ projectContents = SFIO_WriteS (f, projectContents);
+ FIO_WriteString (f, (const char *) ".", 1);
+ FIO_WriteLine (f);
+ FIO_WriteLine (f);
+ projectContents = SFIO_WriteS (f, projectContents);
+ comment (f, (const char *) " is software; you can redistribute it and/or modify", 51);
+ comment (f, (const char *) "it under the terms of the GNU General Public License as published by", 68);
+ comment (f, (const char *) "the Free Software Foundation; either version 3, or (at your option)", 67);
+ comment (f, (const char *) "any later version.", 18);
+ FIO_WriteLine (f);
+ projectContents = SFIO_WriteS (f, projectContents);
+ comment (f, (const char *) " is distributed in the hope that it will be useful, but", 55);
+ comment (f, (const char *) "WITHOUT ANY WARRANTY; without even the implied warranty of", 58);
+ comment (f, (const char *) "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU", 65);
+ comment (f, (const char *) "General Public License for more details.", 40);
+ FIO_WriteLine (f);
+ comment (f, (const char *) "You should have received a copy of the GNU General Public License", 65);
+ FIO_WriteString (f, (const char *) "along with ", 11);
+ projectContents = SFIO_WriteS (f, projectContents);
+ comment (f, (const char *) "; see the file COPYING. If not,", 32);
+ FIO_WriteString (f, (const char *) "see <https://www.gnu.org/licenses/>. ", 37);
+}
+
+
+/*
+ glplBody -
+*/
+
+static void glplBody (FIO_File f)
+{
+ unsigned int year;
+
+ year = getYear ();
+ mcPrintf_printf1 ((const char *) "Copyright (C) %d Free Software Foundation, Inc.\\n", 49, (const unsigned char *) &year, (sizeof (year)-1));
+ if (contributed)
+ {
+ FIO_WriteString (f, (const char *) "Contributed by ", 15);
+ contributedContents = SFIO_WriteS (f, contributedContents);
+ FIO_WriteString (f, (const char *) ".", 1);
+ FIO_WriteLine (f);
+ }
+ FIO_WriteLine (f);
+ FIO_WriteString (f, (const char *) "This file is part of ", 21);
+ projectContents = SFIO_WriteS (f, projectContents);
+ FIO_WriteString (f, (const char *) ".", 1);
+ FIO_WriteLine (f);
+ FIO_WriteLine (f);
+ projectContents = SFIO_WriteS (f, projectContents);
+ comment (f, (const char *) " is free software; you can redistribute it and/or modify", 56);
+ comment (f, (const char *) "it under the terms of the GNU General Public License as published by", 68);
+ comment (f, (const char *) "the Free Software Foundation; either version 3, or (at your option)", 67);
+ comment (f, (const char *) "any later version.", 18);
+ FIO_WriteLine (f);
+ projectContents = SFIO_WriteS (f, projectContents);
+ comment (f, (const char *) " is software; you can redistribute it and/or modify", 51);
+ comment (f, (const char *) "it under the terms of the GNU Lesser General Public License", 59);
+ comment (f, (const char *) "as published by the Free Software Foundation; either version 3,", 63);
+ comment (f, (const char *) "or (at your option) any later version.", 38);
+ FIO_WriteLine (f);
+ projectContents = SFIO_WriteS (f, projectContents);
+ comment (f, (const char *) " is distributed in the hope that it will be useful, but", 55);
+ comment (f, (const char *) "WITHOUT ANY WARRANTY; without even the implied warranty of", 58);
+ comment (f, (const char *) "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU", 65);
+ comment (f, (const char *) "General Public License for more details.", 40);
+ FIO_WriteLine (f);
+ comment (f, (const char *) "You should have received a copy of the GNU General Public License", 65);
+ FIO_WriteString (f, (const char *) "along with ", 11);
+ projectContents = SFIO_WriteS (f, projectContents);
+ comment (f, (const char *) "; see the file COPYING3. If not see", 36);
+ comment (f, (const char *) "<http://www.gnu.org/licenses/>.", 31);
+ FIO_WriteLine (f);
+ comment (f, (const char *) "You should have received a copy of the GNU Lesser General Public License", 72);
+ FIO_WriteString (f, (const char *) "along with ", 11);
+ projectContents = SFIO_WriteS (f, projectContents);
+ comment (f, (const char *) "; see the file COPYING. If not,", 32);
+ FIO_WriteString (f, (const char *) "see <https://www.gnu.org/licenses/>. ", 37);
+}
+
+
+/*
+ issueGPL - writes out the summary, GPL/LGPL and/or contributed as a single comment.
+*/
+
+static void issueGPL (FIO_File f)
+{
+ if (((summary || contributed) || gplHeader) || glplHeader)
+ {
+ commentBegin (f);
+ if (summary)
+ {
+ commentS (f, summaryContents);
+ FIO_WriteLine (f);
+ }
+ if (gplHeader)
+ {
+ gplBody (f);
+ }
+ if (glplHeader)
+ {
+ glplBody (f);
+ }
+ commentEnd (f);
+ FIO_WriteLine (f);
+ }
+}
+
+
+/*
+ setOutputFile - sets the output filename to output.
+*/
+
+static void setOutputFile (DynamicStrings_String output)
+{
+ outputFile = output;
+}
+
+
+/*
+ setQuiet - sets the quiet flag to, value.
+*/
+
+static void setQuiet (unsigned int value)
+{
+ quiet = value;
+}
+
+
+/*
+ setVerbose - sets the verbose flag to, value.
+*/
+
+static void setVerbose (unsigned int value)
+{
+ verbose = value;
+}
+
+
+/*
+ setExtendedOpaque - set extendedOpaque to value.
+*/
+
+static void setExtendedOpaque (unsigned int value)
+{
+ extendedOpaque = value;
+}
+
+
+/*
+ setSearchPath - set the search path for the module sources.
+*/
+
+static void setSearchPath (DynamicStrings_String arg)
+{
+ mcSearch_prependSearchPath (arg);
+}
+
+
+/*
+ setInternalDebugging - turn on/off internal debugging.
+*/
+
+static void setInternalDebugging (unsigned int value)
+{
+ internalDebugging = value;
+}
+
+
+/*
+ setHPrefix - saves the H file prefix.
+*/
+
+static void setHPrefix (DynamicStrings_String s)
+{
+ hPrefix = s;
+}
+
+
+/*
+ setIgnoreFQ - sets the ignorefq flag.
+*/
+
+static void setIgnoreFQ (unsigned int value)
+{
+ ignoreFQ = value;
+}
+
+
+/*
+ optionIs - returns TRUE if the first len (right) characters
+ match left.
+*/
+
+static unsigned int optionIs (const char *left_, unsigned int _left_high, DynamicStrings_String right)
+{
+ DynamicStrings_String s;
+ char left[_left_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (left, left_, _left_high+1);
+
+ if ((DynamicStrings_Length (right)) == (StrLib_StrLen ((const char *) left, _left_high)))
+ {
+ return DynamicStrings_EqualArray (right, (const char *) left, _left_high);
+ }
+ else if ((DynamicStrings_Length (right)) > (StrLib_StrLen ((const char *) left, _left_high)))
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_Mark (DynamicStrings_Slice (right, 0, static_cast<int> (StrLib_StrLen ((const char *) left, _left_high))));
+ return DynamicStrings_EqualArray (s, (const char *) left, _left_high);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ setLang - set the appropriate output language.
+*/
+
+static void setLang (DynamicStrings_String arg)
+{
+ /* must check the longest distinctive string first. */
+ if (optionIs ((const char *) "c++", 3, arg))
+ {
+ decl_setLangCP ();
+ langCPP = TRUE;
+ }
+ else if (optionIs ((const char *) "c", 1, arg))
+ {
+ /* avoid dangling else. */
+ decl_setLangC ();
+ langC = TRUE;
+ }
+ else if (optionIs ((const char *) "m2", 2, arg))
+ {
+ /* avoid dangling else. */
+ decl_setLangM2 ();
+ langM2 = TRUE;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ displayHelp ();
+ }
+}
+
+
+/*
+ handleOption -
+*/
+
+static void handleOption (DynamicStrings_String arg)
+{
+ if ((optionIs ((const char *) "--quiet", 7, arg)) || (optionIs ((const char *) "-q", 2, arg)))
+ {
+ setQuiet (TRUE);
+ }
+ else if ((optionIs ((const char *) "--verbose", 9, arg)) || (optionIs ((const char *) "-v", 2, arg)))
+ {
+ /* avoid dangling else. */
+ setVerbose (TRUE);
+ }
+ else if (optionIs ((const char *) "--version", 9, arg))
+ {
+ /* avoid dangling else. */
+ displayVersion (TRUE);
+ }
+ else if (optionIs ((const char *) "--olang=", 8, arg))
+ {
+ /* avoid dangling else. */
+ setLang (DynamicStrings_Slice (arg, 8, 0));
+ }
+ else if (optionIs ((const char *) "-I", 2, arg))
+ {
+ /* avoid dangling else. */
+ setSearchPath (DynamicStrings_Slice (arg, 2, 0));
+ }
+ else if ((optionIs ((const char *) "--help", 6, arg)) || (optionIs ((const char *) "-h", 2, arg)))
+ {
+ /* avoid dangling else. */
+ displayHelp ();
+ }
+ else if (optionIs ((const char *) "--cpp", 5, arg))
+ {
+ /* avoid dangling else. */
+ cppProgram = DynamicStrings_InitString ((const char *) "cpp", 3);
+ }
+ else if (optionIs ((const char *) "-o=", 3, arg))
+ {
+ /* avoid dangling else. */
+ setOutputFile (DynamicStrings_Slice (arg, 3, 0));
+ }
+ else if (optionIs ((const char *) "--extended-opaque", 17, arg))
+ {
+ /* avoid dangling else. */
+ setExtendedOpaque (TRUE);
+ }
+ else if (optionIs ((const char *) "--debug-top", 11, arg))
+ {
+ /* avoid dangling else. */
+ mcOptions_setDebugTopological (TRUE);
+ }
+ else if (optionIs ((const char *) "--h-file-prefix=", 16, arg))
+ {
+ /* avoid dangling else. */
+ setHPrefix (DynamicStrings_Slice (arg, 16, 0));
+ }
+ else if (optionIs ((const char *) "--ignore-fq", 11, arg))
+ {
+ /* avoid dangling else. */
+ setIgnoreFQ (TRUE);
+ }
+ else if (optionIs ((const char *) "--gpl-header", 12, arg))
+ {
+ /* avoid dangling else. */
+ gplHeader = TRUE;
+ }
+ else if (optionIs ((const char *) "--glpl-header", 13, arg))
+ {
+ /* avoid dangling else. */
+ glplHeader = TRUE;
+ }
+ else if (optionIs ((const char *) "--summary=\"", 11, arg))
+ {
+ /* avoid dangling else. */
+ summary = TRUE;
+ summaryContents = DynamicStrings_Slice (arg, 11, -1);
+ }
+ else if (optionIs ((const char *) "--contributed=\"", 15, arg))
+ {
+ /* avoid dangling else. */
+ contributed = TRUE;
+ contributedContents = DynamicStrings_Slice (arg, 13, -1);
+ }
+ else if (optionIs ((const char *) "--project=\"", 11, arg))
+ {
+ /* avoid dangling else. */
+ projectContents = DynamicStrings_Slice (arg, 10, -1);
+ }
+ else if (optionIs ((const char *) "--gcc-config-system", 19, arg))
+ {
+ /* avoid dangling else. */
+ gccConfigSystem = TRUE;
+ }
+ else if (optionIs ((const char *) "--scaffold-main", 15, arg))
+ {
+ /* avoid dangling else. */
+ scaffoldMain = TRUE;
+ }
+ else if (optionIs ((const char *) "--scaffold-dynamic", 18, arg))
+ {
+ /* avoid dangling else. */
+ scaffoldDynamic = TRUE;
+ }
+ else if (optionIs ((const char *) "--suppress-noreturn", 19, arg))
+ {
+ /* avoid dangling else. */
+ suppressNoReturn = TRUE;
+ }
+}
+
+
+/*
+ handleOptions - iterates over all options setting appropriate
+ values and returns the single source file
+ if found at the end of the arguments.
+*/
+
+extern "C" DynamicStrings_String mcOptions_handleOptions (void)
+{
+ unsigned int i;
+ DynamicStrings_String arg;
+
+ i = 1;
+ while (SArgs_GetArg (&arg, i))
+ {
+ if ((DynamicStrings_Length (arg)) > 0)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((DynamicStrings_char (arg, 0)) == '-')
+ {
+ handleOption (arg);
+ }
+ else
+ {
+ if (! summary)
+ {
+ summaryContents = DynamicStrings_ConCatChar (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "automatically created by mc from ", 33), arg), '.');
+ summary = FALSE;
+ }
+ return arg;
+ }
+ }
+ i += 1;
+ }
+ return static_cast<DynamicStrings_String> (NULL);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getQuiet - return the value of quiet.
+*/
+
+extern "C" unsigned int mcOptions_getQuiet (void)
+{
+ return quiet;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getVerbose - return the value of verbose.
+*/
+
+extern "C" unsigned int mcOptions_getVerbose (void)
+{
+ return verbose;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getInternalDebugging - return the value of internalDebugging.
+*/
+
+extern "C" unsigned int mcOptions_getInternalDebugging (void)
+{
+ return internalDebugging;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getCppCommandLine - returns the Cpp command line and all arguments.
+*/
+
+extern "C" DynamicStrings_String mcOptions_getCppCommandLine (void)
+{
+ DynamicStrings_String s;
+
+ if (DynamicStrings_EqualArray (cppProgram, (const char *) "", 0))
+ {
+ return static_cast<DynamicStrings_String> (NULL);
+ }
+ else
+ {
+ s = DynamicStrings_Dup (cppProgram);
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (s, ' '), cppArgs);
+ if (mcOptions_getQuiet ())
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (s, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-quiet", 6)));
+ }
+ return s;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getOutputFile - sets the output filename to output.
+*/
+
+extern "C" DynamicStrings_String mcOptions_getOutputFile (void)
+{
+ return outputFile;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getExtendedOpaque - return the extendedOpaque value.
+*/
+
+extern "C" unsigned int mcOptions_getExtendedOpaque (void)
+{
+ return extendedOpaque;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ setDebugTopological - sets the flag debugTopological to value.
+*/
+
+extern "C" void mcOptions_setDebugTopological (unsigned int value)
+{
+ debugTopological = value;
+}
+
+
+/*
+ getDebugTopological - returns the flag value of the command
+ line option --debug-top.
+*/
+
+extern "C" unsigned int mcOptions_getDebugTopological (void)
+{
+ return debugTopological;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getHPrefix - saves the H file prefix.
+*/
+
+extern "C" DynamicStrings_String mcOptions_getHPrefix (void)
+{
+ return hPrefix;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getIgnoreFQ - returns the ignorefq flag.
+*/
+
+extern "C" unsigned int mcOptions_getIgnoreFQ (void)
+{
+ return ignoreFQ;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getGccConfigSystem - return the value of the gccConfigSystem flag.
+*/
+
+extern "C" unsigned int mcOptions_getGccConfigSystem (void)
+{
+ return gccConfigSystem;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getScaffoldDynamic - return true if the --scaffold-dynamic option was present.
+*/
+
+extern "C" unsigned int mcOptions_getScaffoldDynamic (void)
+{
+ return scaffoldDynamic;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getScaffoldMain - return true if the --scaffold-main option was present.
+*/
+
+extern "C" unsigned int mcOptions_getScaffoldMain (void)
+{
+ return scaffoldMain;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ writeGPLheader - writes out the GPL or the LGPL as a comment.
+*/
+
+extern "C" void mcOptions_writeGPLheader (FIO_File f)
+{
+ issueGPL (f);
+}
+
+
+/*
+ setSuppressNoReturn - set suppressNoReturn to value.
+*/
+
+extern "C" void mcOptions_setSuppressNoReturn (unsigned int value)
+{
+ suppressNoReturn = value;
+}
+
+
+/*
+ getSuppressNoReturn - return the suppressNoReturn value.
+*/
+
+extern "C" unsigned int mcOptions_getSuppressNoReturn (void)
+{
+ return suppressNoReturn;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcOptions_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ langC = TRUE;
+ langCPP = FALSE;
+ langM2 = FALSE;
+ gplHeader = FALSE;
+ glplHeader = FALSE;
+ summary = FALSE;
+ contributed = FALSE;
+ caseRuntime = FALSE;
+ arrayRuntime = FALSE;
+ returnRuntime = FALSE;
+ internalDebugging = FALSE;
+ quiet = FALSE;
+ verbose = FALSE;
+ extendedOpaque = FALSE;
+ debugTopological = FALSE;
+ ignoreFQ = FALSE;
+ gccConfigSystem = FALSE;
+ scaffoldMain = FALSE;
+ scaffoldDynamic = FALSE;
+ suppressNoReturn = FALSE;
+ hPrefix = DynamicStrings_InitString ((const char *) "", 0);
+ cppArgs = DynamicStrings_InitString ((const char *) "", 0);
+ cppProgram = DynamicStrings_InitString ((const char *) "", 0);
+ outputFile = DynamicStrings_InitString ((const char *) "-", 1);
+ summaryContents = DynamicStrings_InitString ((const char *) "", 0);
+ contributedContents = DynamicStrings_InitString ((const char *) "", 0);
+ projectContents = DynamicStrings_InitString ((const char *) "GNU Modula-2", 12);
+}
+
+extern "C" void _M2_mcOptions_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcPreprocess. */
+/* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _mcPreprocess_H
+#define _mcPreprocess_C
+
+# include "GSYSTEM.h"
+# include "GDynamicStrings.h"
+# include "Glibc.h"
+# include "Galists.h"
+# include "GM2RTS.h"
+# include "GFIO.h"
+# include "GmcPrintf.h"
+# include "GmcOptions.h"
+
+static alists_alist listOfFiles;
+
+/*
+ preprocessModule - preprocess a file, filename, returning the new filename
+ of the preprocessed file.
+ Preprocessing will only occur if requested by the user.
+ If no preprocessing was requested then filename is returned.
+ If preprocessing occurs then a temporary file is created
+ and its name is returned.
+ All temporary files will be deleted when the compiler exits.
+*/
+
+extern "C" DynamicStrings_String mcPreprocess_preprocessModule (DynamicStrings_String filename);
+
+/*
+ makeTempFile -
+*/
+
+static DynamicStrings_String makeTempFile (DynamicStrings_String ext);
+
+/*
+ onExitDelete -
+*/
+
+static DynamicStrings_String onExitDelete (DynamicStrings_String filename);
+
+/*
+ removeFile - removes a single file, s.
+*/
+
+static void removeFile (void * a);
+
+/*
+ removeFiles -
+*/
+
+static void removeFiles (void);
+
+
+/*
+ makeTempFile -
+*/
+
+static DynamicStrings_String makeTempFile (DynamicStrings_String ext)
+{
+ return DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "/tmp/mctemp.", 12), ext);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ onExitDelete -
+*/
+
+static DynamicStrings_String onExitDelete (DynamicStrings_String filename)
+{
+ alists_includeItemIntoList (listOfFiles, reinterpret_cast<void *> (DynamicStrings_Dup (filename)));
+ return filename;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ removeFile - removes a single file, s.
+*/
+
+static void removeFile (void * a)
+{
+ DynamicStrings_String s;
+
+ s = static_cast<DynamicStrings_String> (a);
+ if ((libc_unlink (DynamicStrings_string (s))) != 0)
+ {} /* empty. */
+}
+
+
+/*
+ removeFiles -
+*/
+
+static void removeFiles (void)
+{
+ alists_foreachItemInListDo (listOfFiles, (alists_performOperation) {(alists_performOperation_t) removeFile});
+}
+
+
+/*
+ preprocessModule - preprocess a file, filename, returning the new filename
+ of the preprocessed file.
+ Preprocessing will only occur if requested by the user.
+ If no preprocessing was requested then filename is returned.
+ If preprocessing occurs then a temporary file is created
+ and its name is returned.
+ All temporary files will be deleted when the compiler exits.
+*/
+
+extern "C" DynamicStrings_String mcPreprocess_preprocessModule (DynamicStrings_String filename)
+{
+ DynamicStrings_String tempfile;
+ DynamicStrings_String command;
+ DynamicStrings_String commandLine;
+ unsigned int pos;
+
+ command = mcOptions_getCppCommandLine ();
+ if (DynamicStrings_EqualArray (command, (const char *) "", 0))
+ {
+ return filename;
+ }
+ else
+ {
+ tempfile = DynamicStrings_InitStringCharStar (reinterpret_cast<void *> (makeTempFile (DynamicStrings_InitString ((const char *) "cpp", 3))));
+ commandLine = DynamicStrings_Dup (command);
+ commandLine = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Dup (commandLine), ' '), filename), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " -o ", 4))), tempfile);
+ if (mcOptions_getVerbose ())
+ {
+ mcPrintf_fprintf1 (FIO_StdOut, (const char *) "%s\\n", 4, (const unsigned char *) &commandLine, (sizeof (commandLine)-1));
+ }
+ if ((libc_system (DynamicStrings_string (commandLine))) != 0)
+ {
+ mcPrintf_fprintf1 (FIO_StdErr, (const char *) "C preprocessor failed when preprocessing %s\\n", 45, (const unsigned char *) &filename, (sizeof (filename)-1));
+ libc_exit (1);
+ }
+ commandLine = DynamicStrings_KillString (commandLine);
+ return onExitDelete (tempfile);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcPreprocess_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ listOfFiles = alists_initList ();
+ if (! (M2RTS_InstallTerminationProcedure ((PROC ) {(PROC_t) removeFiles})))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+extern "C" void _M2_mcPreprocess_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcPretty. */
+/* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcPretty_H
+#define _mcPretty_C
+
+# include "GDynamicStrings.h"
+# include "GStorage.h"
+
+typedef struct mcPretty_writeProc_p mcPretty_writeProc;
+
+typedef struct mcPretty_writeLnProc_p mcPretty_writeLnProc;
+
+typedef struct mcPretty__T1_r mcPretty__T1;
+
+typedef mcPretty__T1 *mcPretty_pretty;
+
+typedef void (*mcPretty_writeProc_t) (char);
+struct mcPretty_writeProc_p { mcPretty_writeProc_t proc; };
+
+typedef void (*mcPretty_writeLnProc_t) (void);
+struct mcPretty_writeLnProc_p { mcPretty_writeLnProc_t proc; };
+
+struct mcPretty__T1_r {
+ mcPretty_writeProc write_;
+ mcPretty_writeLnProc writeln;
+ unsigned int needsSpace;
+ unsigned int needsIndent;
+ unsigned int seekPos;
+ unsigned int curLine;
+ unsigned int curPos;
+ unsigned int indent;
+ mcPretty_pretty stacked;
+ };
+
+
+/*
+ initPretty - initialise a pretty print data structure.
+*/
+
+extern "C" mcPretty_pretty mcPretty_initPretty (mcPretty_writeProc w, mcPretty_writeLnProc l);
+
+/*
+ dupPretty - duplicate a pretty print data structure.
+*/
+
+extern "C" mcPretty_pretty mcPretty_dupPretty (mcPretty_pretty p);
+
+/*
+ killPretty - destroy a pretty print data structure.
+ Post condition: p is assigned to NIL.
+*/
+
+extern "C" void mcPretty_killPretty (mcPretty_pretty *p);
+
+/*
+ pushPretty - duplicate, p. Push, p, and return the duplicate.
+*/
+
+extern "C" mcPretty_pretty mcPretty_pushPretty (mcPretty_pretty p);
+
+/*
+ popPretty - pops the pretty object from the stack.
+*/
+
+extern "C" mcPretty_pretty mcPretty_popPretty (mcPretty_pretty p);
+
+/*
+ getindent - returns the current indent value.
+*/
+
+extern "C" unsigned int mcPretty_getindent (mcPretty_pretty p);
+
+/*
+ setindent - sets the current indent to, n.
+*/
+
+extern "C" void mcPretty_setindent (mcPretty_pretty p, unsigned int n);
+
+/*
+ getcurpos - returns the current cursor position.
+*/
+
+extern "C" unsigned int mcPretty_getcurpos (mcPretty_pretty s);
+
+/*
+ getseekpos - returns the seek position.
+*/
+
+extern "C" unsigned int mcPretty_getseekpos (mcPretty_pretty s);
+
+/*
+ getcurline - returns the current line number.
+*/
+
+extern "C" unsigned int mcPretty_getcurline (mcPretty_pretty s);
+extern "C" void mcPretty_setNeedSpace (mcPretty_pretty s);
+
+/*
+ noSpace - unset needsSpace.
+*/
+
+extern "C" void mcPretty_noSpace (mcPretty_pretty s);
+
+/*
+ print - print a string using, p.
+*/
+
+extern "C" void mcPretty_print (mcPretty_pretty p, const char *a_, unsigned int _a_high);
+
+/*
+ prints - print a string using, p.
+*/
+
+extern "C" void mcPretty_prints (mcPretty_pretty p, DynamicStrings_String s);
+
+/*
+ raw - print out string, s, without any translation of
+ escape sequences.
+*/
+
+extern "C" void mcPretty_raw (mcPretty_pretty p, DynamicStrings_String s);
+
+/*
+ flushSpace -
+*/
+
+static void flushSpace (mcPretty_pretty p);
+
+/*
+ flushIndent -
+*/
+
+static void flushIndent (mcPretty_pretty p);
+
+
+/*
+ flushSpace -
+*/
+
+static void flushSpace (mcPretty_pretty p)
+{
+ if (p->needsSpace)
+ {
+ (*p->write_.proc) (' ');
+ p->needsSpace = FALSE;
+ p->curPos += 1;
+ p->seekPos += 1;
+ }
+}
+
+
+/*
+ flushIndent -
+*/
+
+static void flushIndent (mcPretty_pretty p)
+{
+ unsigned int i;
+
+ flushSpace (p);
+ if (p->needsIndent)
+ {
+ while (p->curPos < p->indent)
+ {
+ (*p->write_.proc) (' ');
+ p->curPos += 1;
+ p->seekPos += 1;
+ }
+ p->needsIndent = FALSE;
+ }
+}
+
+
+/*
+ initPretty - initialise a pretty print data structure.
+*/
+
+extern "C" mcPretty_pretty mcPretty_initPretty (mcPretty_writeProc w, mcPretty_writeLnProc l)
+{
+ mcPretty_pretty p;
+
+ Storage_ALLOCATE ((void **) &p, sizeof (mcPretty__T1));
+ p->write_ = w;
+ p->writeln = l;
+ p->needsSpace = FALSE;
+ p->needsIndent = FALSE;
+ p->curPos = 0;
+ p->curLine = 0;
+ p->seekPos = 0;
+ p->indent = 0;
+ p->stacked = NULL;
+ return p;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ dupPretty - duplicate a pretty print data structure.
+*/
+
+extern "C" mcPretty_pretty mcPretty_dupPretty (mcPretty_pretty p)
+{
+ mcPretty_pretty q;
+
+ Storage_ALLOCATE ((void **) &q, sizeof (mcPretty__T1));
+ (*q) = (*p);
+ return q;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ killPretty - destroy a pretty print data structure.
+ Post condition: p is assigned to NIL.
+*/
+
+extern "C" void mcPretty_killPretty (mcPretty_pretty *p)
+{
+ (*p) = NULL;
+ return ;
+ Storage_DEALLOCATE ((void **) &(*p), sizeof (mcPretty__T1));
+ (*p) = NULL;
+}
+
+
+/*
+ pushPretty - duplicate, p. Push, p, and return the duplicate.
+*/
+
+extern "C" mcPretty_pretty mcPretty_pushPretty (mcPretty_pretty p)
+{
+ mcPretty_pretty q;
+
+ q = mcPretty_dupPretty (p);
+ q->stacked = p;
+ return q;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ popPretty - pops the pretty object from the stack.
+*/
+
+extern "C" mcPretty_pretty mcPretty_popPretty (mcPretty_pretty p)
+{
+ mcPretty_pretty q;
+
+ q = p->stacked;
+ q->needsIndent = p->needsIndent;
+ q->needsSpace = p->needsSpace;
+ q->curPos = p->curPos;
+ q->seekPos = p->seekPos;
+ q->curLine = p->curLine;
+ mcPretty_killPretty (&p);
+ return q;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getindent - returns the current indent value.
+*/
+
+extern "C" unsigned int mcPretty_getindent (mcPretty_pretty p)
+{
+ return p->indent;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ setindent - sets the current indent to, n.
+*/
+
+extern "C" void mcPretty_setindent (mcPretty_pretty p, unsigned int n)
+{
+ p->indent = n;
+}
+
+
+/*
+ getcurpos - returns the current cursor position.
+*/
+
+extern "C" unsigned int mcPretty_getcurpos (mcPretty_pretty s)
+{
+ if (s->needsSpace)
+ {
+ return s->curPos+1;
+ }
+ else
+ {
+ return s->curPos;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getseekpos - returns the seek position.
+*/
+
+extern "C" unsigned int mcPretty_getseekpos (mcPretty_pretty s)
+{
+ return s->seekPos;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getcurline - returns the current line number.
+*/
+
+extern "C" unsigned int mcPretty_getcurline (mcPretty_pretty s)
+{
+ return s->curLine;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void mcPretty_setNeedSpace (mcPretty_pretty s)
+{
+ /*
+ setneedSpace - sets needSpace flag to TRUE.
+ */
+ s->needsSpace = TRUE;
+}
+
+
+/*
+ noSpace - unset needsSpace.
+*/
+
+extern "C" void mcPretty_noSpace (mcPretty_pretty s)
+{
+ s->needsSpace = FALSE;
+}
+
+
+/*
+ print - print a string using, p.
+*/
+
+extern "C" void mcPretty_print (mcPretty_pretty p, const char *a_, unsigned int _a_high)
+{
+ DynamicStrings_String s;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ s = DynamicStrings_InitString ((const char *) a, _a_high);
+ mcPretty_prints (p, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ prints - print a string using, p.
+*/
+
+extern "C" void mcPretty_prints (mcPretty_pretty p, DynamicStrings_String s)
+{
+ unsigned int l;
+ unsigned int i;
+
+ l = DynamicStrings_Length (s);
+ i = 0;
+ flushSpace (p);
+ while (i < l)
+ {
+ if ((((i+2) <= l) && ((DynamicStrings_char (s, static_cast<int> (i))) == '\\')) && ((DynamicStrings_char (s, static_cast<int> (i+1))) == 'n'))
+ {
+ p->needsIndent = TRUE;
+ p->needsSpace = FALSE;
+ p->curPos = 0;
+ (*p->writeln.proc) ();
+ p->seekPos += 1;
+ p->curLine += 1;
+ i += 1;
+ }
+ else
+ {
+ flushIndent (p);
+ (*p->write_.proc) (DynamicStrings_char (s, static_cast<int> (i)));
+ p->curPos += 1;
+ p->seekPos += 1;
+ }
+ i += 1;
+ }
+}
+
+
+/*
+ raw - print out string, s, without any translation of
+ escape sequences.
+*/
+
+extern "C" void mcPretty_raw (mcPretty_pretty p, DynamicStrings_String s)
+{
+ unsigned int l;
+ unsigned int i;
+
+ l = DynamicStrings_Length (s);
+ i = 0;
+ flushSpace (p);
+ flushIndent (p);
+ while (i < l)
+ {
+ (*p->write_.proc) (DynamicStrings_char (s, static_cast<int> (i)));
+ p->curPos += 1;
+ p->seekPos += 1;
+ i += 1;
+ }
+}
+
+extern "C" void _M2_mcPretty_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcPretty_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcPrintf. */
+/* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcPrintf_H
+#define _mcPrintf_C
+
+# include "GSFIO.h"
+# include "GFIO.h"
+# include "GDynamicStrings.h"
+# include "GStrLib.h"
+# include "GFormatStrings.h"
+# include "GnameKey.h"
+# include "GM2RTS.h"
+
+
+/*
+ printf0 - writes out an array to, StdOut, after the escape
+ sequences have been translated.
+*/
+
+extern "C" void mcPrintf_printf0 (const char *a_, unsigned int _a_high);
+
+/*
+ printf0 - writes out an array to, StdOut, after the escape
+ sequences have been translated.
+*/
+
+extern "C" void mcPrintf_printf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ printf0 - writes out an array to, StdOut, after the escape
+ sequences have been translated.
+*/
+
+extern "C" void mcPrintf_printf2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+
+/*
+ printf0 - writes out an array to, StdOut, after the escape
+ sequences have been translated.
+*/
+
+extern "C" void mcPrintf_printf3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+
+/*
+ printf0 - writes out an array to, StdOut, after the escape
+ sequences have been translated.
+*/
+
+extern "C" void mcPrintf_printf4 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high);
+
+/*
+ fprintf0 - writes out an array to, file, after the escape sequences
+ have been translated.
+*/
+
+extern "C" void mcPrintf_fprintf0 (FIO_File file, const char *a_, unsigned int _a_high);
+
+/*
+ fprintf0 - writes out an array to, file, after the escape sequences
+ have been translated.
+*/
+
+extern "C" void mcPrintf_fprintf1 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ fprintf0 - writes out an array to, file, after the escape sequences
+ have been translated.
+*/
+
+extern "C" void mcPrintf_fprintf2 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+
+/*
+ fprintf0 - writes out an array to, file, after the escape sequences
+ have been translated.
+*/
+
+extern "C" void mcPrintf_fprintf3 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+
+/*
+ fprintf0 - writes out an array to, file, after the escape sequences
+ have been translated.
+*/
+
+extern "C" void mcPrintf_fprintf4 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high);
+
+/*
+ isDigit - returns TRUE if, ch, is a character 0..9
+*/
+
+static unsigned int isDigit (char ch);
+
+/*
+ cast - casts a := b
+*/
+
+static void cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high);
+
+/*
+ TranslateNameToCharStar - takes a format specification string, a, and
+ if they consist of of %a then this is translated
+ into a String and %a is replaced by %s.
+*/
+
+static unsigned int TranslateNameToCharStar (char *a, unsigned int _a_high, unsigned int n);
+
+
+/*
+ isDigit - returns TRUE if, ch, is a character 0..9
+*/
+
+static unsigned int isDigit (char ch)
+{
+ return (ch >= '0') && (ch <= '9');
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ cast - casts a := b
+*/
+
+static void cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (b, b_, _b_high+1);
+
+ if (_a_high == _b_high)
+ {
+ for (i=0; i<=_a_high; i++)
+ {
+ a[i] = b[i];
+ }
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ TranslateNameToCharStar - takes a format specification string, a, and
+ if they consist of of %a then this is translated
+ into a String and %a is replaced by %s.
+*/
+
+static unsigned int TranslateNameToCharStar (char *a, unsigned int _a_high, unsigned int n)
+{
+ unsigned int argno;
+ unsigned int i;
+ unsigned int h;
+
+ argno = 1;
+ i = 0;
+ h = StrLib_StrLen ((const char *) a, _a_high);
+ while (i < h)
+ {
+ if ((a[i] == '%') && ((i+1) < h))
+ {
+ if ((a[i+1] == 'a') && (argno == n))
+ {
+ a[i+1] = 's';
+ return TRUE;
+ }
+ argno += 1;
+ if (argno > n)
+ {
+ /* all done */
+ return FALSE;
+ }
+ }
+ i += 1;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ printf0 - writes out an array to, StdOut, after the escape
+ sequences have been translated.
+*/
+
+extern "C" void mcPrintf_printf0 (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ mcPrintf_fprintf0 (FIO_StdOut, (const char *) a, _a_high);
+}
+
+
+/*
+ printf0 - writes out an array to, StdOut, after the escape
+ sequences have been translated.
+*/
+
+extern "C" void mcPrintf_printf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high)
+{
+ char a[_a_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ mcPrintf_fprintf1 (FIO_StdOut, (const char *) a, _a_high, (const unsigned char *) w, _w_high);
+}
+
+
+/*
+ printf0 - writes out an array to, StdOut, after the escape
+ sequences have been translated.
+*/
+
+extern "C" void mcPrintf_printf2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high)
+{
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+
+ mcPrintf_fprintf2 (FIO_StdOut, (const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high);
+}
+
+
+/*
+ printf0 - writes out an array to, StdOut, after the escape
+ sequences have been translated.
+*/
+
+extern "C" void mcPrintf_printf3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high)
+{
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+
+ mcPrintf_fprintf3 (FIO_StdOut, (const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high);
+}
+
+
+/*
+ printf0 - writes out an array to, StdOut, after the escape
+ sequences have been translated.
+*/
+
+extern "C" void mcPrintf_printf4 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high)
+{
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+ unsigned char w4[_w4_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+ memcpy (w4, w4_, _w4_high+1);
+
+ mcPrintf_fprintf4 (FIO_StdOut, (const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high);
+}
+
+
+/*
+ fprintf0 - writes out an array to, file, after the escape sequences
+ have been translated.
+*/
+
+extern "C" void mcPrintf_fprintf0 (FIO_File file, const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ if ((DynamicStrings_KillString (SFIO_WriteS (file, FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) a, _a_high))))) == NULL)
+ {} /* empty. */
+}
+
+
+/*
+ fprintf0 - writes out an array to, file, after the escape sequences
+ have been translated.
+*/
+
+extern "C" void mcPrintf_fprintf1 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high)
+{
+ DynamicStrings_String s;
+ DynamicStrings_String t;
+ nameKey_Name n;
+ char a[_a_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ if (TranslateNameToCharStar ((char *) a, _a_high, 1))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w, _w_high);
+ s = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ t = DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high));
+ s = FormatStrings_Sprintf1 (t, (const unsigned char *) &s, (sizeof (s)-1));
+ }
+ else
+ {
+ t = DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high));
+ s = FormatStrings_Sprintf1 (t, (const unsigned char *) w, _w_high);
+ }
+ if ((DynamicStrings_KillString (SFIO_WriteS (file, s))) == NULL)
+ {} /* empty. */
+}
+
+
+/*
+ fprintf0 - writes out an array to, file, after the escape sequences
+ have been translated.
+*/
+
+extern "C" void mcPrintf_fprintf2 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high)
+{
+ nameKey_Name n;
+ DynamicStrings_String s;
+ DynamicStrings_String s1;
+ DynamicStrings_String s2;
+ unsigned int b;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+
+ b = (unsigned int) 0;
+ if (TranslateNameToCharStar ((char *) a, _a_high, 1))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w1, _w1_high);
+ s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (1 ));
+ }
+ if (TranslateNameToCharStar ((char *) a, _a_high, 2))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w2, _w2_high);
+ s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (2 ));
+ }
+ switch (b)
+ {
+ case (unsigned int) 0:
+ s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high);
+ break;
+
+ case (unsigned int) ((1 << (1))):
+ s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high);
+ break;
+
+ case (unsigned int) ((1 << (2))):
+ s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1));
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (2))):
+ s = FormatStrings_Sprintf2 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1));
+ break;
+
+
+ default:
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ break;
+ }
+ if ((DynamicStrings_KillString (SFIO_WriteS (file, s))) == NULL)
+ {} /* empty. */
+}
+
+
+/*
+ fprintf0 - writes out an array to, file, after the escape sequences
+ have been translated.
+*/
+
+extern "C" void mcPrintf_fprintf3 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high)
+{
+ nameKey_Name n;
+ DynamicStrings_String s;
+ DynamicStrings_String s1;
+ DynamicStrings_String s2;
+ DynamicStrings_String s3;
+ unsigned int b;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+
+ b = (unsigned int) 0;
+ if (TranslateNameToCharStar ((char *) a, _a_high, 1))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w1, _w1_high);
+ s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (1 ));
+ }
+ if (TranslateNameToCharStar ((char *) a, _a_high, 2))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w2, _w2_high);
+ s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (2 ));
+ }
+ if (TranslateNameToCharStar ((char *) a, _a_high, 3))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w3, _w3_high);
+ s3 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (3 ));
+ }
+ switch (b)
+ {
+ case (unsigned int) 0:
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high);
+ break;
+
+ case (unsigned int) ((1 << (1))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high);
+ break;
+
+ case (unsigned int) ((1 << (2))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high);
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (2))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high);
+ break;
+
+ case (unsigned int) ((1 << (3))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1));
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (3))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1));
+ break;
+
+ case (unsigned int) ((1 << (2)) | (1 << (3))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1));
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (2)) | (1 << (3))):
+ s = FormatStrings_Sprintf3 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1));
+ break;
+
+
+ default:
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ break;
+ }
+ if ((DynamicStrings_KillString (SFIO_WriteS (file, s))) == NULL)
+ {} /* empty. */
+}
+
+
+/*
+ fprintf0 - writes out an array to, file, after the escape sequences
+ have been translated.
+*/
+
+extern "C" void mcPrintf_fprintf4 (FIO_File file, const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high)
+{
+ nameKey_Name n;
+ DynamicStrings_String s;
+ DynamicStrings_String s1;
+ DynamicStrings_String s2;
+ DynamicStrings_String s3;
+ DynamicStrings_String s4;
+ unsigned int b;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+ unsigned char w4[_w4_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+ memcpy (w4, w4_, _w4_high+1);
+
+ b = (unsigned int) 0;
+ if (TranslateNameToCharStar ((char *) a, _a_high, 1))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w1, _w1_high);
+ s1 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (1 ));
+ }
+ if (TranslateNameToCharStar ((char *) a, _a_high, 2))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w2, _w2_high);
+ s2 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (2 ));
+ }
+ if (TranslateNameToCharStar ((char *) a, _a_high, 3))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w3, _w3_high);
+ s3 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (3 ));
+ }
+ if (TranslateNameToCharStar ((char *) a, _a_high, 4))
+ {
+ cast ((unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) w4, _w4_high);
+ s4 = DynamicStrings_Mark (DynamicStrings_InitStringCharStar (nameKey_keyToCharStar (n)));
+ b |= (1 << (4 ));
+ }
+ switch (b)
+ {
+ case (unsigned int) 0:
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high);
+ break;
+
+ case (unsigned int) ((1 << (1))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high);
+ break;
+
+ case (unsigned int) ((1 << (2))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high);
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (2))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high);
+ break;
+
+ case (unsigned int) ((1 << (3))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) w4, _w4_high);
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (3))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) w4, _w4_high);
+ break;
+
+ case (unsigned int) ((1 << (2)) | (1 << (3))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) w4, _w4_high);
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (2)) | (1 << (3))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) w4, _w4_high);
+ break;
+
+ case (unsigned int) ((1 << (4))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) &s4, (sizeof (s4)-1));
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (4))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) &s4, (sizeof (s4)-1));
+ break;
+
+ case (unsigned int) ((1 << (2)) | (1 << (4))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high, (const unsigned char *) &s4, (sizeof (s4)-1));
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (2)) | (1 << (4))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) w3, _w3_high, (const unsigned char *) &s4, (sizeof (s4)-1));
+ break;
+
+ case (unsigned int) ((1 << (3)) | (1 << (4))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) &s4, (sizeof (s4)-1));
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (3)) | (1 << (4))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) w2, _w2_high, (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) &s4, (sizeof (s4)-1));
+ break;
+
+ case (unsigned int) ((1 << (2)) | (1 << (3)) | (1 << (4))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) w1, _w1_high, (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) &s4, (sizeof (s4)-1));
+ break;
+
+ case (unsigned int) ((1 << (1)) | (1 << (2)) | (1 << (3)) | (1 << (4))):
+ s = FormatStrings_Sprintf4 (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) a, _a_high)), (const unsigned char *) &s1, (sizeof (s1)-1), (const unsigned char *) &s2, (sizeof (s2)-1), (const unsigned char *) &s3, (sizeof (s3)-1), (const unsigned char *) &s4, (sizeof (s4)-1));
+ break;
+
+
+ default:
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ break;
+ }
+ if ((DynamicStrings_KillString (SFIO_WriteS (file, s))) == NULL)
+ {} /* empty. */
+}
+
+extern "C" void _M2_mcPrintf_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcPrintf_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcQuiet. */
+/* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _mcQuiet_H
+#define _mcQuiet_C
+
+# include "GmcOptions.h"
+# include "GmcPrintf.h"
+
+extern "C" void mcQuiet_qprintf0 (const char *a_, unsigned int _a_high);
+extern "C" void mcQuiet_qprintf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+extern "C" void mcQuiet_qprintf2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+extern "C" void mcQuiet_qprintf3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+extern "C" void mcQuiet_qprintf4 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high);
+
+extern "C" void mcQuiet_qprintf0 (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ if (! (mcOptions_getQuiet ()))
+ {
+ mcPrintf_printf0 ((const char *) a, _a_high);
+ }
+}
+
+extern "C" void mcQuiet_qprintf1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high)
+{
+ char a[_a_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ if (! (mcOptions_getQuiet ()))
+ {
+ mcPrintf_printf1 ((const char *) a, _a_high, (const unsigned char *) w, _w_high);
+ }
+}
+
+extern "C" void mcQuiet_qprintf2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high)
+{
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+
+ if (! (mcOptions_getQuiet ()))
+ {
+ mcPrintf_printf2 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high);
+ }
+}
+
+extern "C" void mcQuiet_qprintf3 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high)
+{
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+
+ if (! (mcOptions_getQuiet ()))
+ {
+ mcPrintf_printf3 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high);
+ }
+}
+
+extern "C" void mcQuiet_qprintf4 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high)
+{
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+ unsigned char w4[_w4_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+ memcpy (w4, w4_, _w4_high+1);
+
+ if (! (mcOptions_getQuiet ()))
+ {
+ mcPrintf_printf4 ((const char *) a, _a_high, (const unsigned char *) w1, _w1_high, (const unsigned char *) w2, _w2_high, (const unsigned char *) w3, _w3_high, (const unsigned char *) w4, _w4_high);
+ }
+}
+
+extern "C" void _M2_mcQuiet_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcQuiet_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcReserved. */
+/* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _mcReserved_H
+#define _mcReserved_C
+
+
+typedef enum {mcReserved_eoftok, mcReserved_plustok, mcReserved_minustok, mcReserved_timestok, mcReserved_dividetok, mcReserved_becomestok, mcReserved_ambersandtok, mcReserved_periodtok, mcReserved_commatok, mcReserved_semicolontok, mcReserved_lparatok, mcReserved_rparatok, mcReserved_lsbratok, mcReserved_rsbratok, mcReserved_lcbratok, mcReserved_rcbratok, mcReserved_uparrowtok, mcReserved_singlequotetok, mcReserved_equaltok, mcReserved_hashtok, mcReserved_lesstok, mcReserved_greatertok, mcReserved_lessgreatertok, mcReserved_lessequaltok, mcReserved_greaterequaltok, mcReserved_ldirectivetok, mcReserved_rdirectivetok, mcReserved_periodperiodtok, mcReserved_colontok, mcReserved_doublequotestok, mcReserved_bartok, mcReserved_andtok, mcReserved_arraytok, mcReserved_begintok, mcReserved_bytok, mcReserved_casetok, mcReserved_consttok, mcReserved_definitiontok, mcReserved_divtok, mcReserved_dotok, mcReserved_elsetok, mcReserved_elsiftok, mcReserved_endtok, mcReserved_excepttok, mcReserved_exittok, mcReserved_exporttok, mcReserved_finallytok, mcReserved_fortok, mcReserved_fromtok, mcReserved_iftok, mcReserved_implementationtok, mcReserved_importtok, mcReserved_intok, mcReserved_looptok, mcReserved_modtok, mcReserved_moduletok, mcReserved_nottok, mcReserved_oftok, mcReserved_ortok, mcReserved_packedsettok, mcReserved_pointertok, mcReserved_proceduretok, mcReserved_qualifiedtok, mcReserved_unqualifiedtok, mcReserved_recordtok, mcReserved_remtok, mcReserved_repeattok, mcReserved_retrytok, mcReserved_returntok, mcReserved_settok, mcReserved_thentok, mcReserved_totok, mcReserved_typetok, mcReserved_untiltok, mcReserved_vartok, mcReserved_whiletok, mcReserved_withtok, mcReserved_asmtok, mcReserved_volatiletok, mcReserved_periodperiodperiodtok, mcReserved_datetok, mcReserved_linetok, mcReserved_filetok, mcReserved_attributetok, mcReserved_builtintok, mcReserved_inlinetok, mcReserved_integertok, mcReserved_identtok, mcReserved_realtok, mcReserved_stringtok, mcReserved_commenttok} mcReserved_toktype;
+
+
+extern "C" void _M2_mcReserved_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcReserved_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcSearch. */
+/* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcSearch_H
+#define _mcSearch_C
+
+# include "GSFIO.h"
+# include "GmcFileName.h"
+# include "GDynamicStrings.h"
+
+# define Directory '/'
+static DynamicStrings_String Def;
+static DynamicStrings_String Mod;
+static DynamicStrings_String UserPath;
+static DynamicStrings_String InitialPath;
+
+/*
+ initSearchPath - assigns the search path to Path.
+ The string Path may take the form:
+
+ Path ::= IndividualPath { ":" IndividualPath }
+ IndividualPath ::= "." | DirectoryPath
+ DirectoryPath ::= [ "/" ] Name { "/" Name }
+ Name ::= Letter { (Letter | Number) }
+ Letter ::= A..Z | a..z
+ Number ::= 0..9
+*/
+
+extern "C" void mcSearch_initSearchPath (DynamicStrings_String path);
+
+/*
+ prependSearchPath - prepends a new path to the initial search path.
+*/
+
+extern "C" void mcSearch_prependSearchPath (DynamicStrings_String path);
+
+/*
+ findSourceFile - attempts to locate the source file FileName.
+ If a file is found then TRUE is returned otherwise
+ FALSE is returned.
+ The parameter fullPath is set indicating the
+ absolute location of source FileName.
+ fullPath will be totally overwritten and should
+ not be initialized by InitString before this function
+ is called.
+ fullPath is set to NIL if this function returns FALSE.
+ findSourceFile sets fullPath to a new string if successful.
+ The string, FileName, is not altered.
+*/
+
+extern "C" unsigned int mcSearch_findSourceFile (DynamicStrings_String FileName, DynamicStrings_String *fullPath);
+
+/*
+ findSourceDefFile - attempts to find the definition module for
+ a module, stem. If successful it returns
+ the full path and returns TRUE. If unsuccessful
+ then FALSE is returned and fullPath is set to NIL.
+*/
+
+extern "C" unsigned int mcSearch_findSourceDefFile (DynamicStrings_String stem, DynamicStrings_String *fullPath);
+
+/*
+ findSourceModFile - attempts to find the implementation module for
+ a module, stem. If successful it returns
+ the full path and returns TRUE. If unsuccessful
+ then FALSE is returned and fullPath is set to NIL.
+*/
+
+extern "C" unsigned int mcSearch_findSourceModFile (DynamicStrings_String stem, DynamicStrings_String *fullPath);
+
+/*
+ setDefExtension - sets the default extension for definition modules to, ext.
+ The string, ext, should be deallocated by the caller at
+ an appropriate time.
+*/
+
+extern "C" void mcSearch_setDefExtension (DynamicStrings_String ext);
+
+/*
+ setModExtension - sets the default extension for implementation and program
+ modules to, ext. The string, ext, should be deallocated
+ by the caller at an appropriate time.
+*/
+
+extern "C" void mcSearch_setModExtension (DynamicStrings_String ext);
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void);
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s);
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void);
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s);
+
+/*
+ Init - initializes the search path.
+*/
+
+static void Init (void);
+
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void)
+{
+ DynamicStrings_PushAllocation ();
+}
+
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s)
+{
+ s = DynamicStrings_PopAllocationExemption (TRUE, s);
+}
+
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void)
+{
+}
+
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s)
+{
+}
+
+
+/*
+ Init - initializes the search path.
+*/
+
+static void Init (void)
+{
+ UserPath = DynamicStrings_InitString ((const char *) "", 0);
+ InitialPath = DynamicStrings_InitStringChar ('.');
+ Def = static_cast<DynamicStrings_String> (NULL);
+ Mod = static_cast<DynamicStrings_String> (NULL);
+}
+
+
+/*
+ initSearchPath - assigns the search path to Path.
+ The string Path may take the form:
+
+ Path ::= IndividualPath { ":" IndividualPath }
+ IndividualPath ::= "." | DirectoryPath
+ DirectoryPath ::= [ "/" ] Name { "/" Name }
+ Name ::= Letter { (Letter | Number) }
+ Letter ::= A..Z | a..z
+ Number ::= 0..9
+*/
+
+extern "C" void mcSearch_initSearchPath (DynamicStrings_String path)
+{
+ if (InitialPath != NULL)
+ {
+ InitialPath = DynamicStrings_KillString (InitialPath);
+ }
+ InitialPath = path;
+}
+
+
+/*
+ prependSearchPath - prepends a new path to the initial search path.
+*/
+
+extern "C" void mcSearch_prependSearchPath (DynamicStrings_String path)
+{
+ DSdbEnter ();
+ if (DynamicStrings_EqualArray (UserPath, (const char *) "", 0))
+ {
+ UserPath = DynamicStrings_KillString (UserPath);
+ UserPath = DynamicStrings_Dup (path);
+ }
+ else
+ {
+ UserPath = DynamicStrings_ConCat (DynamicStrings_ConCatChar (UserPath, ':'), path);
+ }
+ DSdbExit (UserPath);
+}
+
+
+/*
+ findSourceFile - attempts to locate the source file FileName.
+ If a file is found then TRUE is returned otherwise
+ FALSE is returned.
+ The parameter fullPath is set indicating the
+ absolute location of source FileName.
+ fullPath will be totally overwritten and should
+ not be initialized by InitString before this function
+ is called.
+ fullPath is set to NIL if this function returns FALSE.
+ findSourceFile sets fullPath to a new string if successful.
+ The string, FileName, is not altered.
+*/
+
+extern "C" unsigned int mcSearch_findSourceFile (DynamicStrings_String FileName, DynamicStrings_String *fullPath)
+{
+ DynamicStrings_String completeSearchPath;
+ int start;
+ int end;
+ DynamicStrings_String newpath;
+
+ if (DynamicStrings_EqualArray (UserPath, (const char *) "", 0))
+ {
+ if (DynamicStrings_EqualArray (InitialPath, (const char *) "", 0))
+ {
+ completeSearchPath = DynamicStrings_InitString ((const char *) ".", 1);
+ }
+ else
+ {
+ completeSearchPath = DynamicStrings_Dup (InitialPath);
+ }
+ }
+ else
+ {
+ completeSearchPath = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Dup (UserPath), ':'), InitialPath);
+ }
+ start = 0;
+ end = DynamicStrings_Index (completeSearchPath, ':', (unsigned int ) (start));
+ do {
+ if (end == -1)
+ {
+ end = 0;
+ }
+ newpath = DynamicStrings_Slice (completeSearchPath, start, end);
+ if (DynamicStrings_EqualArray (newpath, (const char *) ".", 1))
+ {
+ newpath = DynamicStrings_KillString (newpath);
+ newpath = DynamicStrings_Dup (FileName);
+ }
+ else
+ {
+ newpath = DynamicStrings_ConCat (DynamicStrings_ConCatChar (newpath, Directory), FileName);
+ }
+ if (SFIO_Exists (newpath))
+ {
+ (*fullPath) = newpath;
+ completeSearchPath = DynamicStrings_KillString (completeSearchPath);
+ return TRUE;
+ }
+ newpath = DynamicStrings_KillString (newpath);
+ if (end != 0)
+ {
+ start = end+1;
+ end = DynamicStrings_Index (completeSearchPath, ':', (unsigned int ) (start));
+ }
+ } while (! (end == 0));
+ (*fullPath) = static_cast<DynamicStrings_String> (NULL);
+ newpath = DynamicStrings_KillString (newpath);
+ completeSearchPath = DynamicStrings_KillString (completeSearchPath);
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ findSourceDefFile - attempts to find the definition module for
+ a module, stem. If successful it returns
+ the full path and returns TRUE. If unsuccessful
+ then FALSE is returned and fullPath is set to NIL.
+*/
+
+extern "C" unsigned int mcSearch_findSourceDefFile (DynamicStrings_String stem, DynamicStrings_String *fullPath)
+{
+ DynamicStrings_String f;
+
+ if (Def != NULL)
+ {
+ f = mcFileName_calculateFileName (stem, Def);
+ if (mcSearch_findSourceFile (f, fullPath))
+ {
+ return TRUE;
+ }
+ f = DynamicStrings_KillString (f);
+ }
+ /* and try the GNU Modula-2 default extension */
+ f = mcFileName_calculateFileName (stem, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "def", 3)));
+ return mcSearch_findSourceFile (f, fullPath);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ findSourceModFile - attempts to find the implementation module for
+ a module, stem. If successful it returns
+ the full path and returns TRUE. If unsuccessful
+ then FALSE is returned and fullPath is set to NIL.
+*/
+
+extern "C" unsigned int mcSearch_findSourceModFile (DynamicStrings_String stem, DynamicStrings_String *fullPath)
+{
+ DynamicStrings_String f;
+
+ if (Mod != NULL)
+ {
+ f = mcFileName_calculateFileName (stem, Mod);
+ if (mcSearch_findSourceFile (f, fullPath))
+ {
+ return TRUE;
+ }
+ f = DynamicStrings_KillString (f);
+ }
+ /* and try the GNU Modula-2 default extension */
+ f = mcFileName_calculateFileName (stem, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "mod", 3)));
+ return mcSearch_findSourceFile (f, fullPath);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ setDefExtension - sets the default extension for definition modules to, ext.
+ The string, ext, should be deallocated by the caller at
+ an appropriate time.
+*/
+
+extern "C" void mcSearch_setDefExtension (DynamicStrings_String ext)
+{
+ Def = DynamicStrings_KillString (Def);
+ Def = DynamicStrings_Dup (ext);
+}
+
+
+/*
+ setModExtension - sets the default extension for implementation and program
+ modules to, ext. The string, ext, should be deallocated
+ by the caller at an appropriate time.
+*/
+
+extern "C" void mcSearch_setModExtension (DynamicStrings_String ext)
+{
+ Mod = DynamicStrings_KillString (Mod);
+ Mod = DynamicStrings_Dup (ext);
+}
+
+extern "C" void _M2_mcSearch_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_mcSearch_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcStack. */
+/* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcStack_H
+#define _mcStack_C
+
+# include "GStorage.h"
+# include "GIndexing.h"
+# include "GM2RTS.h"
+
+typedef struct mcStack__T1_r mcStack__T1;
+
+typedef mcStack__T1 *mcStack_stack;
+
+struct mcStack__T1_r {
+ Indexing_Index list;
+ unsigned int count;
+ };
+
+
+/*
+ init - create and return a stack.
+*/
+
+extern "C" mcStack_stack mcStack_init (void);
+
+/*
+ kill - deletes stack, s.
+*/
+
+extern "C" void mcStack_kill (mcStack_stack *s);
+
+/*
+ push - an address, a, onto the stack, s.
+ It returns, a.
+*/
+
+extern "C" void * mcStack_push (mcStack_stack s, void * a);
+
+/*
+ pop - and return the top element from stack, s.
+*/
+
+extern "C" void * mcStack_pop (mcStack_stack s);
+
+/*
+ replace - performs a pop; push (a); return a.
+*/
+
+extern "C" void * mcStack_replace (mcStack_stack s, void * a);
+
+/*
+ depth - returns the depth of the stack.
+*/
+
+extern "C" unsigned int mcStack_depth (mcStack_stack s);
+
+/*
+ access - returns the, i, th stack element.
+ The top of stack is defined by:
+
+ access (s, depth (s)).
+*/
+
+extern "C" void * mcStack_access (mcStack_stack s, unsigned int i);
+
+
+/*
+ init - create and return a stack.
+*/
+
+extern "C" mcStack_stack mcStack_init (void)
+{
+ mcStack_stack s;
+
+ Storage_ALLOCATE ((void **) &s, sizeof (mcStack__T1));
+ s->list = Indexing_InitIndex (1);
+ s->count = 0;
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ kill - deletes stack, s.
+*/
+
+extern "C" void mcStack_kill (mcStack_stack *s)
+{
+ (*s)->list = Indexing_KillIndex ((*s)->list);
+ Storage_DEALLOCATE ((void **) &(*s), sizeof (mcStack__T1));
+ (*s) = NULL;
+}
+
+
+/*
+ push - an address, a, onto the stack, s.
+ It returns, a.
+*/
+
+extern "C" void * mcStack_push (mcStack_stack s, void * a)
+{
+ if (s->count == 0)
+ {
+ Indexing_PutIndice (s->list, Indexing_LowIndice (s->list), a);
+ }
+ else
+ {
+ Indexing_PutIndice (s->list, (Indexing_HighIndice (s->list))+1, a);
+ }
+ s->count += 1;
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ pop - and return the top element from stack, s.
+*/
+
+extern "C" void * mcStack_pop (mcStack_stack s)
+{
+ void * a;
+
+ if (s->count == 0)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ s->count -= 1;
+ a = Indexing_GetIndice (s->list, Indexing_HighIndice (s->list));
+ Indexing_DeleteIndice (s->list, Indexing_HighIndice (s->list));
+ return a;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/mcStack.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ replace - performs a pop; push (a); return a.
+*/
+
+extern "C" void * mcStack_replace (mcStack_stack s, void * a)
+{
+ void * b;
+
+ b = mcStack_pop (s);
+ return mcStack_push (s, a);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ depth - returns the depth of the stack.
+*/
+
+extern "C" unsigned int mcStack_depth (mcStack_stack s)
+{
+ return s->count;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ access - returns the, i, th stack element.
+ The top of stack is defined by:
+
+ access (s, depth (s)).
+*/
+
+extern "C" void * mcStack_access (mcStack_stack s, unsigned int i)
+{
+ if ((i > s->count) || (i == 0))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return Indexing_GetIndice (s->list, i);
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/mcStack.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcStack_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcStack_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcStream. */
+/* mcStream.mod provides an interface to create a file from fragments.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcStream_H
+#define _mcStream_C
+
+# include "GFIO.h"
+# include "Glibc.h"
+# include "GIndexing.h"
+# include "GDynamicStrings.h"
+# include "GFormatStrings.h"
+# include "GSYSTEM.h"
+# include "GStorage.h"
+# include "Galists.h"
+# include "GSFIO.h"
+# include "GM2RTS.h"
+
+typedef FIO_File *mcStream_ptrToFile;
+
+# define maxBuffer 4096
+static alists_alist listOfFiles;
+static Indexing_Index frag;
+static FIO_File destFile;
+static unsigned int seenDest;
+
+/*
+ openFrag - create and open fragment, id, and return the file.
+ The file should not be closed by the user.
+*/
+
+extern "C" FIO_File mcStream_openFrag (unsigned int id);
+
+/*
+ setDest - informs the stream module and all fragments must be copied
+ info, f.
+*/
+
+extern "C" void mcStream_setDest (FIO_File f);
+
+/*
+ combine - closes all fragments and then writes them in
+ order to the destination file. The dest file
+ is returned.
+*/
+
+extern "C" FIO_File mcStream_combine (void);
+
+/*
+ removeFiles - remove any fragment.
+*/
+
+extern "C" void mcStream_removeFiles (void);
+
+/*
+ removeLater -
+*/
+
+static DynamicStrings_String removeLater (DynamicStrings_String filename);
+
+/*
+ removeNow - removes a single file, s.
+*/
+
+static void removeNow (DynamicStrings_String s);
+
+/*
+ createTemporaryFile -
+*/
+
+static FIO_File createTemporaryFile (unsigned int id);
+
+/*
+ copy - copies contents of f to the destination file.
+*/
+
+static void copy (mcStream_ptrToFile p);
+
+
+/*
+ removeLater -
+*/
+
+static DynamicStrings_String removeLater (DynamicStrings_String filename)
+{
+ alists_includeItemIntoList (listOfFiles, reinterpret_cast<void *> (filename));
+ return filename;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ removeNow - removes a single file, s.
+*/
+
+static void removeNow (DynamicStrings_String s)
+{
+ if ((libc_unlink (DynamicStrings_string (s))) != 0)
+ {} /* empty. */
+}
+
+
+/*
+ createTemporaryFile -
+*/
+
+static FIO_File createTemporaryFile (unsigned int id)
+{
+ DynamicStrings_String s;
+ FIO_File f;
+ int p;
+
+ s = DynamicStrings_InitString ((const char *) "/tmp/frag-%d-%d.frag", 20);
+ p = libc_getpid ();
+ s = removeLater (FormatStrings_Sprintf2 (s, (const unsigned char *) &p, (sizeof (p)-1), (const unsigned char *) &id, (sizeof (id)-1)));
+ f = SFIO_OpenToWrite (s);
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ copy - copies contents of f to the destination file.
+*/
+
+static void copy (mcStream_ptrToFile p)
+{
+ typedef struct copy__T1_a copy__T1;
+
+ struct copy__T1_a { char array[maxBuffer+1]; };
+ copy__T1 buffer;
+ unsigned int b;
+ DynamicStrings_String s;
+ FIO_File f;
+
+ if (p != NULL)
+ {
+ f = (*p);
+ s = DynamicStrings_InitStringCharStar (FIO_getFileName (f));
+ FIO_Close (f);
+ f = SFIO_OpenToRead (s);
+ while (! (FIO_EOF (f)))
+ {
+ b = FIO_ReadNBytes (f, maxBuffer, &buffer);
+ b = FIO_WriteNBytes (destFile, b, &buffer);
+ }
+ FIO_Close (f);
+ }
+}
+
+
+/*
+ openFrag - create and open fragment, id, and return the file.
+ The file should not be closed by the user.
+*/
+
+extern "C" FIO_File mcStream_openFrag (unsigned int id)
+{
+ FIO_File f;
+ mcStream_ptrToFile p;
+
+ f = createTemporaryFile (id);
+ Storage_ALLOCATE ((void **) &p, sizeof (FIO_File));
+ (*p) = f;
+ Indexing_PutIndice (frag, id, reinterpret_cast<void *> (p));
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ setDest - informs the stream module and all fragments must be copied
+ info, f.
+*/
+
+extern "C" void mcStream_setDest (FIO_File f)
+{
+ seenDest = TRUE;
+ destFile = f;
+}
+
+
+/*
+ combine - closes all fragments and then writes them in
+ order to the destination file. The dest file
+ is returned.
+*/
+
+extern "C" FIO_File mcStream_combine (void)
+{
+ if (! seenDest)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ Indexing_ForeachIndiceInIndexDo (frag, (Indexing_IndexProcedure) {(Indexing_IndexProcedure_t) copy});
+ mcStream_removeFiles ();
+ return destFile;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ removeFiles - remove any fragment.
+*/
+
+extern "C" void mcStream_removeFiles (void)
+{
+ alists_foreachItemInListDo (listOfFiles, (alists_performOperation) {(alists_performOperation_t) removeNow});
+ alists_killList (&listOfFiles);
+ listOfFiles = alists_initList ();
+}
+
+extern "C" void _M2_mcStream_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ listOfFiles = alists_initList ();
+ seenDest = FALSE;
+ frag = Indexing_InitIndex (1);
+}
+
+extern "C" void _M2_mcStream_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcp1. */
+/* output from mc-1.bnf, automatically generated do not edit.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING. If not,
+see <https://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcp1_H
+#define _mcp1_C
+
+# include "GDynamicStrings.h"
+# include "GmcError.h"
+# include "GnameKey.h"
+# include "GmcPrintf.h"
+# include "GmcDebug.h"
+# include "GmcReserved.h"
+# include "GmcComment.h"
+# include "GmcLexBuf.h"
+# include "Gdecl.h"
+
+# define Pass1 TRUE
+# define Debugging FALSE
+typedef unsigned int mcp1_stop0;
+
+typedef unsigned int mcp1_SetOfStop0;
+
+typedef unsigned int mcp1_stop1;
+
+typedef unsigned int mcp1_SetOfStop1;
+
+typedef unsigned int mcp1_stop2;
+
+typedef unsigned int mcp1_SetOfStop2;
+
+static unsigned int WasNoError;
+static nameKey_Name curident;
+static decl_node curproc;
+static decl_node curmodule;
+
+/*
+ CompilationUnit - returns TRUE if the input was correct enough to parse
+ in future passes.
+*/
+
+extern "C" unsigned int mcp1_CompilationUnit (void);
+static void ErrorString (DynamicStrings_String s);
+static void ErrorArray (const char *a_, unsigned int _a_high);
+
+/*
+ checkEndName - if module does not have, name, then issue an error containing, desc.
+*/
+
+static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high);
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void);
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*/
+
+static void WarnMissingToken (mcReserved_toktype t);
+
+/*
+ MissingToken - generates a warning message about a missing token, t.
+*/
+
+static void MissingToken (mcReserved_toktype t);
+
+/*
+ CheckAndInsert -
+*/
+
+static unsigned int CheckAndInsert (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ InStopSet
+*/
+
+static unsigned int InStopSet (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
+ If it is not then it will insert a token providing the token
+ is one of ; ] ) } . OF END ,
+
+ if the stopset contains <identtok> then we do not insert a token
+*/
+
+static void PeepToken (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Expect -
+*/
+
+static void Expect (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ string -
+*/
+
+static void string (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Integer -
+*/
+
+static void Integer (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Real -
+*/
+
+static void Real (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ registerImport - looks up module, ident, and adds it to the
+ current module import list.
+*/
+
+static void registerImport (nameKey_Name ident, unsigned int scoped);
+
+/*
+ FileUnit := DefinitionModule |
+ ImplementationOrProgramModule
+
+ first symbols:implementationtok, moduletok, definitiontok
+
+ cannot reachend
+*/
+
+static void FileUnit (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ProgramModule := 'MODULE' Ident
+ % curmodule := lookupModule (curident) %
+
+ % enterScope (curmodule) %
+ [ Priority ] ';' { Import } Block
+ Ident
+ % checkEndName (curmodule, curident, 'program module') %
+
+ % leaveScope %
+ '.'
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ProgramModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ImplementationModule := 'IMPLEMENTATION' 'MODULE'
+ Ident
+ % curmodule := lookupImp (curident) %
+
+ % enterScope (lookupDef (curident)) %
+
+ % enterScope (curmodule) %
+ [ Priority ] ';' { Import }
+ Block Ident
+ % checkEndName (curmodule, curident, 'implementation module') %
+
+ % leaveScope ; leaveScope %
+ '.'
+
+ first symbols:implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ImplementationOrProgramModule := ImplementationModule |
+ ProgramModule
+
+ first symbols:moduletok, implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationOrProgramModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Number := Integer | Real
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void Number (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Qualident := Ident { '.' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Qualident (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Relation := '=' | '#' | '<>' | '<' | '<=' |
+ '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void Relation (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SimpleConstExpr := UnaryOrConstTerm { AddOperator
+ ConstTerm }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleConstExpr (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ UnaryOrConstTerm := '+' ConstTerm |
+ '-' ConstTerm |
+ ConstTerm
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void AddOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ConstTerm := ConstFactor { MulOperator ConstFactor }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void ConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ MulOperator := '*' | '/' | 'DIV' | 'MOD' |
+ 'REM' | 'AND' | '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void MulOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ConstFactor := Number | ConstString |
+ ConstSetOrQualidentOrFunction |
+ '(' ConstExpression ')' |
+ 'NOT' ConstFactor |
+ ConstAttribute
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void ConstFactor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void ConstString (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ComponentElement := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ComponentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ComponentValue := ComponentElement [ 'BY' ConstExpression ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ComponentValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArraySetRecordValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Constructor := '{' [ ArraySetRecordValue ] '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void Constructor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ConstSetOrQualidentOrFunction := Qualident [ Constructor |
+ ConstActualParameters ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void ConstSetOrQualidentOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ConstActualParameters := ActualParameters
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ConstActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' ConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void ConstAttribute (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ConstAttributeExpression := Ident | '<' Qualident
+ ',' Ident '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void ConstAttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ByteAlignment := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void ByteAlignment (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ OptAlignmentExpression := [ AlignmentExpression ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void OptAlignmentExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AlignmentExpression := '(' ConstExpression ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void AlignmentExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Alignment := [ ByteAlignment ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void Alignment (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ TypeDeclaration := Ident
+ % VAR n: node ; %
+
+ % n := makeTypeImp (curident) %
+ '=' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void TypeDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Type := ( SimpleType | ArrayType | RecordType |
+ SetType | PointerType |
+ ProcedureType )
+
+ first symbols:lparatok, lsbratok, proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok
+
+ cannot reachend
+*/
+
+static void Type (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SimpleType := Qualident [ SubrangeType ] |
+ Enumeration | SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void SimpleType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Enumeration := '(' ( IdentList ) ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void Enumeration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ IdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void IdentList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SubrangeType := '[' ConstExpression '..' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void SubrangeType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ArrayType := 'ARRAY' SimpleType { ',' SimpleType }
+ 'OF' Type
+
+ first symbols:arraytok
+
+ cannot reachend
+*/
+
+static void ArrayType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ RecordType := 'RECORD' [ DefaultRecordAttributes ]
+ FieldListSequence 'END'
+
+ first symbols:recordtok
+
+ cannot reachend
+*/
+
+static void RecordType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ DefaultRecordAttributes := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void DefaultRecordAttributes (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ RecordFieldPragma := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void RecordFieldPragma (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FieldPragmaExpression := Ident PragmaConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FieldPragmaExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ PragmaConstExpression := [ '(' ConstExpression ')' ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void PragmaConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AttributeExpression := Ident '(' ConstExpression
+ ')'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FieldListSequence := FieldListStatement { ';' FieldListStatement }
+
+ first symbols:casetok, identtok, semicolontok
+
+ reachend
+*/
+
+static void FieldListSequence (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FieldListStatement := [ FieldList ]
+
+ first symbols:identtok, casetok
+
+ reachend
+*/
+
+static void FieldListStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FieldList := IdentList ':' Type RecordFieldPragma |
+ 'CASE' CaseTag 'OF' Varient { '|' Varient }
+ [ 'ELSE' FieldListSequence ] 'END'
+
+ first symbols:casetok, identtok
+
+ cannot reachend
+*/
+
+static void FieldList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ TagIdent := [ Ident ]
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TagIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ CaseTag := TagIdent [ ':' Qualident ]
+
+ first symbols:colontok, identtok
+
+ reachend
+*/
+
+static void CaseTag (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Varient := [ VarientCaseLabelList ':' FieldListSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Varient (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ VarientCaseLabelList := VarientCaseLabels { ','
+ VarientCaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabelList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ VarientCaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabels (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentConstExpression := SilentSimpleConstExpr [
+ SilentRelation SilentSimpleConstExpr ]
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentRelation := '=' | '#' | '<>' | '<' |
+ '<=' | '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void SilentRelation (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentSimpleConstExpr := SilentUnaryOrConstTerm
+ { SilentAddOperator SilentConstTerm }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentSimpleConstExpr (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentUnaryOrConstTerm := '+' SilentConstTerm |
+ '-' SilentConstTerm |
+ SilentConstTerm
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentUnaryOrConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentAddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentAddOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentConstTerm := SilentConstFactor { SilentMulOperator
+ SilentConstFactor }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void SilentConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentMulOperator := '*' | '/' | 'DIV' |
+ 'MOD' | 'REM' | 'AND' |
+ '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void SilentMulOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentConstFactor := Number | SilentConstString |
+ SilentConstSetOrQualidentOrFunction |
+ '(' SilentConstExpression ')' |
+ 'NOT' SilentConstFactor |
+ SilentConstAttribute
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void SilentConstFactor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void SilentConstString (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' SilentConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void SilentConstAttribute (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentConstAttributeExpression := Ident |
+ '<' Ident ','
+ SilentConstString
+ '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void SilentConstAttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentComponentElement := SilentConstExpression
+ [ '..' SilentConstExpression ]
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentComponentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentComponentValue := SilentComponentElement [
+ 'BY' SilentConstExpression ]
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentComponentValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentArraySetRecordValue := SilentComponentValue
+ { ',' SilentComponentValue }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentArraySetRecordValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentConstructor := '{' [ SilentArraySetRecordValue ]
+ '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void SilentConstructor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentConstSetOrQualidentOrFunction := SilentConstructor |
+ Qualident
+ [ SilentConstructor |
+ SilentActualParameters ]
+
+ first symbols:identtok, lcbratok
+
+ cannot reachend
+*/
+
+static void SilentConstSetOrQualidentOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentElement := SilentConstExpression [ '..' SilentConstExpression ]
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentActualParameters := '(' [ SilentExpList ]
+ ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void SilentActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SilentExpList := SilentConstExpression { ',' SilentConstExpression }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType
+
+ first symbols:oftok, packedsettok, settok
+
+ cannot reachend
+*/
+
+static void SetType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ PointerType := 'POINTER' 'TO' Type
+
+ first symbols:pointertok
+
+ cannot reachend
+*/
+
+static void PointerType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ProcedureType := 'PROCEDURE' [ FormalTypeList ]
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FormalTypeList := '(' ( ')' FormalReturn |
+ ProcedureParameters ')'
+ FormalReturn )
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalTypeList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FormalReturn := [ ':' OptReturnType ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void FormalReturn (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ OptReturnType := '[' Qualident ']' |
+ Qualident
+
+ first symbols:identtok, lsbratok
+
+ cannot reachend
+*/
+
+static void OptReturnType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ProcedureParameters := ProcedureParameter { ','
+ ProcedureParameter }
+
+ first symbols:identtok, arraytok, periodperiodperiodtok, vartok
+
+ cannot reachend
+*/
+
+static void ProcedureParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ProcedureParameter := '...' | 'VAR' FormalType |
+ FormalType
+
+ first symbols:arraytok, identtok, vartok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ProcedureParameter (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ VarIdent := Ident
+ % VAR n: node ; %
+
+ % n := makeVar (curident) %
+ [ '[' ConstExpression ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ VarIdentList := VarIdent { ',' VarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdentList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ VariableDeclaration := VarIdentList ':' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VariableDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Designator := Qualident { SubDesignator }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Designator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SubDesignator := '.' Ident | '[' ArrayExpList ']' |
+ '^'
+
+ first symbols:uparrowtok, lsbratok, periodtok
+
+ cannot reachend
+*/
+
+static void SubDesignator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ArrayExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArrayExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Expression := SimpleExpression [ Relation SimpleExpression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void Expression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SimpleExpression := UnaryOrTerm { AddOperator Term }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ UnaryOrTerm := '+' Term | '-' Term |
+ Term
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Term := Factor { MulOperator Factor }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void Term (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Factor := Number | string | SetOrDesignatorOrFunction |
+ '(' Expression ')' |
+ 'NOT' ( Factor | ConstAttribute )
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void Factor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SetOrDesignatorOrFunction := Qualident [ Constructor |
+ SimpleDes
+ [ ActualParameters ] ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void SetOrDesignatorOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ SimpleDes := { SubDesignator }
+
+ first symbols:periodtok, lsbratok, uparrowtok
+
+ reachend
+*/
+
+static void SimpleDes (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ActualParameters := '(' [ ExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ExitStatement := 'EXIT'
+
+ first symbols:exittok
+
+ cannot reachend
+*/
+
+static void ExitStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ReturnStatement := 'RETURN' [ Expression ]
+
+ first symbols:returntok
+
+ cannot reachend
+*/
+
+static void ReturnStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Statement := [ AssignmentOrProcedureCall |
+ IfStatement | CaseStatement |
+ WhileStatement |
+ RepeatStatement |
+ LoopStatement | ForStatement |
+ WithStatement | AsmStatement |
+ ExitStatement | ReturnStatement |
+ RetryStatement ]
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok
+
+ reachend
+*/
+
+static void Statement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ RetryStatement := 'RETRY'
+
+ first symbols:retrytok
+
+ cannot reachend
+*/
+
+static void RetryStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AssignmentOrProcedureCall := Designator ( ':=' Expression |
+ ActualParameters |
+
+ % epsilon %
+ )
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AssignmentOrProcedureCall (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ StatementSequence := Statement { ';' Statement }
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok
+
+ reachend
+*/
+
+static void StatementSequence (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ IfStatement := 'IF' Expression 'THEN' StatementSequence
+ { 'ELSIF' Expression 'THEN' StatementSequence }
+ [ 'ELSE' StatementSequence ] 'END'
+
+ first symbols:iftok
+
+ cannot reachend
+*/
+
+static void IfStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ CaseStatement := 'CASE' Expression 'OF' Case { '|'
+ Case }
+ CaseEndStatement
+
+ first symbols:casetok
+
+ cannot reachend
+*/
+
+static void CaseStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ CaseEndStatement := 'END' | 'ELSE' StatementSequence
+ 'END'
+
+ first symbols:elsetok, endtok
+
+ cannot reachend
+*/
+
+static void CaseEndStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Case := [ CaseLabelList ':' StatementSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Case (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ CaseLabelList := CaseLabels { ',' CaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void CaseLabelList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ CaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void CaseLabels (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ WhileStatement := 'WHILE' Expression 'DO' StatementSequence
+ 'END'
+
+ first symbols:whiletok
+
+ cannot reachend
+*/
+
+static void WhileStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ RepeatStatement := 'REPEAT' StatementSequence 'UNTIL'
+ Expression
+
+ first symbols:repeattok
+
+ cannot reachend
+*/
+
+static void RepeatStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ForStatement := 'FOR' Ident ':=' Expression 'TO'
+ Expression [ 'BY' ConstExpression ]
+ 'DO' StatementSequence 'END'
+
+ first symbols:fortok
+
+ cannot reachend
+*/
+
+static void ForStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ LoopStatement := 'LOOP' StatementSequence 'END'
+
+ first symbols:looptok
+
+ cannot reachend
+*/
+
+static void LoopStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ WithStatement := 'WITH' Designator 'DO' StatementSequence
+ 'END'
+
+ first symbols:withtok
+
+ cannot reachend
+*/
+
+static void WithStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock
+ Ident
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ DefProcedureIdent := Ident
+ % curproc := makeProcedure (curident) ;
+ setProcedureComment (lastcomment, curident) ;
+ putCommentDefProcedure (curproc) ;
+ %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefProcedureIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ProcedureIdent := Ident
+ % curproc := lookupSym (curident) ;
+ IF curproc=NIL
+ THEN
+ curproc := makeProcedure (curident)
+ END ;
+ setProcedureComment (lastcomment, curident) ;
+ putCommentModProcedure (curproc) ;
+ %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ProcedureIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' Ident ')' ')' |
+ '__INLINE__' ]
+
+ first symbols:inlinetok, attributetok
+
+ reachend
+*/
+
+static void DefineBuiltinProcedure (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure
+ ( ProcedureIdent
+ % enterScope (curproc) %
+ [ FormalParameters ] AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureHeading (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Builtin := [ '__BUILTIN__' | '__INLINE__' ]
+
+ first symbols:inlinetok, builtintok
+
+ reachend
+*/
+
+static void Builtin (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent
+ [ DefFormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void DefProcedureHeading (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ]
+ 'END'
+ % leaveScope %
+
+
+ first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok
+
+ cannot reachend
+*/
+
+static void ProcedureBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Block := { Declaration } InitialBlock FinalBlock
+ 'END'
+
+ first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok
+
+ cannot reachend
+*/
+
+static void Block (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ InitialBlock := [ 'BEGIN' InitialBlockBody ]
+
+ first symbols:begintok
+
+ reachend
+*/
+
+static void InitialBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FinalBlock := [ 'FINALLY' FinalBlockBody ]
+
+ first symbols:finallytok
+
+ reachend
+*/
+
+static void FinalBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void InitialBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void FinalBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void ProcedureBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ NormalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void NormalPart (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ExceptionalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ExceptionalPart (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Declaration := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration ';' } |
+ 'VAR' { VariableDeclaration ';' } |
+ ProcedureDeclaration ';' |
+ ModuleDeclaration ';'
+
+ first symbols:moduletok, proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Declaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ DefFormalParameters := '(' [ DefMultiFPSection ]
+ ')' FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefFormalParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ DefMultiFPSection := DefExtendedFP |
+ FPSection [ ';' DefMultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefMultiFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FormalParameters := '(' [ MultiFPSection ] ')'
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AttributeNoReturn := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeNoReturn (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AttributeUnused := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeUnused (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ MultiFPSection := ExtendedFP | FPSection [ ';'
+ MultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void MultiFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FPSection := NonVarFPSection |
+ VarFPSection
+
+ first symbols:vartok, identtok
+
+ cannot reachend
+*/
+
+static void FPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ DefExtendedFP := DefOptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefExtendedFP (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ExtendedFP := OptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ExtendedFP (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ VarFPSection := 'VAR' IdentList ':' FormalType [
+ AttributeUnused ]
+
+ first symbols:vartok
+
+ cannot reachend
+*/
+
+static void VarFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void NonVarFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ]
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void OptArg (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ DefOptArg := '[' Ident ':' FormalType '=' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void DefOptArg (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FormalType := { 'ARRAY' 'OF' } Qualident
+
+ first symbols:identtok, arraytok
+
+ cannot reachend
+*/
+
+static void FormalType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ModuleDeclaration := 'MODULE' Ident [ Priority ]
+ ';' { Import } [ Export ]
+ Block Ident
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ModuleDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Priority := '[' ConstExpression ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void Priority (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Export := 'EXPORT' ( 'QUALIFIED' IdentList |
+ 'UNQUALIFIED' IdentList |
+ IdentList ) ';'
+
+ first symbols:exporttok
+
+ cannot reachend
+*/
+
+static void Export (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ FromImport := 'FROM' Ident
+ % registerImport (curident, FALSE) %
+ 'IMPORT' IdentList ';'
+
+ first symbols:fromtok
+
+ cannot reachend
+*/
+
+static void FromImport (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ImportModuleList := Ident
+ % registerImport (curident, TRUE) %
+ { ',' Ident
+ % registerImport (curident, TRUE) %
+ }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ImportModuleList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ WithoutFromImport := 'IMPORT' ImportModuleList ';'
+
+ first symbols:importtok
+
+ cannot reachend
+*/
+
+static void WithoutFromImport (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Import := FromImport | WithoutFromImport
+
+ first symbols:importtok, fromtok
+
+ cannot reachend
+*/
+
+static void Import (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ DefinitionModule :=
+ % VAR c: BOOLEAN ; %
+
+ % c := FALSE %
+ 'DEFINITION' 'MODULE' [ 'FOR'
+ string
+
+ % c := TRUE %
+ ] Ident
+ ';'
+ % curmodule := lookupDef (curident) %
+
+ % IF c THEN putDefForC (curmodule) END %
+
+ % enterScope (curmodule) %
+ { Import } [ Export ] { Definition }
+ 'END' Ident '.'
+ % checkEndName (curmodule, curident, 'definition module') %
+
+ % leaveScope %
+
+
+ first symbols:definitiontok
+
+ cannot reachend
+*/
+
+static void DefinitionModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ DefTypeDeclaration := { Ident
+ % VAR n: node ; %
+
+ % n := makeType (curident) %
+ ( ';'
+ % putTypeHidden (n) %
+ | '=' Type Alignment
+ ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void DefTypeDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ ConstantDeclaration := Ident
+ % VAR n: node ; %
+
+ % n := makeConst (curident) %
+ '=' ConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ConstantDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ Definition := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { DefTypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ DefProcedureHeading ';'
+
+ first symbols:proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Definition (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands
+ ')'
+
+ first symbols:asmtok
+
+ cannot reachend
+*/
+
+static void AsmStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AsmOperands := string [ AsmOperandSpec ]
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void AsmOperands (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AsmOperandSpec := [ ':' AsmList [ ':' AsmList [
+ ':' TrashList ] ] ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void AsmOperandSpec (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AsmList := [ AsmElement ] { ',' AsmElement }
+
+ first symbols:lsbratok, stringtok, commatok
+
+ reachend
+*/
+
+static void AsmList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ NamedOperand := '[' Ident ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void NamedOperand (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AsmOperandName := [ NamedOperand ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void AsmOperandName (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ AsmElement := AsmOperandName string '(' Expression
+ ')'
+
+ first symbols:stringtok, lsbratok
+
+ cannot reachend
+*/
+
+static void AsmElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+/*
+ TrashList := [ string ] { ',' string }
+
+ first symbols:commatok, stringtok
+
+ reachend
+*/
+
+static void TrashList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2);
+
+static void ErrorString (DynamicStrings_String s)
+{
+ mcError_errorStringAt (s, mcLexBuf_getTokenNo ());
+ WasNoError = FALSE;
+}
+
+static void ErrorArray (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ ErrorString (DynamicStrings_InitString ((const char *) a, _a_high));
+}
+
+
+/*
+ checkEndName - if module does not have, name, then issue an error containing, desc.
+*/
+
+static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high)
+{
+ DynamicStrings_String s;
+ char desc[_desc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (desc, desc_, _desc_high+1);
+
+ if ((decl_getSymName (module)) != name)
+ {
+ s = DynamicStrings_InitString ((const char *) "inconsistent module name found with this ", 41);
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) desc, _desc_high)));
+ ErrorString (s);
+ }
+}
+
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ unsigned int n;
+ DynamicStrings_String str;
+ DynamicStrings_String message;
+
+ n = 0;
+ message = DynamicStrings_InitString ((const char *) "", 0);
+ if ((((1 << (mcReserved_stringtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "string", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_realtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "real number", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_identtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_integertok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "integer number", 14)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_inlinetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__INLINE__", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_builtintok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__BUILTIN__", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_attributetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__ATTRIBUTE__", 13)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_filetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__FILE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_linetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__LINE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_datetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__DATE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "...", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_volatiletok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VOLATILE", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_asmtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ASM", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_withtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WITH", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_whiletok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WHILE", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_vartok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VAR", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_untiltok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNTIL", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_typetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TYPE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_totok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TO", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_thentok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "THEN", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_settok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "SET", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_returntok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETURN", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_retrytok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETRY", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_repeattok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REPEAT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_remtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REM", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_recordtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RECORD", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_unqualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNQUALIFIED", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "QUALIFIED", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_proceduretok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PROCEDURE", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_pointertok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "POINTER", 7)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_packedsettok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PACKEDSET", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ortok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OR", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_oftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OF", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_nottok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "NOT", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_moduletok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MODULE", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_modtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MOD", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_looptok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "LOOP", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_intok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IN", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_importtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPORT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_implementationtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPLEMENTATION", 14)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_iftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IF", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_fromtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FROM", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_fortok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FOR", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_finallytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FINALLY", 7)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_exporttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXPORT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_exittok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXIT", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_excepttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXCEPT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_endtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "END", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_elsiftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSIF", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_elsetok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_dotok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DO", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_divtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DIV", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_definitiontok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DEFINITION", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_consttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CONST", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_casetok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CASE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_bytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BY", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_begintok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BEGIN", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_arraytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ARRAY", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_andtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "AND", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_colontok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodperiodtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "..", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*>", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<*", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lessequaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<>", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_hashtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "#", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_equaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "^", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_semicolontok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ";", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_commatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ",", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "&", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_dividetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "/", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_timestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_minustok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_plustok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "+", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_doublequotestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ',');
+ n += 1;
+ }
+ if ((((1 << (mcReserved_singlequotetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ',');
+ n += 1;
+ }
+ if ((((1 << (mcReserved_greatertok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lesstok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rparatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lparatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rcbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lcbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rsbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lsbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_bartok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_becomestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_eoftok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {} /* empty. */
+ /* eoftok has no token name (needed to generate error messages) */
+ if (n == 0)
+ {
+ str = DynamicStrings_InitString ((const char *) " syntax error", 13);
+ message = DynamicStrings_KillString (message);
+ }
+ else if (n == 1)
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message);
+ message = DynamicStrings_KillString (message);
+ }
+ return str;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void)
+{
+ DynamicStrings_String str;
+
+ str = DynamicStrings_InitString ((const char *) "", 0);
+ switch (mcLexBuf_currenttoken)
+ {
+ case mcReserved_stringtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found string", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_realtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found real number", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_identtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_integertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found integer number", 34), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_inlinetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __INLINE__", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_builtintok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __BUILTIN__", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_attributetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __ATTRIBUTE__", 33), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_filetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __FILE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_linetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __LINE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_datetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __DATE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodperiodperiodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ...", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_volatiletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VOLATILE", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_asmtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ASM", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_withtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WITH", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_whiletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WHILE", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_vartok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VAR", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_untiltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNTIL", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_typetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TYPE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_totok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TO", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_thentok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found THEN", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_settok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found SET", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_returntok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETURN", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_retrytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETRY", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_repeattok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REPEAT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_remtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REM", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_recordtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RECORD", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_unqualifiedtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNQUALIFIED", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_qualifiedtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found QUALIFIED", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_proceduretok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PROCEDURE", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_pointertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found POINTER", 27), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_packedsettok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PACKEDSET", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ortok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OR", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_oftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OF", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_nottok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found NOT", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_moduletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MODULE", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_modtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MOD", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_looptok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found LOOP", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_intok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IN", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_importtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPORT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_implementationtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPLEMENTATION", 34), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_iftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IF", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_fromtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FROM", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_fortok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FOR", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_finallytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FINALLY", 27), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_exporttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXPORT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_exittok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXIT", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_excepttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXCEPT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_endtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found END", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_elsiftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSIF", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_elsetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_dotok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DO", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_divtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DIV", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_definitiontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DEFINITION", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_consttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CONST", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_casetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CASE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_bytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BY", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_begintok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BEGIN", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_arraytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ARRAY", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_andtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found AND", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_colontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodperiodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ..", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rdirectivetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *>", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ldirectivetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <*", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_greaterequaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lessequaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lessgreatertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <>", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_hashtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found #", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_equaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_uparrowtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ^", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_semicolontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ;", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_commatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ,", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found .", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ambersandtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found &", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_dividetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found /", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_timestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_minustok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found -", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_plustok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found +", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_doublequotestok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_singlequotetok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_greatertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lesstok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rcbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lcbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rsbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lsbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_bartok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_becomestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_eoftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str));
+ break;
+
+
+ default:
+ break;
+ }
+ ErrorString (str);
+}
+
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ DescribeError ();
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "\\nskipping token *** ", 21);
+ }
+ /*
+ yes the ORD(currenttoken) looks ugly, but it is *much* safer than
+ using currenttoken<sometok as a change to the ordering of the
+ token declarations below would cause this to break. Using ORD() we are
+ immune from such changes
+ */
+ while (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0)))))
+ {
+ mcLexBuf_getToken ();
+ }
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) " ***\\n", 6);
+ }
+}
+
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ /* and again (see above re: ORD)
+ */
+ if (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0)))))
+ {
+ SyntaxError (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*/
+
+static void WarnMissingToken (mcReserved_toktype t)
+{
+ mcp1_SetOfStop0 s0;
+ mcp1_SetOfStop1 s1;
+ mcp1_SetOfStop2 s2;
+ DynamicStrings_String str;
+
+ s0 = (mcp1_SetOfStop0) 0;
+ s1 = (mcp1_SetOfStop1) 0;
+ s2 = (mcp1_SetOfStop2) 0;
+ if ( ((unsigned int) (t)) < 32)
+ {
+ s0 = (mcp1_SetOfStop0) ((1 << (t-mcReserved_eoftok)));
+ }
+ else if ( ((unsigned int) (t)) < 64)
+ {
+ /* avoid dangling else. */
+ s1 = (mcp1_SetOfStop1) ((1 << (t-mcReserved_arraytok)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ s2 = (mcp1_SetOfStop2) ((1 << (t-mcReserved_recordtok)));
+ }
+ str = DescribeStop (s0, s1, s2);
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error,", 13), DynamicStrings_Mark (str));
+ mcError_errorStringAt (str, mcLexBuf_getTokenNo ());
+}
+
+
+/*
+ MissingToken - generates a warning message about a missing token, t.
+*/
+
+static void MissingToken (mcReserved_toktype t)
+{
+ WarnMissingToken (t);
+ if ((((t != mcReserved_identtok) && (t != mcReserved_integertok)) && (t != mcReserved_realtok)) && (t != mcReserved_stringtok))
+ {
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "inserting token\\n", 17);
+ }
+ mcLexBuf_insertToken (t);
+ }
+}
+
+
+/*
+ CheckAndInsert -
+*/
+
+static unsigned int CheckAndInsert (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0))))
+ {
+ WarnMissingToken (t);
+ mcLexBuf_insertTokenAndRewind (t);
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InStopSet
+*/
+
+static unsigned int InStopSet (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0))))
+ {
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
+ If it is not then it will insert a token providing the token
+ is one of ; ] ) } . OF END ,
+
+ if the stopset contains <identtok> then we do not insert a token
+*/
+
+static void PeepToken (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ /* and again (see above re: ORD)
+ */
+ if ((! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) && (! (InStopSet (mcReserved_identtok, stopset0, stopset1, stopset2))))
+ {
+ /* SyntaxCheck would fail since currentoken is not part of the stopset
+ we check to see whether any of currenttoken might be a commonly omitted token */
+ if ((((((((CheckAndInsert (mcReserved_semicolontok, stopset0, stopset1, stopset2)) || (CheckAndInsert (mcReserved_rsbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rparatok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rcbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_periodtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_oftok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_endtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_commatok, stopset0, stopset1, stopset2)))
+ {} /* empty. */
+ }
+}
+
+
+/*
+ Expect -
+*/
+
+static void Expect (mcReserved_toktype t, mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == t)
+ {
+ /* avoid dangling else. */
+ mcLexBuf_getToken ();
+ if (Pass1)
+ {
+ PeepToken (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ MissingToken (t);
+ }
+ SyntaxCheck (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ curident = nameKey_makekey (mcLexBuf_currentstring);
+ /*
+ PushTF(makekey(currentstring), identtok)
+ */
+ Expect (mcReserved_identtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ string -
+*/
+
+static void string (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ /*
+ PushTF(makekey(currentstring), stringtok) ;
+ BuildString
+ */
+ Expect (mcReserved_stringtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Integer -
+*/
+
+static void Integer (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ /*
+ PushTF(makekey(currentstring), integertok) ;
+ BuildNumber
+ */
+ Expect (mcReserved_integertok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Real -
+*/
+
+static void Real (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ /*
+ PushTF(makekey(currentstring), realtok) ;
+ BuildNumber
+ */
+ Expect (mcReserved_realtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ registerImport - looks up module, ident, and adds it to the
+ current module import list.
+*/
+
+static void registerImport (nameKey_Name ident, unsigned int scoped)
+{
+ decl_node n;
+
+ n = decl_lookupDef (ident);
+ decl_addImportedModule (decl_getCurrentModule (), n, scoped);
+}
+
+
+/*
+ FileUnit := DefinitionModule |
+ ImplementationOrProgramModule
+
+ first symbols:implementationtok, moduletok, definitiontok
+
+ cannot reachend
+*/
+
+static void FileUnit (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_definitiontok)
+ {
+ DefinitionModule (stopset0, stopset1, stopset2);
+ }
+ else if (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_implementationtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ ImplementationOrProgramModule (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IMPLEMENTATION MODULE DEFINITION", 50);
+ }
+}
+
+
+/*
+ ProgramModule := 'MODULE' Ident
+ % curmodule := lookupModule (curident) %
+
+ % enterScope (curmodule) %
+ [ Priority ] ';' { Import } Block
+ Ident
+ % checkEndName (curmodule, curident, 'program module') %
+
+ % leaveScope %
+ '.'
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ProgramModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ curmodule = decl_lookupModule (curident);
+ decl_enterScope (curmodule);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ Block (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "program module", 14);
+ decl_leaveScope ();
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImplementationModule := 'IMPLEMENTATION' 'MODULE'
+ Ident
+ % curmodule := lookupImp (curident) %
+
+ % enterScope (lookupDef (curident)) %
+
+ % enterScope (curmodule) %
+ [ Priority ] ';' { Import }
+ Block Ident
+ % checkEndName (curmodule, curident, 'implementation module') %
+
+ % leaveScope ; leaveScope %
+ '.'
+
+ first symbols:implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_implementationtok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ curmodule = decl_lookupImp (curident);
+ decl_enterScope (decl_lookupDef (curident));
+ decl_enterScope (curmodule);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ Block (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "implementation module", 21);
+ decl_leaveScope ();
+ decl_leaveScope ();
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImplementationOrProgramModule := ImplementationModule |
+ ProgramModule
+
+ first symbols:moduletok, implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationOrProgramModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_implementationtok)
+ {
+ ImplementationModule (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ ProgramModule (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: MODULE IMPLEMENTATION", 39);
+ }
+}
+
+
+/*
+ Number := Integer | Real
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void Number (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_integertok)
+ {
+ Integer (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_realtok)
+ {
+ /* avoid dangling else. */
+ Real (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: real number integer number", 44);
+ }
+}
+
+
+/*
+ Qualident := Ident { '.' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Qualident (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ SimpleConstExpr (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SimpleConstExpr (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Relation := '=' | '#' | '<>' | '<' | '<=' |
+ '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void Relation (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_hashtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_hashtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_intok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_intok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37);
+ }
+}
+
+
+/*
+ SimpleConstExpr := UnaryOrConstTerm { AddOperator
+ ConstTerm }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleConstExpr (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ UnaryOrConstTerm (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ AddOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ UnaryOrConstTerm := '+' ConstTerm |
+ '-' ConstTerm |
+ ConstTerm
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ identifier { string - +", 88);
+ }
+}
+
+
+/*
+ AddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void AddOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ortok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ortok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: OR - +", 24);
+ }
+}
+
+
+/*
+ ConstTerm := ConstFactor { MulOperator ConstFactor }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void ConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ ConstFactor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ MulOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstFactor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ }
+ /* while */
+}
+
+
+/*
+ MulOperator := '*' | '/' | 'DIV' | 'MOD' |
+ 'REM' | 'AND' | '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void MulOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_timestok)
+ {
+ Expect (mcReserved_timestok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_dividetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_dividetok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_divtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_divtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_modtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_modtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_remtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_remtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_andtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_andtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ambersandtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39);
+ }
+}
+
+
+/*
+ ConstFactor := Number | ConstString |
+ ConstSetOrQualidentOrFunction |
+ '(' ConstExpression ')' |
+ 'NOT' ConstFactor |
+ ConstAttribute
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void ConstFactor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ Number (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ ConstString (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ ConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_nottok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstFactor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ ConstAttribute (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( identifier { string integer number real number", 84);
+ }
+}
+
+
+/*
+ ConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void ConstString (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ string (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ComponentElement := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ComponentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ComponentValue := ComponentElement [ 'BY' ConstExpression ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ComponentValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ ComponentElement (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArraySetRecordValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ ComponentValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ComponentValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ Constructor := '{' [ ArraySetRecordValue ] '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void Constructor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lcbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ ArraySetRecordValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstSetOrQualidentOrFunction := Qualident [ Constructor |
+ ConstActualParameters ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void ConstSetOrQualidentOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ ConstActualParameters (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( {", 21);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ /* avoid dangling else. */
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: { identifier", 30);
+ }
+}
+
+
+/*
+ ConstActualParameters := ActualParameters
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ConstActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ ActualParameters (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' ConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void ConstAttribute (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstAttributeExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstAttributeExpression := Ident | '<' Qualident
+ ',' Ident '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void ConstAttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: < identifier", 30);
+ }
+}
+
+
+/*
+ ByteAlignment := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void ByteAlignment (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ AttributeExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ OptAlignmentExpression := [ AlignmentExpression ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void OptAlignmentExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ AlignmentExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AlignmentExpression := '(' ConstExpression ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void AlignmentExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Alignment := [ ByteAlignment ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void Alignment (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ ByteAlignment (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ TypeDeclaration := Ident
+ % VAR n: node ; %
+
+ % n := makeTypeImp (curident) %
+ '=' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void TypeDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ n = decl_makeTypeImp (curident);
+ Expect (mcReserved_equaltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Type := ( SimpleType | ArrayType | RecordType |
+ SetType | PointerType |
+ ProcedureType )
+
+ first symbols:lparatok, lsbratok, proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok
+
+ cannot reachend
+*/
+
+static void Type (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ SimpleType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ /* avoid dangling else. */
+ ArrayType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_recordtok)
+ {
+ /* avoid dangling else. */
+ RecordType (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok))
+ {
+ /* avoid dangling else. */
+ SetType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_pointertok)
+ {
+ /* avoid dangling else. */
+ PointerType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80);
+ }
+}
+
+
+/*
+ SimpleType := Qualident [ SubrangeType ] |
+ Enumeration | SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void SimpleType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Enumeration (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: [ ( identifier", 32);
+ }
+}
+
+
+/*
+ Enumeration := '(' ( IdentList ) ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void Enumeration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ IdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void IdentList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SubrangeType := '[' ConstExpression '..' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void SubrangeType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ArrayType := 'ARRAY' SimpleType { ',' SimpleType }
+ 'OF' Type
+
+ first symbols:arraytok
+
+ cannot reachend
+*/
+
+static void ArrayType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_arraytok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ Expect (mcReserved_oftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RecordType := 'RECORD' [ DefaultRecordAttributes ]
+ FieldListSequence 'END'
+
+ first symbols:recordtok
+
+ cannot reachend
+*/
+
+static void RecordType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_recordtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ DefaultRecordAttributes (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ FieldListSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefaultRecordAttributes := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void DefaultRecordAttributes (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ AttributeExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RecordFieldPragma := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void RecordFieldPragma (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldPragmaExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldPragmaExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FieldPragmaExpression := Ident PragmaConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FieldPragmaExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ PragmaConstExpression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ PragmaConstExpression := [ '(' ConstExpression ')' ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void PragmaConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AttributeExpression := Ident '(' ConstExpression
+ ')'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FieldListSequence := FieldListStatement { ';' FieldListStatement }
+
+ first symbols:casetok, identtok, semicolontok
+
+ reachend
+*/
+
+static void FieldListSequence (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ FieldListStatement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListStatement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ FieldListStatement := [ FieldList ]
+
+ first symbols:identtok, casetok
+
+ reachend
+*/
+
+static void FieldListStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_casetok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ FieldList (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FieldList := IdentList ':' Type RecordFieldPragma |
+ 'CASE' CaseTag 'OF' Varient { '|' Varient }
+ [ 'ELSE' FieldListSequence ] 'END'
+
+ first symbols:casetok, identtok
+
+ cannot reachend
+*/
+
+static void FieldList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ RecordFieldPragma (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_casetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_casetok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ CaseTag (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Varient (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_bartok)
+ {
+ Expect (mcReserved_bartok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Varient (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ Expect (mcReserved_elsetok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: CASE identifier", 33);
+ }
+}
+
+
+/*
+ TagIdent := [ Ident ]
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TagIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ CaseTag := TagIdent [ ':' Qualident ]
+
+ first symbols:colontok, identtok
+
+ reachend
+*/
+
+static void CaseTag (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ TagIdent (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Varient := [ VarientCaseLabelList ':' FieldListSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Varient (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))))
+ {
+ VarientCaseLabelList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListSequence (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ VarientCaseLabelList := VarientCaseLabels { ','
+ VarientCaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabelList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ VarientCaseLabels (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ VarientCaseLabels (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ VarientCaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabels (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SilentConstExpression := SilentSimpleConstExpr [
+ SilentRelation SilentSimpleConstExpr ]
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentConstExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ SilentSimpleConstExpr (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ SilentRelation (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SilentSimpleConstExpr (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SilentRelation := '=' | '#' | '<>' | '<' |
+ '<=' | '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void SilentRelation (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_hashtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_hashtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_intok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_intok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37);
+ }
+}
+
+
+/*
+ SilentSimpleConstExpr := SilentUnaryOrConstTerm
+ { SilentAddOperator SilentConstTerm }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentSimpleConstExpr (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ SilentUnaryOrConstTerm (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ SilentAddOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SilentConstTerm (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SilentUnaryOrConstTerm := '+' SilentConstTerm |
+ '-' SilentConstTerm |
+ SilentConstTerm
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentUnaryOrConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SilentConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SilentConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ SilentConstTerm (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ { identifier string - +", 88);
+ }
+}
+
+
+/*
+ SilentAddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentAddOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ortok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ortok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: OR - +", 24);
+ }
+}
+
+
+/*
+ SilentConstTerm := SilentConstFactor { SilentMulOperator
+ SilentConstFactor }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void SilentConstTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ SilentConstFactor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ SilentMulOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstFactor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ }
+ /* while */
+}
+
+
+/*
+ SilentMulOperator := '*' | '/' | 'DIV' |
+ 'MOD' | 'REM' | 'AND' |
+ '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void SilentMulOperator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_timestok)
+ {
+ Expect (mcReserved_timestok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_dividetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_dividetok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_divtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_divtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_modtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_modtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_remtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_remtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_andtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_andtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ambersandtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39);
+ }
+}
+
+
+/*
+ SilentConstFactor := Number | SilentConstString |
+ SilentConstSetOrQualidentOrFunction |
+ '(' SilentConstExpression ')' |
+ 'NOT' SilentConstFactor |
+ SilentConstAttribute
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void SilentConstFactor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ Number (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ SilentConstString (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ SilentConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_nottok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstFactor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ SilentConstAttribute (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( { identifier string integer number real number", 84);
+ }
+}
+
+
+/*
+ SilentConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void SilentConstString (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ string (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SilentConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' SilentConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void SilentConstAttribute (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SilentConstAttributeExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SilentConstAttributeExpression := Ident |
+ '<' Ident ','
+ SilentConstString
+ '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void SilentConstAttributeExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstString (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: < identifier", 30);
+ }
+}
+
+
+/*
+ SilentComponentElement := SilentConstExpression
+ [ '..' SilentConstExpression ]
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentComponentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ SilentConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SilentComponentValue := SilentComponentElement [
+ 'BY' SilentConstExpression ]
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentComponentValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ SilentComponentElement (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SilentArraySetRecordValue := SilentComponentValue
+ { ',' SilentComponentValue }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentArraySetRecordValue (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ SilentComponentValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentComponentValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SilentConstructor := '{' [ SilentArraySetRecordValue ]
+ '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void SilentConstructor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lcbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ SilentArraySetRecordValue (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SilentConstSetOrQualidentOrFunction := SilentConstructor |
+ Qualident
+ [ SilentConstructor |
+ SilentActualParameters ]
+
+ first symbols:identtok, lcbratok
+
+ cannot reachend
+*/
+
+static void SilentConstSetOrQualidentOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ SilentConstructor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ SilentConstructor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ SilentActualParameters (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( {", 21);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier {", 30);
+ }
+}
+
+
+/*
+ SilentElement := SilentConstExpression [ '..' SilentConstExpression ]
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ SilentConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SilentActualParameters := '(' [ SilentExpList ]
+ ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void SilentActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ SilentExpList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SilentExpList := SilentConstExpression { ',' SilentConstExpression }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ SilentConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType
+
+ first symbols:oftok, packedsettok, settok
+
+ cannot reachend
+*/
+
+static void SetType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_settok)
+ {
+ Expect (mcReserved_settok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_packedsettok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_packedsettok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PACKEDSET SET", 31);
+ }
+ Expect (mcReserved_oftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ PointerType := 'POINTER' 'TO' Type
+
+ first symbols:pointertok
+
+ cannot reachend
+*/
+
+static void PointerType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_pointertok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok))));
+ Expect (mcReserved_totok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureType := 'PROCEDURE' [ FormalTypeList ]
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ FormalTypeList (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FormalTypeList := '(' ( ')' FormalReturn |
+ ProcedureParameters ')'
+ FormalReturn )
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalTypeList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_rparatok)
+ {
+ Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ ProcedureParameters (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: VAR ... ARRAY identifier )", 44);
+ }
+}
+
+
+/*
+ FormalReturn := [ ':' OptReturnType ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void FormalReturn (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ OptReturnType (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ OptReturnType := '[' Qualident ']' |
+ Qualident
+
+ first symbols:identtok, lsbratok
+
+ cannot reachend
+*/
+
+static void OptReturnType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier [", 30);
+ }
+}
+
+
+/*
+ ProcedureParameters := ProcedureParameter { ','
+ ProcedureParameter }
+
+ first symbols:identtok, arraytok, periodperiodperiodtok, vartok
+
+ cannot reachend
+*/
+
+static void ProcedureParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ ProcedureParameter (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureParameter (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ProcedureParameter := '...' | 'VAR' FormalType |
+ FormalType
+
+ first symbols:arraytok, identtok, vartok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ProcedureParameter (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ FormalType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ARRAY identifier VAR ...", 42);
+ }
+}
+
+
+/*
+ VarIdent := Ident
+ % VAR n: node ; %
+
+ % n := makeVar (curident) %
+ [ '[' ConstExpression ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ n = decl_makeVar (curident);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Expect (mcReserved_lsbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ VarIdentList := VarIdent { ',' VarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdentList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ VarIdent (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ VarIdent (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ VariableDeclaration := VarIdentList ':' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VariableDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ VarIdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Designator := Qualident { SubDesignator }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Designator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0)))
+ {
+ SubDesignator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SubDesignator := '.' Ident | '[' ArrayExpList ']' |
+ '^'
+
+ first symbols:uparrowtok, lsbratok, periodtok
+
+ cannot reachend
+*/
+
+static void SubDesignator (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lsbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ArrayExpList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_uparrowtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_uparrowtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ^ [ .", 23);
+ }
+}
+
+
+/*
+ ArrayExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArrayExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ExpList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ Expression := SimpleExpression [ Relation SimpleExpression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void Expression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ SimpleExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SimpleExpression := UnaryOrTerm { AddOperator Term }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleExpression (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ UnaryOrTerm (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ AddOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ UnaryOrTerm := '+' Term | '-' Term |
+ Term
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrTerm (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ Term (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( string integer number real number identifier { - +", 74);
+ }
+}
+
+
+/*
+ Term := Factor { MulOperator Factor }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void Term (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Factor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ MulOperator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Factor (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ }
+ /* while */
+}
+
+
+/*
+ Factor := Number | string | SetOrDesignatorOrFunction |
+ '(' Expression ')' |
+ 'NOT' ( Factor | ConstAttribute )
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void Factor (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ Number (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ string (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ SetOrDesignatorOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_nottok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ Factor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ ConstAttribute (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ real number integer number string ( NOT { identifier", 84);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( identifier { string integer number real number", 70);
+ }
+}
+
+
+/*
+ SetOrDesignatorOrFunction := Qualident [ Constructor |
+ SimpleDes
+ [ ActualParameters ] ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void SetOrDesignatorOrFunction (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ SimpleDes (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ ActualParameters (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( ^ [ . {", 27);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ /* avoid dangling else. */
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: { identifier", 30);
+ }
+}
+
+
+/*
+ SimpleDes := { SubDesignator }
+
+ first symbols:periodtok, lsbratok, uparrowtok
+
+ reachend
+*/
+
+static void SimpleDes (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0)))
+ {
+ SubDesignator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ActualParameters := '(' [ ExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ActualParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ ExpList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ExitStatement := 'EXIT'
+
+ first symbols:exittok
+
+ cannot reachend
+*/
+
+static void ExitStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_exittok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ReturnStatement := 'RETURN' [ Expression ]
+
+ first symbols:returntok
+
+ cannot reachend
+*/
+
+static void ReturnStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_returntok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ Expression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Statement := [ AssignmentOrProcedureCall |
+ IfStatement | CaseStatement |
+ WhileStatement |
+ RepeatStatement |
+ LoopStatement | ForStatement |
+ WithStatement | AsmStatement |
+ ExitStatement | ReturnStatement |
+ RetryStatement ]
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok
+
+ reachend
+*/
+
+static void Statement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ AssignmentOrProcedureCall (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_iftok)
+ {
+ /* avoid dangling else. */
+ IfStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_casetok)
+ {
+ /* avoid dangling else. */
+ CaseStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_whiletok)
+ {
+ /* avoid dangling else. */
+ WhileStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_repeattok)
+ {
+ /* avoid dangling else. */
+ RepeatStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_looptok)
+ {
+ /* avoid dangling else. */
+ LoopStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_fortok)
+ {
+ /* avoid dangling else. */
+ ForStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_withtok)
+ {
+ /* avoid dangling else. */
+ WithStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_asmtok)
+ {
+ /* avoid dangling else. */
+ AsmStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_exittok)
+ {
+ /* avoid dangling else. */
+ ExitStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_returntok)
+ {
+ /* avoid dangling else. */
+ ReturnStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_retrytok)
+ {
+ /* avoid dangling else. */
+ RetryStatement (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: RETRY RETURN EXIT ASM WITH FOR LOOP REPEAT WHILE CASE IF identifier", 85);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ RetryStatement := 'RETRY'
+
+ first symbols:retrytok
+
+ cannot reachend
+*/
+
+static void RetryStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_retrytok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AssignmentOrProcedureCall := Designator ( ':=' Expression |
+ ActualParameters |
+
+ % epsilon %
+ )
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AssignmentOrProcedureCall (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Designator (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_becomestok)
+ {
+ Expect (mcReserved_becomestok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ ActualParameters (stopset0, stopset1, stopset2);
+ }
+ /* epsilon */
+}
+
+
+/*
+ StatementSequence := Statement { ';' Statement }
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok
+
+ reachend
+*/
+
+static void StatementSequence (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Statement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Statement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ IfStatement := 'IF' Expression 'THEN' StatementSequence
+ { 'ELSIF' Expression 'THEN' StatementSequence }
+ [ 'ELSE' StatementSequence ] 'END'
+
+ first symbols:iftok
+
+ cannot reachend
+*/
+
+static void IfStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_iftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok))));
+ Expect (mcReserved_thentok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_elsiftok)
+ {
+ Expect (mcReserved_elsiftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok))));
+ Expect (mcReserved_thentok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ Expect (mcReserved_elsetok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ CaseStatement := 'CASE' Expression 'OF' Case { '|'
+ Case }
+ CaseEndStatement
+
+ first symbols:casetok
+
+ cannot reachend
+*/
+
+static void CaseStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_casetok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Case (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_bartok)
+ {
+ Expect (mcReserved_bartok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Case (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ CaseEndStatement (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ CaseEndStatement := 'END' | 'ELSE' StatementSequence
+ 'END'
+
+ first symbols:elsetok, endtok
+
+ cannot reachend
+*/
+
+static void CaseEndStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_endtok)
+ {
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_elsetok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ELSE END", 26);
+ }
+}
+
+
+/*
+ Case := [ CaseLabelList ':' StatementSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Case (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))))
+ {
+ CaseLabelList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ CaseLabelList := CaseLabels { ',' CaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void CaseLabelList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ CaseLabels (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ CaseLabels (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ CaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void CaseLabels (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ WhileStatement := 'WHILE' Expression 'DO' StatementSequence
+ 'END'
+
+ first symbols:whiletok
+
+ cannot reachend
+*/
+
+static void WhileStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_whiletok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_dotok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RepeatStatement := 'REPEAT' StatementSequence 'UNTIL'
+ Expression
+
+ first symbols:repeattok
+
+ cannot reachend
+*/
+
+static void RepeatStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_repeattok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_untiltok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_untiltok-mcReserved_recordtok))));
+ Expect (mcReserved_untiltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ForStatement := 'FOR' Ident ':=' Expression 'TO'
+ Expression [ 'BY' ConstExpression ]
+ 'DO' StatementSequence 'END'
+
+ first symbols:fortok
+
+ cannot reachend
+*/
+
+static void ForStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_becomestok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok))));
+ Expect (mcReserved_totok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok)) | (1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_dotok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ LoopStatement := 'LOOP' StatementSequence 'END'
+
+ first symbols:looptok
+
+ cannot reachend
+*/
+
+static void LoopStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_looptok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ WithStatement := 'WITH' Designator 'DO' StatementSequence
+ 'END'
+
+ first symbols:withtok
+
+ cannot reachend
+*/
+
+static void WithStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_withtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Designator (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_dotok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock
+ Ident
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ ProcedureHeading (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ ProcedureBlock (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefProcedureIdent := Ident
+ % curproc := makeProcedure (curident) ;
+ setProcedureComment (lastcomment, curident) ;
+ putCommentDefProcedure (curproc) ;
+ %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefProcedureIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Ident (stopset0, stopset1, stopset2);
+ curproc = decl_makeProcedure (curident);
+ mcComment_setProcedureComment (mcLexBuf_lastcomment, curident);
+ decl_putCommentDefProcedure (curproc);
+}
+
+
+/*
+ ProcedureIdent := Ident
+ % curproc := lookupSym (curident) ;
+ IF curproc=NIL
+ THEN
+ curproc := makeProcedure (curident)
+ END ;
+ setProcedureComment (lastcomment, curident) ;
+ putCommentModProcedure (curproc) ;
+ %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ProcedureIdent (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Ident (stopset0, stopset1, stopset2);
+ curproc = decl_lookupSym (curident);
+ if (curproc == NULL)
+ {
+ curproc = decl_makeProcedure (curident);
+ }
+ mcComment_setProcedureComment (mcLexBuf_lastcomment, curident);
+ decl_putCommentModProcedure (curproc);
+}
+
+
+/*
+ DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' Ident ')' ')' |
+ '__INLINE__' ]
+
+ first symbols:inlinetok, attributetok
+
+ reachend
+*/
+
+static void DefineBuiltinProcedure (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_inlinetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __INLINE__ __ATTRIBUTE__", 42);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure
+ ( ProcedureIdent
+ % enterScope (curproc) %
+ [ FormalParameters ] AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureHeading (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefineBuiltinProcedure (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureIdent (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_enterScope (curproc);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ FormalParameters (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ AttributeNoReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Builtin := [ '__BUILTIN__' | '__INLINE__' ]
+
+ first symbols:inlinetok, builtintok
+
+ reachend
+*/
+
+static void Builtin (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_builtintok)
+ {
+ Expect (mcReserved_builtintok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_inlinetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __INLINE__ __BUILTIN__", 40);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent
+ [ DefFormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void DefProcedureHeading (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Builtin (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefProcedureIdent (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ DefFormalParameters (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ AttributeNoReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ]
+ 'END'
+ % leaveScope %
+
+
+ first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok
+
+ cannot reachend
+*/
+
+static void ProcedureBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Declaration (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_begintok)
+ {
+ Expect (mcReserved_begintok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ ProcedureBlockBody (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ decl_leaveScope ();
+}
+
+
+/*
+ Block := { Declaration } InitialBlock FinalBlock
+ 'END'
+
+ first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok
+
+ cannot reachend
+*/
+
+static void Block (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Declaration (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ InitialBlock (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok))), stopset2);
+ FinalBlock (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ InitialBlock := [ 'BEGIN' InitialBlockBody ]
+
+ first symbols:begintok
+
+ reachend
+*/
+
+static void InitialBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_begintok)
+ {
+ Expect (mcReserved_begintok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ InitialBlockBody (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FinalBlock := [ 'FINALLY' FinalBlockBody ]
+
+ first symbols:finallytok
+
+ reachend
+*/
+
+static void FinalBlock (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_finallytok)
+ {
+ Expect (mcReserved_finallytok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ FinalBlockBody (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void InitialBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void FinalBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void ProcedureBlockBody (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ NormalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void NormalPart (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ StatementSequence (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ExceptionalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ExceptionalPart (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ StatementSequence (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Declaration := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration ';' } |
+ 'VAR' { VariableDeclaration ';' } |
+ ProcedureDeclaration ';' |
+ ModuleDeclaration ';'
+
+ first symbols:moduletok, proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Declaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_consttok)
+ {
+ Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ ConstantDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_typetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ TypeDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ VariableDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ ModuleDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: MODULE PROCEDURE VAR TYPE CONST", 49);
+ }
+}
+
+
+/*
+ DefFormalParameters := '(' [ DefMultiFPSection ]
+ ')' FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefFormalParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ DefMultiFPSection (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefMultiFPSection := DefExtendedFP |
+ FPSection [ ';' DefMultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefMultiFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok))
+ {
+ DefExtendedFP (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ FPSection (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ DefMultiFPSection (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38);
+ }
+}
+
+
+/*
+ FormalParameters := '(' [ MultiFPSection ] ')'
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalParameters (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ MultiFPSection (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AttributeNoReturn := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeNoReturn (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AttributeUnused := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeUnused (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ MultiFPSection := ExtendedFP | FPSection [ ';'
+ MultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void MultiFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok))
+ {
+ ExtendedFP (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ FPSection (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ MultiFPSection (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38);
+ }
+}
+
+
+/*
+ FPSection := NonVarFPSection |
+ VarFPSection
+
+ first symbols:vartok, identtok
+
+ cannot reachend
+*/
+
+static void FPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ NonVarFPSection (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ VarFPSection (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: VAR identifier", 32);
+ }
+}
+
+
+/*
+ DefExtendedFP := DefOptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefExtendedFP (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ DefOptArg (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ... [", 23);
+ }
+}
+
+
+/*
+ ExtendedFP := OptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ExtendedFP (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ OptArg (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ... [", 23);
+ }
+}
+
+
+/*
+ VarFPSection := 'VAR' IdentList ':' FormalType [
+ AttributeUnused ]
+
+ first symbols:vartok
+
+ cannot reachend
+*/
+
+static void VarFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ AttributeUnused (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void NonVarFPSection (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ AttributeUnused (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ]
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void OptArg (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefOptArg := '[' Ident ':' FormalType '=' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void DefOptArg (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_equaltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FormalType := { 'ARRAY' 'OF' } Qualident
+
+ first symbols:identtok, arraytok
+
+ cannot reachend
+*/
+
+static void FormalType (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ while (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ Expect (mcReserved_arraytok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ Qualident (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ModuleDeclaration := 'MODULE' Ident [ Priority ]
+ ';' { Import } [ Export ]
+ Block Ident
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ModuleDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_exporttok)
+ {
+ Export (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ Block (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Priority := '[' ConstExpression ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void Priority (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Export := 'EXPORT' ( 'QUALIFIED' IdentList |
+ 'UNQUALIFIED' IdentList |
+ IdentList ) ';'
+
+ first symbols:exporttok
+
+ cannot reachend
+*/
+
+static void Export (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_exporttok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) | (1 << (mcReserved_unqualifiedtok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_qualifiedtok)
+ {
+ Expect (mcReserved_qualifiedtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_unqualifiedtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_unqualifiedtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier UNQUALIFIED QUALIFIED", 50);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FromImport := 'FROM' Ident
+ % registerImport (curident, FALSE) %
+ 'IMPORT' IdentList ';'
+
+ first symbols:fromtok
+
+ cannot reachend
+*/
+
+static void FromImport (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_fromtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok))), stopset2);
+ registerImport (curident, FALSE);
+ Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImportModuleList := Ident
+ % registerImport (curident, TRUE) %
+ { ',' Ident
+ % registerImport (curident, TRUE) %
+ }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ImportModuleList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ registerImport (curident, TRUE);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ registerImport (curident, TRUE);
+ }
+ /* while */
+}
+
+
+/*
+ WithoutFromImport := 'IMPORT' ImportModuleList ';'
+
+ first symbols:importtok
+
+ cannot reachend
+*/
+
+static void WithoutFromImport (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ImportModuleList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Import := FromImport | WithoutFromImport
+
+ first symbols:importtok, fromtok
+
+ cannot reachend
+*/
+
+static void Import (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_fromtok)
+ {
+ FromImport (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_importtok)
+ {
+ /* avoid dangling else. */
+ WithoutFromImport (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IMPORT FROM", 29);
+ }
+}
+
+
+/*
+ DefinitionModule :=
+ % VAR c: BOOLEAN ; %
+
+ % c := FALSE %
+ 'DEFINITION' 'MODULE' [ 'FOR'
+ string
+
+ % c := TRUE %
+ ] Ident
+ ';'
+ % curmodule := lookupDef (curident) %
+
+ % IF c THEN putDefForC (curmodule) END %
+
+ % enterScope (curmodule) %
+ { Import } [ Export ] { Definition }
+ 'END' Ident '.'
+ % checkEndName (curmodule, curident, 'definition module') %
+
+ % leaveScope %
+
+
+ first symbols:definitiontok
+
+ cannot reachend
+*/
+
+static void DefinitionModule (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ unsigned int c;
+
+ c = FALSE;
+ Expect (mcReserved_definitiontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_moduletok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_fortok)
+ {
+ Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ c = TRUE;
+ }
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ curmodule = decl_lookupDef (curident);
+ if (c)
+ {
+ decl_putDefForC (curmodule);
+ }
+ decl_enterScope (curmodule);
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_exporttok)
+ {
+ Export (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp1_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Definition (stopset0, stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "definition module", 17);
+ decl_leaveScope ();
+}
+
+
+/*
+ DefTypeDeclaration := { Ident
+ % VAR n: node ; %
+
+ % n := makeType (curident) %
+ ( ';'
+ % putTypeHidden (n) %
+ | '=' Type Alignment
+ ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void DefTypeDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ n = decl_makeType (curident);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ decl_putTypeHidden (n);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_equaltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: = ;", 21);
+ }
+ }
+ /* while */
+}
+
+
+/*
+ ConstantDeclaration := Ident
+ % VAR n: node ; %
+
+ % n := makeConst (curident) %
+ '=' ConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ConstantDeclaration (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ n = decl_makeConst (curident);
+ Expect (mcReserved_equaltok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Definition := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { DefTypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ DefProcedureHeading ';'
+
+ first symbols:proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Definition (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_consttok)
+ {
+ Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ ConstantDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_typetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ DefTypeDeclaration (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ VariableDeclaration (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ DefProcedureHeading (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE VAR TYPE CONST", 42);
+ }
+}
+
+
+/*
+ AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands
+ ')'
+
+ first symbols:asmtok
+
+ cannot reachend
+*/
+
+static void AsmStatement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_asmtok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_volatiletok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_volatiletok)
+ {
+ Expect (mcReserved_volatiletok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmOperands (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AsmOperands := string [ AsmOperandSpec ]
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void AsmOperands (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ string (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ AsmOperandSpec (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AsmOperandSpec := [ ':' AsmList [ ':' AsmList [
+ ':' TrashList ] ] ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void AsmOperandSpec (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmList (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ TrashList (stopset0, stopset1, stopset2);
+ }
+ }
+ }
+}
+
+
+/*
+ AsmList := [ AsmElement ] { ',' AsmElement }
+
+ first symbols:lsbratok, stringtok, commatok
+
+ reachend
+*/
+
+static void AsmList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_stringtok))
+ {
+ AsmElement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmElement (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ NamedOperand := '[' Ident ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void NamedOperand (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AsmOperandName := [ NamedOperand ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void AsmOperandName (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ NamedOperand (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AsmElement := AsmOperandName string '(' Expression
+ ')'
+
+ first symbols:stringtok, lsbratok
+
+ cannot reachend
+*/
+
+static void AsmElement (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ AsmOperandName (stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp1_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ TrashList := [ string ] { ',' string }
+
+ first symbols:commatok, stringtok
+
+ reachend
+*/
+
+static void TrashList (mcp1_SetOfStop0 stopset0, mcp1_SetOfStop1 stopset1, mcp1_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ string (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp1_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0|(mcp1_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ CompilationUnit - returns TRUE if the input was correct enough to parse
+ in future passes.
+*/
+
+extern "C" unsigned int mcp1_CompilationUnit (void)
+{
+ WasNoError = TRUE;
+ FileUnit ((mcp1_SetOfStop0) ((1 << (mcReserved_eoftok-mcReserved_eoftok))), (mcp1_SetOfStop1) 0, (mcp1_SetOfStop2) 0);
+ return WasNoError;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcp1_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcp1_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcp2. */
+/* output from mc-2.bnf, automatically generated do not edit.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING. If not,
+see <https://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcp2_H
+#define _mcp2_C
+
+# include "GDynamicStrings.h"
+# include "GmcError.h"
+# include "GnameKey.h"
+# include "GmcPrintf.h"
+# include "GmcDebug.h"
+# include "GmcReserved.h"
+# include "GmcLexBuf.h"
+# include "Gdecl.h"
+
+# define Pass1 FALSE
+# define Debugging FALSE
+typedef unsigned int mcp2_stop0;
+
+typedef unsigned int mcp2_SetOfStop0;
+
+typedef unsigned int mcp2_stop1;
+
+typedef unsigned int mcp2_SetOfStop1;
+
+typedef unsigned int mcp2_stop2;
+
+typedef unsigned int mcp2_SetOfStop2;
+
+static unsigned int WasNoError;
+static nameKey_Name curident;
+static decl_node typeDes;
+static decl_node typeExp;
+static decl_node curproc;
+static decl_node curmodule;
+
+/*
+ CompilationUnit - returns TRUE if the input was correct enough to parse
+ in future passes.
+*/
+
+extern "C" unsigned int mcp2_CompilationUnit (void);
+static void ErrorString (DynamicStrings_String s);
+static void ErrorArray (const char *a_, unsigned int _a_high);
+
+/*
+ checkEndName - if module does not have, name, then issue an error containing, desc.
+*/
+
+static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high);
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void);
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*/
+
+static void WarnMissingToken (mcReserved_toktype t);
+
+/*
+ MissingToken - generates a warning message about a missing token, t.
+*/
+
+static void MissingToken (mcReserved_toktype t);
+
+/*
+ CheckAndInsert -
+*/
+
+static unsigned int CheckAndInsert (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ InStopSet
+*/
+
+static unsigned int InStopSet (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
+ If it is not then it will insert a token providing the token
+ is one of ; ] ) } . OF END ,
+
+ if the stopset contains <identtok> then we do not insert a token
+*/
+
+static void PeepToken (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Expect -
+*/
+
+static void Expect (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ string -
+*/
+
+static void string (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Integer -
+*/
+
+static void Integer (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Real -
+*/
+
+static void Real (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ registerImport - looks up module, ident, and adds it to the
+ current module import list.
+*/
+
+static void registerImport (nameKey_Name ident, unsigned int scoped);
+
+/*
+ FileUnit := DefinitionModule |
+ ImplementationOrProgramModule
+
+ first symbols:implementationtok, moduletok, definitiontok
+
+ cannot reachend
+*/
+
+static void FileUnit (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ProgramModule := 'MODULE' Ident
+ % curmodule := lookupModule (curident) %
+
+ % enterScope (curmodule) %
+ [ Priority ] ';' { Import } Block
+ Ident
+ % checkEndName (curmodule, curident, 'program module') %
+
+ % leaveScope %
+
+ % setEnumsComplete (curmodule) %
+ '.'
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ProgramModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ImplementationModule := 'IMPLEMENTATION' 'MODULE'
+ Ident
+ % curmodule := lookupImp (curident) %
+
+ % enterScope (lookupDef (curident)) %
+
+ % enterScope (curmodule) %
+ [ Priority ] ';' { Import }
+ Block Ident
+ % checkEndName (curmodule, curident, 'implementation module') %
+
+ % leaveScope ; leaveScope %
+
+ % setEnumsComplete (curmodule) %
+ '.'
+
+ first symbols:implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ImplementationOrProgramModule := ImplementationModule |
+ ProgramModule
+
+ first symbols:moduletok, implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationOrProgramModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Number := Integer | Real
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void Number (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Qualident := Ident { '.' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Qualident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ConstantDeclaration := Ident '=' ConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ConstantDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Relation := '=' | '#' | '<>' | '<' | '<=' |
+ '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void Relation (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SimpleConstExpr := UnaryOrConstTerm { AddOperator
+ ConstTerm }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleConstExpr (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ UnaryOrConstTerm := '+' ConstTerm |
+ '-' ConstTerm |
+ ConstTerm
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void AddOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ConstTerm := ConstFactor { MulOperator ConstFactor }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void ConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ MulOperator := '*' | '/' | 'DIV' | 'MOD' |
+ 'REM' | 'AND' | '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void MulOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ConstFactor := Number | ConstString |
+ ConstSetOrQualidentOrFunction |
+ '(' ConstExpression ')' |
+ 'NOT' ConstFactor |
+ ConstAttribute
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void ConstFactor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void ConstString (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ComponentElement := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ComponentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ComponentValue := ComponentElement [ 'BY' ConstExpression ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ComponentValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArraySetRecordValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Constructor := '{' [ ArraySetRecordValue ] '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void Constructor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ConstSetOrQualidentOrFunction := Qualident [ Constructor |
+ ConstActualParameters ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void ConstSetOrQualidentOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ConstActualParameters := ActualParameters
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ConstActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' ConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void ConstAttribute (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ConstAttributeExpression := Ident | '<' Qualident
+ ',' Ident '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void ConstAttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ByteAlignment := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void ByteAlignment (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ OptAlignmentExpression := [ AlignmentExpression ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void OptAlignmentExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AlignmentExpression := '(' ConstExpression ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void AlignmentExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Alignment := [ ByteAlignment ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void Alignment (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ TypeDeclaration := Ident
+ % typeDes := lookupSym (curident) %
+ '=' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void TypeDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Type := ( DefSimpleType | ArrayType |
+ RecordType | SetType | PointerType |
+ ProcedureType )
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void Type (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SimpleType := Qualident [ SubrangeType ] |
+ Enumeration | SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void SimpleType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ EnumIdentList :=
+ % VAR n, f: node ; %
+
+ % n := makeEnum () %
+ Ident
+ % f := makeEnumField (n, curident) %
+ { ',' Ident
+ % f := makeEnumField (n, curident) %
+ }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void EnumIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Enumeration := '(' ( EnumIdentList ) ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void Enumeration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ IdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void IdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SubrangeType := '[' ConstExpression '..' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void SubrangeType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ArrayType := 'ARRAY' SimpleType { ',' SimpleType }
+ 'OF' Type
+
+ first symbols:arraytok
+
+ cannot reachend
+*/
+
+static void ArrayType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ RecordType := 'RECORD' [ DefaultRecordAttributes ]
+ FieldListSequence 'END'
+
+ first symbols:recordtok
+
+ cannot reachend
+*/
+
+static void RecordType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefaultRecordAttributes := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void DefaultRecordAttributes (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ RecordFieldPragma := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void RecordFieldPragma (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FieldPragmaExpression := Ident PragmaConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FieldPragmaExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ PragmaConstExpression := [ '(' ConstExpression ')' ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void PragmaConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AttributeExpression := Ident '(' ConstExpression
+ ')'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FieldListSequence := FieldListStatement { ';' FieldListStatement }
+
+ first symbols:casetok, identtok, semicolontok
+
+ reachend
+*/
+
+static void FieldListSequence (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FieldListStatement := [ FieldList ]
+
+ first symbols:identtok, casetok
+
+ reachend
+*/
+
+static void FieldListStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FieldList := IdentList ':' Type RecordFieldPragma |
+ 'CASE' CaseTag 'OF' Varient { '|' Varient }
+ [ 'ELSE' FieldListSequence ] 'END'
+
+ first symbols:casetok, identtok
+
+ cannot reachend
+*/
+
+static void FieldList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ TagIdent := [ Ident ]
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TagIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ CaseTag := TagIdent [ ':' Qualident ]
+
+ first symbols:colontok, identtok
+
+ reachend
+*/
+
+static void CaseTag (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Varient := [ VarientCaseLabelList ':' FieldListSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Varient (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ VarientCaseLabelList := VarientCaseLabels { ','
+ VarientCaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabelList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ VarientCaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabels (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentConstExpression := SilentSimpleConstExpr [
+ SilentRelation SilentSimpleConstExpr ]
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentRelation := '=' | '#' | '<>' | '<' |
+ '<=' | '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void SilentRelation (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentSimpleConstExpr := SilentUnaryOrConstTerm
+ { SilentAddOperator SilentConstTerm }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentSimpleConstExpr (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentUnaryOrConstTerm := '+' SilentConstTerm |
+ '-' SilentConstTerm |
+ SilentConstTerm
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentUnaryOrConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentAddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentAddOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentConstTerm := SilentConstFactor { SilentMulOperator
+ SilentConstFactor }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void SilentConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentMulOperator := '*' | '/' | 'DIV' |
+ 'MOD' | 'REM' | 'AND' |
+ '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void SilentMulOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentConstFactor := Number | SilentConstString |
+ SilentConstSetOrQualidentOrFunction |
+ '(' SilentConstExpression ')' |
+ 'NOT' SilentConstFactor |
+ SilentConstAttribute
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void SilentConstFactor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void SilentConstString (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' SilentConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void SilentConstAttribute (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentConstAttributeExpression := Ident |
+ '<' Ident ','
+ SilentConstString
+ '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void SilentConstAttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentComponentElement := SilentConstExpression
+ [ '..' SilentConstExpression ]
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentComponentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentComponentValue := SilentComponentElement [
+ 'BY' SilentConstExpression ]
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentComponentValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentArraySetRecordValue := SilentComponentValue
+ { ',' SilentComponentValue }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentArraySetRecordValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentConstructor := '{' [ SilentArraySetRecordValue ]
+ '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void SilentConstructor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentConstSetOrQualidentOrFunction := SilentConstructor |
+ Qualident
+ [ SilentConstructor |
+ SilentActualParameters ]
+
+ first symbols:identtok, lcbratok
+
+ cannot reachend
+*/
+
+static void SilentConstSetOrQualidentOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentElement := SilentConstExpression [ '..' SilentConstExpression ]
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentActualParameters := '(' [ SilentExpList ]
+ ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void SilentActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SilentExpList := SilentConstExpression { ',' SilentConstExpression }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType
+
+ first symbols:oftok, packedsettok, settok
+
+ cannot reachend
+*/
+
+static void SetType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ PointerType := 'POINTER' 'TO' Type
+
+ first symbols:pointertok
+
+ cannot reachend
+*/
+
+static void PointerType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ProcedureType := 'PROCEDURE' [ FormalTypeList ]
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FormalTypeList := '(' ( ')' FormalReturn |
+ ProcedureParameters ')'
+ FormalReturn )
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalTypeList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FormalReturn := [ ':' OptReturnType ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void FormalReturn (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ OptReturnType := '[' Qualident ']' |
+ Qualident
+
+ first symbols:identtok, lsbratok
+
+ cannot reachend
+*/
+
+static void OptReturnType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ProcedureParameters := ProcedureParameter { ','
+ ProcedureParameter }
+
+ first symbols:identtok, arraytok, periodperiodperiodtok, vartok
+
+ cannot reachend
+*/
+
+static void ProcedureParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ProcedureParameter := '...' | 'VAR' FormalType |
+ FormalType
+
+ first symbols:arraytok, identtok, vartok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ProcedureParameter (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ VarIdent := Ident [ '[' ConstExpression ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ VarIdentList := VarIdent { ',' VarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ VariableDeclaration := VarIdentList ':' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VariableDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefVarIdent := Ident [ '[' ConstExpression ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefVarIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefVarIdentList := DefVarIdent { ',' DefVarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefVarIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefVariableDeclaration :=
+ % typeDes := NIL %
+ DefVarIdentList ':' Type
+ Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefVariableDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Designator := Qualident { SubDesignator }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Designator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SubDesignator := '.' Ident | '[' ArrayExpList ']' |
+ '^'
+
+ first symbols:uparrowtok, lsbratok, periodtok
+
+ cannot reachend
+*/
+
+static void SubDesignator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ArrayExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArrayExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Expression := SimpleExpression [ Relation SimpleExpression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void Expression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SimpleExpression := UnaryOrTerm { AddOperator Term }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ UnaryOrTerm := '+' Term | '-' Term |
+ Term
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Term := Factor { MulOperator Factor }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void Term (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Factor := Number | string | SetOrDesignatorOrFunction |
+ '(' Expression ')' |
+ 'NOT' ( Factor | ConstAttribute )
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void Factor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SetOrDesignatorOrFunction := Qualident [ Constructor |
+ SimpleDes
+ [ ActualParameters ] ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void SetOrDesignatorOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ SimpleDes := { SubDesignator }
+
+ first symbols:periodtok, lsbratok, uparrowtok
+
+ reachend
+*/
+
+static void SimpleDes (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ActualParameters := '(' [ ExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ExitStatement := 'EXIT'
+
+ first symbols:exittok
+
+ cannot reachend
+*/
+
+static void ExitStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ReturnStatement := 'RETURN' [ Expression ]
+
+ first symbols:returntok
+
+ cannot reachend
+*/
+
+static void ReturnStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Statement := [ AssignmentOrProcedureCall |
+ IfStatement | CaseStatement |
+ WhileStatement |
+ RepeatStatement |
+ LoopStatement | ForStatement |
+ WithStatement | AsmStatement |
+ ExitStatement | ReturnStatement |
+ RetryStatement ]
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok
+
+ reachend
+*/
+
+static void Statement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ RetryStatement := 'RETRY'
+
+ first symbols:retrytok
+
+ cannot reachend
+*/
+
+static void RetryStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AssignmentOrProcedureCall := Designator ( ':=' Expression |
+ ActualParameters |
+
+ % epsilon %
+ )
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AssignmentOrProcedureCall (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ StatementSequence := Statement { ';' Statement }
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok
+
+ reachend
+*/
+
+static void StatementSequence (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ IfStatement := 'IF' Expression 'THEN' StatementSequence
+ { 'ELSIF' Expression 'THEN' StatementSequence }
+ [ 'ELSE' StatementSequence ] 'END'
+
+ first symbols:iftok
+
+ cannot reachend
+*/
+
+static void IfStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ CaseStatement := 'CASE' Expression 'OF' Case { '|'
+ Case }
+ CaseEndStatement
+
+ first symbols:casetok
+
+ cannot reachend
+*/
+
+static void CaseStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ CaseEndStatement := 'END' | 'ELSE' StatementSequence
+ 'END'
+
+ first symbols:elsetok, endtok
+
+ cannot reachend
+*/
+
+static void CaseEndStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Case := [ CaseLabelList ':' StatementSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Case (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ CaseLabelList := CaseLabels { ',' CaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void CaseLabelList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ CaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void CaseLabels (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ WhileStatement := 'WHILE' Expression 'DO' StatementSequence
+ 'END'
+
+ first symbols:whiletok
+
+ cannot reachend
+*/
+
+static void WhileStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ RepeatStatement := 'REPEAT' StatementSequence 'UNTIL'
+ Expression
+
+ first symbols:repeattok
+
+ cannot reachend
+*/
+
+static void RepeatStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ForStatement := 'FOR' Ident ':=' Expression 'TO'
+ Expression [ 'BY' ConstExpression ]
+ 'DO' StatementSequence 'END'
+
+ first symbols:fortok
+
+ cannot reachend
+*/
+
+static void ForStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ LoopStatement := 'LOOP' StatementSequence 'END'
+
+ first symbols:looptok
+
+ cannot reachend
+*/
+
+static void LoopStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ WithStatement := 'WITH' Designator 'DO' StatementSequence
+ 'END'
+
+ first symbols:withtok
+
+ cannot reachend
+*/
+
+static void WithStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock
+ Ident
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ProcedureIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' Ident ')' ')' |
+ '__INLINE__' ]
+
+ first symbols:inlinetok, attributetok
+
+ reachend
+*/
+
+static void DefineBuiltinProcedure (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure
+ ( ProcedureIdent
+ % enterScope (curproc) %
+ [ FormalParameters ] AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureHeading (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Builtin := [ '__BUILTIN__' | '__INLINE__' ]
+
+ first symbols:inlinetok, builtintok
+
+ reachend
+*/
+
+static void Builtin (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefProcedureHeading := 'PROCEDURE' Builtin ( ProcedureIdent
+ [ DefFormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void DefProcedureHeading (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ]
+ 'END'
+ % leaveScope %
+
+
+ first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok
+
+ cannot reachend
+*/
+
+static void ProcedureBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Block := { Declaration } InitialBlock FinalBlock
+ 'END'
+
+ first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok
+
+ cannot reachend
+*/
+
+static void Block (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ InitialBlock := [ 'BEGIN' InitialBlockBody ]
+
+ first symbols:begintok
+
+ reachend
+*/
+
+static void InitialBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FinalBlock := [ 'FINALLY' FinalBlockBody ]
+
+ first symbols:finallytok
+
+ reachend
+*/
+
+static void FinalBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void InitialBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void FinalBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void ProcedureBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ NormalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void NormalPart (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ExceptionalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ExceptionalPart (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Declaration := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration ';' } |
+ 'VAR' { VariableDeclaration ';' } |
+ ProcedureDeclaration ';' |
+ ModuleDeclaration ';'
+
+ first symbols:moduletok, proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Declaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefFormalParameters := '(' [ DefMultiFPSection ]
+ ')' FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefFormalParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefMultiFPSection := DefExtendedFP |
+ FPSection [ ';' DefMultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefMultiFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FormalParameters := '(' [ MultiFPSection ] ')'
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AttributeNoReturn := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeNoReturn (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AttributeUnused := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeUnused (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ MultiFPSection := ExtendedFP | FPSection [ ';'
+ MultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void MultiFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FPSection := NonVarFPSection |
+ VarFPSection
+
+ first symbols:vartok, identtok
+
+ cannot reachend
+*/
+
+static void FPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefExtendedFP := DefOptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefExtendedFP (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ExtendedFP := OptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ExtendedFP (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ VarFPSection := 'VAR' IdentList ':' FormalType [
+ AttributeUnused ]
+
+ first symbols:vartok
+
+ cannot reachend
+*/
+
+static void VarFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void NonVarFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ]
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void OptArg (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefOptArg := '[' Ident ':' FormalType '=' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void DefOptArg (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FormalType := { 'ARRAY' 'OF' } Qualident
+
+ first symbols:identtok, arraytok
+
+ cannot reachend
+*/
+
+static void FormalType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ModuleDeclaration := 'MODULE' Ident [ Priority ]
+ ';' { Import } [ Export ]
+ Block Ident
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ModuleDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Priority := '[' ConstExpression ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void Priority (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Export := 'EXPORT' ( 'QUALIFIED' IdentList |
+ 'UNQUALIFIED' IdentList |
+ IdentList ) ';'
+
+ first symbols:exporttok
+
+ cannot reachend
+*/
+
+static void Export (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ FromImport := 'FROM' Ident 'IMPORT' IdentList ';'
+
+ first symbols:fromtok
+
+ cannot reachend
+*/
+
+static void FromImport (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ ImportModuleList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ImportModuleList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ WithoutFromImport := 'IMPORT' ImportModuleList ';'
+
+ first symbols:importtok
+
+ cannot reachend
+*/
+
+static void WithoutFromImport (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Import := FromImport | WithoutFromImport
+
+ first symbols:importtok, fromtok
+
+ cannot reachend
+*/
+
+static void Import (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR'
+ string ]
+ Ident ';'
+ % curmodule := lookupDef (curident) %
+
+ % enterScope (curmodule) %
+ { Import } [ Export ] { Definition }
+ 'END' Ident '.'
+ % checkEndName (curmodule, curident, 'definition module') %
+
+ % leaveScope %
+
+ % setEnumsComplete (curmodule) %
+
+
+ first symbols:definitiontok
+
+ cannot reachend
+*/
+
+static void DefinitionModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefQualident := Ident
+ % typeExp := lookupSym (curident) %
+ [ '.'
+ % IF NOT isDef (typeExp)
+ THEN
+ ErrorArray ('the first component of this qualident must be a definition module')
+ END %
+ Ident
+ % typeExp := lookupInScope (typeExp, curident) ;
+ IF typeExp=NIL
+ THEN
+ ErrorArray ('identifier not found in definition module')
+ END %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefQualident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefOptSubrange := [ SubrangeType |
+
+ % putType (typeDes, typeExp) %
+ ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void DefOptSubrange (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefTypeEquiv := DefQualident DefOptSubrange
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefTypeEquiv (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefEnumIdentList :=
+ % VAR n, f: node ; %
+
+ % n := makeEnum () %
+ Ident
+ % f := makeEnumField (n, curident) %
+ { ',' Ident
+ % f := makeEnumField (n, curident) %
+ }
+ % IF typeDes # NIL THEN putType (typeDes, n) END %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefEnumIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefEnumeration := '(' DefEnumIdentList ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefEnumeration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefSimpleType := DefTypeEquiv | DefEnumeration |
+ SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void DefSimpleType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefType := DefSimpleType | ArrayType |
+ RecordType | SetType | PointerType |
+ ProcedureType
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void DefType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefTypeDeclaration := { Ident
+ % typeDes := lookupSym (curident) %
+ ( ';' | '=' DefType Alignment
+ ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void DefTypeDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ DefConstantDeclaration := Ident '=' ConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefConstantDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ Definition := 'CONST' { DefConstantDeclaration ';' } |
+ 'TYPE' { DefTypeDeclaration } |
+ 'VAR' { DefVariableDeclaration ';' } |
+ DefProcedureHeading ';'
+
+ first symbols:proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Definition (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands
+ ')'
+
+ first symbols:asmtok
+
+ cannot reachend
+*/
+
+static void AsmStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AsmOperands := string [ AsmOperandSpec ]
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void AsmOperands (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AsmOperandSpec := [ ':' AsmList [ ':' AsmList [
+ ':' TrashList ] ] ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void AsmOperandSpec (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AsmList := [ AsmElement ] { ',' AsmElement }
+
+ first symbols:lsbratok, stringtok, commatok
+
+ reachend
+*/
+
+static void AsmList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ NamedOperand := '[' Ident ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void NamedOperand (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AsmOperandName := [ NamedOperand ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void AsmOperandName (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ AsmElement := AsmOperandName string '(' Expression
+ ')'
+
+ first symbols:stringtok, lsbratok
+
+ cannot reachend
+*/
+
+static void AsmElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+/*
+ TrashList := [ string ] { ',' string }
+
+ first symbols:commatok, stringtok
+
+ reachend
+*/
+
+static void TrashList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2);
+
+static void ErrorString (DynamicStrings_String s)
+{
+ mcError_errorStringAt (s, mcLexBuf_getTokenNo ());
+ WasNoError = FALSE;
+}
+
+static void ErrorArray (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ ErrorString (DynamicStrings_InitString ((const char *) a, _a_high));
+}
+
+
+/*
+ checkEndName - if module does not have, name, then issue an error containing, desc.
+*/
+
+static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high)
+{
+ DynamicStrings_String s;
+ char desc[_desc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (desc, desc_, _desc_high+1);
+
+ if ((decl_getSymName (module)) != name)
+ {
+ s = DynamicStrings_InitString ((const char *) "inconsistent module name found with this ", 41);
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) desc, _desc_high)));
+ ErrorString (s);
+ }
+}
+
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ unsigned int n;
+ DynamicStrings_String str;
+ DynamicStrings_String message;
+
+ n = 0;
+ message = DynamicStrings_InitString ((const char *) "", 0);
+ if ((((1 << (mcReserved_stringtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "string", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_realtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "real number", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_identtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_integertok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "integer number", 14)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_inlinetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__INLINE__", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_builtintok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__BUILTIN__", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_attributetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__ATTRIBUTE__", 13)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_filetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__FILE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_linetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__LINE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_datetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__DATE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "...", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_volatiletok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VOLATILE", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_asmtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ASM", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_withtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WITH", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_whiletok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WHILE", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_vartok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VAR", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_untiltok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNTIL", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_typetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TYPE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_totok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TO", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_thentok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "THEN", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_settok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "SET", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_returntok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETURN", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_retrytok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETRY", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_repeattok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REPEAT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_remtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REM", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_recordtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RECORD", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_unqualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNQUALIFIED", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "QUALIFIED", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_proceduretok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PROCEDURE", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_pointertok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "POINTER", 7)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_packedsettok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PACKEDSET", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ortok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OR", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_oftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OF", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_nottok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "NOT", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_moduletok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MODULE", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_modtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MOD", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_looptok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "LOOP", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_intok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IN", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_importtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPORT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_implementationtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPLEMENTATION", 14)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_iftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IF", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_fromtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FROM", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_fortok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FOR", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_finallytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FINALLY", 7)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_exporttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXPORT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_exittok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXIT", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_excepttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXCEPT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_endtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "END", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_elsiftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSIF", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_elsetok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_dotok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DO", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_divtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DIV", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_definitiontok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DEFINITION", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_consttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CONST", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_casetok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CASE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_bytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BY", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_begintok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BEGIN", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_arraytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ARRAY", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_andtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "AND", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_colontok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodperiodtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "..", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*>", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<*", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lessequaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<>", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_hashtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "#", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_equaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "^", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_semicolontok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ";", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_commatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ",", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "&", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_dividetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "/", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_timestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_minustok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_plustok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "+", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_doublequotestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ',');
+ n += 1;
+ }
+ if ((((1 << (mcReserved_singlequotetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ',');
+ n += 1;
+ }
+ if ((((1 << (mcReserved_greatertok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lesstok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rparatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lparatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rcbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lcbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rsbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lsbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_bartok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_becomestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_eoftok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {} /* empty. */
+ /* eoftok has no token name (needed to generate error messages) */
+ if (n == 0)
+ {
+ str = DynamicStrings_InitString ((const char *) " syntax error", 13);
+ message = DynamicStrings_KillString (message);
+ }
+ else if (n == 1)
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message);
+ message = DynamicStrings_KillString (message);
+ }
+ return str;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void)
+{
+ DynamicStrings_String str;
+
+ str = DynamicStrings_InitString ((const char *) "", 0);
+ switch (mcLexBuf_currenttoken)
+ {
+ case mcReserved_stringtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found string", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_realtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found real number", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_identtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_integertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found integer number", 34), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_inlinetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __INLINE__", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_builtintok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __BUILTIN__", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_attributetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __ATTRIBUTE__", 33), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_filetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __FILE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_linetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __LINE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_datetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __DATE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodperiodperiodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ...", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_volatiletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VOLATILE", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_asmtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ASM", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_withtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WITH", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_whiletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WHILE", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_vartok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VAR", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_untiltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNTIL", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_typetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TYPE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_totok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TO", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_thentok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found THEN", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_settok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found SET", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_returntok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETURN", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_retrytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETRY", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_repeattok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REPEAT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_remtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REM", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_recordtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RECORD", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_unqualifiedtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNQUALIFIED", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_qualifiedtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found QUALIFIED", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_proceduretok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PROCEDURE", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_pointertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found POINTER", 27), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_packedsettok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PACKEDSET", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ortok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OR", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_oftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OF", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_nottok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found NOT", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_moduletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MODULE", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_modtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MOD", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_looptok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found LOOP", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_intok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IN", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_importtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPORT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_implementationtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPLEMENTATION", 34), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_iftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IF", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_fromtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FROM", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_fortok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FOR", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_finallytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FINALLY", 27), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_exporttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXPORT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_exittok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXIT", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_excepttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXCEPT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_endtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found END", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_elsiftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSIF", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_elsetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_dotok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DO", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_divtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DIV", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_definitiontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DEFINITION", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_consttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CONST", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_casetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CASE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_bytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BY", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_begintok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BEGIN", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_arraytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ARRAY", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_andtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found AND", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_colontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodperiodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ..", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rdirectivetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *>", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ldirectivetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <*", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_greaterequaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lessequaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lessgreatertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <>", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_hashtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found #", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_equaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_uparrowtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ^", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_semicolontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ;", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_commatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ,", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found .", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ambersandtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found &", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_dividetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found /", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_timestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_minustok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found -", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_plustok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found +", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_doublequotestok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_singlequotetok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_greatertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lesstok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rcbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lcbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rsbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lsbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_bartok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_becomestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_eoftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str));
+ break;
+
+
+ default:
+ break;
+ }
+ ErrorString (str);
+}
+
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ DescribeError ();
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "\\nskipping token *** ", 21);
+ }
+ /*
+ yes the ORD(currenttoken) looks ugly, but it is *much* safer than
+ using currenttoken<sometok as a change to the ordering of the
+ token declarations below would cause this to break. Using ORD() we are
+ immune from such changes
+ */
+ while (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0)))))
+ {
+ mcLexBuf_getToken ();
+ }
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) " ***\\n", 6);
+ }
+}
+
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ /* and again (see above re: ORD)
+ */
+ if (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0)))))
+ {
+ SyntaxError (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*/
+
+static void WarnMissingToken (mcReserved_toktype t)
+{
+ mcp2_SetOfStop0 s0;
+ mcp2_SetOfStop1 s1;
+ mcp2_SetOfStop2 s2;
+ DynamicStrings_String str;
+
+ s0 = (mcp2_SetOfStop0) 0;
+ s1 = (mcp2_SetOfStop1) 0;
+ s2 = (mcp2_SetOfStop2) 0;
+ if ( ((unsigned int) (t)) < 32)
+ {
+ s0 = (mcp2_SetOfStop0) ((1 << (t-mcReserved_eoftok)));
+ }
+ else if ( ((unsigned int) (t)) < 64)
+ {
+ /* avoid dangling else. */
+ s1 = (mcp2_SetOfStop1) ((1 << (t-mcReserved_arraytok)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ s2 = (mcp2_SetOfStop2) ((1 << (t-mcReserved_recordtok)));
+ }
+ str = DescribeStop (s0, s1, s2);
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error,", 13), DynamicStrings_Mark (str));
+ mcError_errorStringAt (str, mcLexBuf_getTokenNo ());
+}
+
+
+/*
+ MissingToken - generates a warning message about a missing token, t.
+*/
+
+static void MissingToken (mcReserved_toktype t)
+{
+ WarnMissingToken (t);
+ if ((((t != mcReserved_identtok) && (t != mcReserved_integertok)) && (t != mcReserved_realtok)) && (t != mcReserved_stringtok))
+ {
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "inserting token\\n", 17);
+ }
+ mcLexBuf_insertToken (t);
+ }
+}
+
+
+/*
+ CheckAndInsert -
+*/
+
+static unsigned int CheckAndInsert (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0))))
+ {
+ WarnMissingToken (t);
+ mcLexBuf_insertTokenAndRewind (t);
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InStopSet
+*/
+
+static unsigned int InStopSet (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0))))
+ {
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
+ If it is not then it will insert a token providing the token
+ is one of ; ] ) } . OF END ,
+
+ if the stopset contains <identtok> then we do not insert a token
+*/
+
+static void PeepToken (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ /* and again (see above re: ORD)
+ */
+ if ((! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) && (! (InStopSet (mcReserved_identtok, stopset0, stopset1, stopset2))))
+ {
+ /* SyntaxCheck would fail since currentoken is not part of the stopset
+ we check to see whether any of currenttoken might be a commonly omitted token */
+ if ((((((((CheckAndInsert (mcReserved_semicolontok, stopset0, stopset1, stopset2)) || (CheckAndInsert (mcReserved_rsbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rparatok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rcbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_periodtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_oftok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_endtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_commatok, stopset0, stopset1, stopset2)))
+ {} /* empty. */
+ }
+}
+
+
+/*
+ Expect -
+*/
+
+static void Expect (mcReserved_toktype t, mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == t)
+ {
+ /* avoid dangling else. */
+ mcLexBuf_getToken ();
+ if (Pass1)
+ {
+ PeepToken (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ MissingToken (t);
+ }
+ SyntaxCheck (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ curident = nameKey_makekey (mcLexBuf_currentstring);
+ Expect (mcReserved_identtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ string -
+*/
+
+static void string (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ /*
+ PushTF(makekey(currentstring), stringtok) ;
+ BuildString
+ */
+ Expect (mcReserved_stringtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Integer -
+*/
+
+static void Integer (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ /*
+ PushTF(makekey(currentstring), integertok) ;
+ BuildNumber
+ */
+ Expect (mcReserved_integertok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Real -
+*/
+
+static void Real (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ /*
+ PushTF(makekey(currentstring), realtok) ;
+ BuildNumber
+ */
+ Expect (mcReserved_realtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ registerImport - looks up module, ident, and adds it to the
+ current module import list.
+*/
+
+static void registerImport (nameKey_Name ident, unsigned int scoped)
+{
+ decl_node n;
+
+ n = decl_lookupDef (ident);
+ decl_addImportedModule (decl_getCurrentModule (), n, scoped);
+}
+
+
+/*
+ FileUnit := DefinitionModule |
+ ImplementationOrProgramModule
+
+ first symbols:implementationtok, moduletok, definitiontok
+
+ cannot reachend
+*/
+
+static void FileUnit (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_definitiontok)
+ {
+ DefinitionModule (stopset0, stopset1, stopset2);
+ }
+ else if (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_implementationtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ ImplementationOrProgramModule (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IMPLEMENTATION MODULE DEFINITION", 50);
+ }
+}
+
+
+/*
+ ProgramModule := 'MODULE' Ident
+ % curmodule := lookupModule (curident) %
+
+ % enterScope (curmodule) %
+ [ Priority ] ';' { Import } Block
+ Ident
+ % checkEndName (curmodule, curident, 'program module') %
+
+ % leaveScope %
+
+ % setEnumsComplete (curmodule) %
+ '.'
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ProgramModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ curmodule = decl_lookupModule (curident);
+ decl_enterScope (curmodule);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ Block (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "program module", 14);
+ decl_leaveScope ();
+ decl_setEnumsComplete (curmodule);
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImplementationModule := 'IMPLEMENTATION' 'MODULE'
+ Ident
+ % curmodule := lookupImp (curident) %
+
+ % enterScope (lookupDef (curident)) %
+
+ % enterScope (curmodule) %
+ [ Priority ] ';' { Import }
+ Block Ident
+ % checkEndName (curmodule, curident, 'implementation module') %
+
+ % leaveScope ; leaveScope %
+
+ % setEnumsComplete (curmodule) %
+ '.'
+
+ first symbols:implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_implementationtok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ curmodule = decl_lookupImp (curident);
+ decl_enterScope (decl_lookupDef (curident));
+ decl_enterScope (curmodule);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ Block (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "implementation module", 21);
+ decl_leaveScope ();
+ decl_leaveScope ();
+ decl_setEnumsComplete (curmodule);
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImplementationOrProgramModule := ImplementationModule |
+ ProgramModule
+
+ first symbols:moduletok, implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationOrProgramModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_implementationtok)
+ {
+ ImplementationModule (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ ProgramModule (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: MODULE IMPLEMENTATION", 39);
+ }
+}
+
+
+/*
+ Number := Integer | Real
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void Number (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_integertok)
+ {
+ Integer (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_realtok)
+ {
+ /* avoid dangling else. */
+ Real (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: real number integer number", 44);
+ }
+}
+
+
+/*
+ Qualident := Ident { '.' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Qualident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ConstantDeclaration := Ident '=' ConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ConstantDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ SimpleConstExpr (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SimpleConstExpr (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Relation := '=' | '#' | '<>' | '<' | '<=' |
+ '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void Relation (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_hashtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_hashtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_intok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_intok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37);
+ }
+}
+
+
+/*
+ SimpleConstExpr := UnaryOrConstTerm { AddOperator
+ ConstTerm }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleConstExpr (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ UnaryOrConstTerm (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ AddOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ UnaryOrConstTerm := '+' ConstTerm |
+ '-' ConstTerm |
+ ConstTerm
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ identifier { string - +", 88);
+ }
+}
+
+
+/*
+ AddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void AddOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ortok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ortok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: OR - +", 24);
+ }
+}
+
+
+/*
+ ConstTerm := ConstFactor { MulOperator ConstFactor }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void ConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ ConstFactor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ MulOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstFactor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ }
+ /* while */
+}
+
+
+/*
+ MulOperator := '*' | '/' | 'DIV' | 'MOD' |
+ 'REM' | 'AND' | '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void MulOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_timestok)
+ {
+ Expect (mcReserved_timestok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_dividetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_dividetok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_divtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_divtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_modtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_modtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_remtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_remtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_andtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_andtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ambersandtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39);
+ }
+}
+
+
+/*
+ ConstFactor := Number | ConstString |
+ ConstSetOrQualidentOrFunction |
+ '(' ConstExpression ')' |
+ 'NOT' ConstFactor |
+ ConstAttribute
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void ConstFactor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ Number (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ ConstString (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ ConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_nottok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstFactor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ ConstAttribute (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( identifier { string integer number real number", 84);
+ }
+}
+
+
+/*
+ ConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void ConstString (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ string (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ComponentElement := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ComponentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ComponentValue := ComponentElement [ 'BY' ConstExpression ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ComponentValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ ComponentElement (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArraySetRecordValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ ComponentValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ComponentValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ Constructor := '{' [ ArraySetRecordValue ] '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void Constructor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lcbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ ArraySetRecordValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstSetOrQualidentOrFunction := Qualident [ Constructor |
+ ConstActualParameters ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void ConstSetOrQualidentOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ ConstActualParameters (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( {", 21);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ /* avoid dangling else. */
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: { identifier", 30);
+ }
+}
+
+
+/*
+ ConstActualParameters := ActualParameters
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ConstActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ ActualParameters (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' ConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void ConstAttribute (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstAttributeExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstAttributeExpression := Ident | '<' Qualident
+ ',' Ident '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void ConstAttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: < identifier", 30);
+ }
+}
+
+
+/*
+ ByteAlignment := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void ByteAlignment (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ AttributeExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ OptAlignmentExpression := [ AlignmentExpression ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void OptAlignmentExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ AlignmentExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AlignmentExpression := '(' ConstExpression ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void AlignmentExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Alignment := [ ByteAlignment ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void Alignment (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ ByteAlignment (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ TypeDeclaration := Ident
+ % typeDes := lookupSym (curident) %
+ '=' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void TypeDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ typeDes = decl_lookupSym (curident);
+ Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Type := ( DefSimpleType | ArrayType |
+ RecordType | SetType | PointerType |
+ ProcedureType )
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void Type (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ DefSimpleType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ /* avoid dangling else. */
+ ArrayType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_recordtok)
+ {
+ /* avoid dangling else. */
+ RecordType (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok))
+ {
+ /* avoid dangling else. */
+ SetType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_pointertok)
+ {
+ /* avoid dangling else. */
+ PointerType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80);
+ }
+}
+
+
+/*
+ SimpleType := Qualident [ SubrangeType ] |
+ Enumeration | SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void SimpleType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Enumeration (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: [ ( identifier", 32);
+ }
+}
+
+
+/*
+ EnumIdentList :=
+ % VAR n, f: node ; %
+
+ % n := makeEnum () %
+ Ident
+ % f := makeEnumField (n, curident) %
+ { ',' Ident
+ % f := makeEnumField (n, curident) %
+ }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void EnumIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ decl_node n;
+ decl_node f;
+
+ n = decl_makeEnum ();
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ f = decl_makeEnumField (n, curident);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ f = decl_makeEnumField (n, curident);
+ }
+ /* while */
+}
+
+
+/*
+ Enumeration := '(' ( EnumIdentList ) ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void Enumeration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ EnumIdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ IdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void IdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SubrangeType := '[' ConstExpression '..' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void SubrangeType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ArrayType := 'ARRAY' SimpleType { ',' SimpleType }
+ 'OF' Type
+
+ first symbols:arraytok
+
+ cannot reachend
+*/
+
+static void ArrayType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_arraytok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ Expect (mcReserved_oftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RecordType := 'RECORD' [ DefaultRecordAttributes ]
+ FieldListSequence 'END'
+
+ first symbols:recordtok
+
+ cannot reachend
+*/
+
+static void RecordType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_recordtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ DefaultRecordAttributes (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ FieldListSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefaultRecordAttributes := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void DefaultRecordAttributes (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ AttributeExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RecordFieldPragma := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void RecordFieldPragma (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldPragmaExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldPragmaExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FieldPragmaExpression := Ident PragmaConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FieldPragmaExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ PragmaConstExpression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ PragmaConstExpression := [ '(' ConstExpression ')' ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void PragmaConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AttributeExpression := Ident '(' ConstExpression
+ ')'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FieldListSequence := FieldListStatement { ';' FieldListStatement }
+
+ first symbols:casetok, identtok, semicolontok
+
+ reachend
+*/
+
+static void FieldListSequence (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ FieldListStatement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListStatement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ FieldListStatement := [ FieldList ]
+
+ first symbols:identtok, casetok
+
+ reachend
+*/
+
+static void FieldListStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_casetok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ FieldList (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FieldList := IdentList ':' Type RecordFieldPragma |
+ 'CASE' CaseTag 'OF' Varient { '|' Varient }
+ [ 'ELSE' FieldListSequence ] 'END'
+
+ first symbols:casetok, identtok
+
+ cannot reachend
+*/
+
+static void FieldList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ RecordFieldPragma (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_casetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_casetok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ CaseTag (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Varient (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_bartok)
+ {
+ Expect (mcReserved_bartok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Varient (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ Expect (mcReserved_elsetok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: CASE identifier", 33);
+ }
+}
+
+
+/*
+ TagIdent := [ Ident ]
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TagIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ CaseTag := TagIdent [ ':' Qualident ]
+
+ first symbols:colontok, identtok
+
+ reachend
+*/
+
+static void CaseTag (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ TagIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Varient := [ VarientCaseLabelList ':' FieldListSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Varient (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))))
+ {
+ VarientCaseLabelList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListSequence (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ VarientCaseLabelList := VarientCaseLabels { ','
+ VarientCaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabelList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ VarientCaseLabels (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ VarientCaseLabels (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ VarientCaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabels (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SilentConstExpression := SilentSimpleConstExpr [
+ SilentRelation SilentSimpleConstExpr ]
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentConstExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ SilentSimpleConstExpr (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ SilentRelation (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SilentSimpleConstExpr (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SilentRelation := '=' | '#' | '<>' | '<' |
+ '<=' | '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void SilentRelation (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_hashtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_hashtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_intok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_intok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37);
+ }
+}
+
+
+/*
+ SilentSimpleConstExpr := SilentUnaryOrConstTerm
+ { SilentAddOperator SilentConstTerm }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentSimpleConstExpr (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ SilentUnaryOrConstTerm (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ SilentAddOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SilentConstTerm (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SilentUnaryOrConstTerm := '+' SilentConstTerm |
+ '-' SilentConstTerm |
+ SilentConstTerm
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentUnaryOrConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SilentConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SilentConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ SilentConstTerm (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ { identifier string - +", 88);
+ }
+}
+
+
+/*
+ SilentAddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentAddOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ortok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ortok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: OR - +", 24);
+ }
+}
+
+
+/*
+ SilentConstTerm := SilentConstFactor { SilentMulOperator
+ SilentConstFactor }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void SilentConstTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ SilentConstFactor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ SilentMulOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstFactor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ }
+ /* while */
+}
+
+
+/*
+ SilentMulOperator := '*' | '/' | 'DIV' |
+ 'MOD' | 'REM' | 'AND' |
+ '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void SilentMulOperator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_timestok)
+ {
+ Expect (mcReserved_timestok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_dividetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_dividetok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_divtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_divtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_modtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_modtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_remtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_remtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_andtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_andtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ambersandtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39);
+ }
+}
+
+
+/*
+ SilentConstFactor := Number | SilentConstString |
+ SilentConstSetOrQualidentOrFunction |
+ '(' SilentConstExpression ')' |
+ 'NOT' SilentConstFactor |
+ SilentConstAttribute
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void SilentConstFactor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ Number (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ SilentConstString (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ SilentConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_nottok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstFactor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ SilentConstAttribute (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( { identifier string integer number real number", 84);
+ }
+}
+
+
+/*
+ SilentConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void SilentConstString (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ string (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SilentConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' SilentConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void SilentConstAttribute (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SilentConstAttributeExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SilentConstAttributeExpression := Ident |
+ '<' Ident ','
+ SilentConstString
+ '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void SilentConstAttributeExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstString (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: < identifier", 30);
+ }
+}
+
+
+/*
+ SilentComponentElement := SilentConstExpression
+ [ '..' SilentConstExpression ]
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentComponentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ SilentConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SilentComponentValue := SilentComponentElement [
+ 'BY' SilentConstExpression ]
+
+ first symbols:attributetok, lcbratok, identtok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void SilentComponentValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ SilentComponentElement (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SilentArraySetRecordValue := SilentComponentValue
+ { ',' SilentComponentValue }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentArraySetRecordValue (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ SilentComponentValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentComponentValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SilentConstructor := '{' [ SilentArraySetRecordValue ]
+ '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void SilentConstructor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lcbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ SilentArraySetRecordValue (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SilentConstSetOrQualidentOrFunction := SilentConstructor |
+ Qualident
+ [ SilentConstructor |
+ SilentActualParameters ]
+
+ first symbols:identtok, lcbratok
+
+ cannot reachend
+*/
+
+static void SilentConstSetOrQualidentOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ SilentConstructor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ SilentConstructor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ SilentActualParameters (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( {", 21);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier {", 30);
+ }
+}
+
+
+/*
+ SilentElement := SilentConstExpression [ '..' SilentConstExpression ]
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ SilentConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SilentActualParameters := '(' [ SilentExpList ]
+ ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void SilentActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ SilentExpList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SilentExpList := SilentConstExpression { ',' SilentConstExpression }
+
+ first symbols:stringtok, identtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SilentExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ SilentConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ SilentConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType
+
+ first symbols:oftok, packedsettok, settok
+
+ cannot reachend
+*/
+
+static void SetType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_settok)
+ {
+ Expect (mcReserved_settok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_packedsettok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_packedsettok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PACKEDSET SET", 31);
+ }
+ Expect (mcReserved_oftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ PointerType := 'POINTER' 'TO' Type
+
+ first symbols:pointertok
+
+ cannot reachend
+*/
+
+static void PointerType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_pointertok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok))));
+ Expect (mcReserved_totok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureType := 'PROCEDURE' [ FormalTypeList ]
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ FormalTypeList (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FormalTypeList := '(' ( ')' FormalReturn |
+ ProcedureParameters ')'
+ FormalReturn )
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalTypeList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_rparatok)
+ {
+ Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ ProcedureParameters (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: VAR ... ARRAY identifier )", 44);
+ }
+}
+
+
+/*
+ FormalReturn := [ ':' OptReturnType ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void FormalReturn (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ OptReturnType (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ OptReturnType := '[' Qualident ']' |
+ Qualident
+
+ first symbols:identtok, lsbratok
+
+ cannot reachend
+*/
+
+static void OptReturnType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier [", 30);
+ }
+}
+
+
+/*
+ ProcedureParameters := ProcedureParameter { ','
+ ProcedureParameter }
+
+ first symbols:identtok, arraytok, periodperiodperiodtok, vartok
+
+ cannot reachend
+*/
+
+static void ProcedureParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ ProcedureParameter (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureParameter (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ProcedureParameter := '...' | 'VAR' FormalType |
+ FormalType
+
+ first symbols:arraytok, identtok, vartok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ProcedureParameter (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ FormalType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ARRAY identifier VAR ...", 42);
+ }
+}
+
+
+/*
+ VarIdent := Ident [ '[' ConstExpression ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Expect (mcReserved_lsbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ VarIdentList := VarIdent { ',' VarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ VarIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ VarIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ VariableDeclaration := VarIdentList ':' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VariableDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ VarIdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefVarIdent := Ident [ '[' ConstExpression ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefVarIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Expect (mcReserved_lsbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ DefVarIdentList := DefVarIdent { ',' DefVarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefVarIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ DefVarIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefVarIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ DefVariableDeclaration :=
+ % typeDes := NIL %
+ DefVarIdentList ':' Type
+ Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefVariableDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ typeDes = static_cast<decl_node> (NULL);
+ DefVarIdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Designator := Qualident { SubDesignator }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Designator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0)))
+ {
+ SubDesignator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SubDesignator := '.' Ident | '[' ArrayExpList ']' |
+ '^'
+
+ first symbols:uparrowtok, lsbratok, periodtok
+
+ cannot reachend
+*/
+
+static void SubDesignator (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lsbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ArrayExpList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_uparrowtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_uparrowtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ^ [ .", 23);
+ }
+}
+
+
+/*
+ ArrayExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArrayExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ExpList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ Expression := SimpleExpression [ Relation SimpleExpression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void Expression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ SimpleExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SimpleExpression := UnaryOrTerm { AddOperator Term }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleExpression (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ UnaryOrTerm (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ AddOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ UnaryOrTerm := '+' Term | '-' Term |
+ Term
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrTerm (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ Term (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( string integer number real number identifier { - +", 74);
+ }
+}
+
+
+/*
+ Term := Factor { MulOperator Factor }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void Term (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Factor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ MulOperator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Factor (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ }
+ /* while */
+}
+
+
+/*
+ Factor := Number | string | SetOrDesignatorOrFunction |
+ '(' Expression ')' |
+ 'NOT' ( Factor | ConstAttribute )
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void Factor (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ Number (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ string (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ SetOrDesignatorOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_nottok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ Factor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ ConstAttribute (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ real number integer number string ( NOT { identifier", 84);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( identifier { string integer number real number", 70);
+ }
+}
+
+
+/*
+ SetOrDesignatorOrFunction := Qualident [ Constructor |
+ SimpleDes
+ [ ActualParameters ] ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void SetOrDesignatorOrFunction (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ SimpleDes (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ ActualParameters (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( ^ [ . {", 27);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ /* avoid dangling else. */
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: { identifier", 30);
+ }
+}
+
+
+/*
+ SimpleDes := { SubDesignator }
+
+ first symbols:periodtok, lsbratok, uparrowtok
+
+ reachend
+*/
+
+static void SimpleDes (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0)))
+ {
+ SubDesignator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ActualParameters := '(' [ ExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ActualParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ ExpList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ExitStatement := 'EXIT'
+
+ first symbols:exittok
+
+ cannot reachend
+*/
+
+static void ExitStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_exittok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ReturnStatement := 'RETURN' [ Expression ]
+
+ first symbols:returntok
+
+ cannot reachend
+*/
+
+static void ReturnStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_returntok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ Expression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Statement := [ AssignmentOrProcedureCall |
+ IfStatement | CaseStatement |
+ WhileStatement |
+ RepeatStatement |
+ LoopStatement | ForStatement |
+ WithStatement | AsmStatement |
+ ExitStatement | ReturnStatement |
+ RetryStatement ]
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok
+
+ reachend
+*/
+
+static void Statement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ AssignmentOrProcedureCall (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_iftok)
+ {
+ /* avoid dangling else. */
+ IfStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_casetok)
+ {
+ /* avoid dangling else. */
+ CaseStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_whiletok)
+ {
+ /* avoid dangling else. */
+ WhileStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_repeattok)
+ {
+ /* avoid dangling else. */
+ RepeatStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_looptok)
+ {
+ /* avoid dangling else. */
+ LoopStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_fortok)
+ {
+ /* avoid dangling else. */
+ ForStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_withtok)
+ {
+ /* avoid dangling else. */
+ WithStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_asmtok)
+ {
+ /* avoid dangling else. */
+ AsmStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_exittok)
+ {
+ /* avoid dangling else. */
+ ExitStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_returntok)
+ {
+ /* avoid dangling else. */
+ ReturnStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_retrytok)
+ {
+ /* avoid dangling else. */
+ RetryStatement (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: RETRY RETURN EXIT ASM WITH FOR LOOP REPEAT WHILE CASE IF identifier", 85);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ RetryStatement := 'RETRY'
+
+ first symbols:retrytok
+
+ cannot reachend
+*/
+
+static void RetryStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_retrytok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AssignmentOrProcedureCall := Designator ( ':=' Expression |
+ ActualParameters |
+
+ % epsilon %
+ )
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AssignmentOrProcedureCall (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Designator (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_becomestok)
+ {
+ Expect (mcReserved_becomestok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ ActualParameters (stopset0, stopset1, stopset2);
+ }
+ /* epsilon */
+}
+
+
+/*
+ StatementSequence := Statement { ';' Statement }
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok
+
+ reachend
+*/
+
+static void StatementSequence (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Statement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Statement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ IfStatement := 'IF' Expression 'THEN' StatementSequence
+ { 'ELSIF' Expression 'THEN' StatementSequence }
+ [ 'ELSE' StatementSequence ] 'END'
+
+ first symbols:iftok
+
+ cannot reachend
+*/
+
+static void IfStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_iftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok))));
+ Expect (mcReserved_thentok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_elsiftok)
+ {
+ Expect (mcReserved_elsiftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok))));
+ Expect (mcReserved_thentok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ Expect (mcReserved_elsetok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ CaseStatement := 'CASE' Expression 'OF' Case { '|'
+ Case }
+ CaseEndStatement
+
+ first symbols:casetok
+
+ cannot reachend
+*/
+
+static void CaseStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_casetok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Case (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_bartok)
+ {
+ Expect (mcReserved_bartok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Case (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ CaseEndStatement (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ CaseEndStatement := 'END' | 'ELSE' StatementSequence
+ 'END'
+
+ first symbols:elsetok, endtok
+
+ cannot reachend
+*/
+
+static void CaseEndStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_endtok)
+ {
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_elsetok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ELSE END", 26);
+ }
+}
+
+
+/*
+ Case := [ CaseLabelList ':' StatementSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Case (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))))
+ {
+ CaseLabelList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ CaseLabelList := CaseLabels { ',' CaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void CaseLabelList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ CaseLabels (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ CaseLabels (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ CaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void CaseLabels (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ WhileStatement := 'WHILE' Expression 'DO' StatementSequence
+ 'END'
+
+ first symbols:whiletok
+
+ cannot reachend
+*/
+
+static void WhileStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_whiletok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_dotok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RepeatStatement := 'REPEAT' StatementSequence 'UNTIL'
+ Expression
+
+ first symbols:repeattok
+
+ cannot reachend
+*/
+
+static void RepeatStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_repeattok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_untiltok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_untiltok-mcReserved_recordtok))));
+ Expect (mcReserved_untiltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ForStatement := 'FOR' Ident ':=' Expression 'TO'
+ Expression [ 'BY' ConstExpression ]
+ 'DO' StatementSequence 'END'
+
+ first symbols:fortok
+
+ cannot reachend
+*/
+
+static void ForStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_becomestok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok))));
+ Expect (mcReserved_totok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok)) | (1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_dotok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ LoopStatement := 'LOOP' StatementSequence 'END'
+
+ first symbols:looptok
+
+ cannot reachend
+*/
+
+static void LoopStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_looptok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ WithStatement := 'WITH' Designator 'DO' StatementSequence
+ 'END'
+
+ first symbols:withtok
+
+ cannot reachend
+*/
+
+static void WithStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_withtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Designator (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_dotok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock
+ Ident
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ ProcedureHeading (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ ProcedureBlock (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ProcedureIdent (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0, stopset1, stopset2);
+ curproc = decl_lookupSym (curident);
+}
+
+
+/*
+ DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' Ident ')' ')' |
+ '__INLINE__' ]
+
+ first symbols:inlinetok, attributetok
+
+ reachend
+*/
+
+static void DefineBuiltinProcedure (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_inlinetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __INLINE__ __ATTRIBUTE__", 42);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure
+ ( ProcedureIdent
+ % enterScope (curproc) %
+ [ FormalParameters ] AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureHeading (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefineBuiltinProcedure (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_enterScope (curproc);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ FormalParameters (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ AttributeNoReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Builtin := [ '__BUILTIN__' | '__INLINE__' ]
+
+ first symbols:inlinetok, builtintok
+
+ reachend
+*/
+
+static void Builtin (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_builtintok)
+ {
+ Expect (mcReserved_builtintok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_inlinetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __INLINE__ __BUILTIN__", 40);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ DefProcedureHeading := 'PROCEDURE' Builtin ( ProcedureIdent
+ [ DefFormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void DefProcedureHeading (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Builtin (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureIdent (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ DefFormalParameters (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ AttributeNoReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ]
+ 'END'
+ % leaveScope %
+
+
+ first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok
+
+ cannot reachend
+*/
+
+static void ProcedureBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Declaration (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_begintok)
+ {
+ Expect (mcReserved_begintok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ ProcedureBlockBody (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ decl_leaveScope ();
+}
+
+
+/*
+ Block := { Declaration } InitialBlock FinalBlock
+ 'END'
+
+ first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok
+
+ cannot reachend
+*/
+
+static void Block (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Declaration (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ InitialBlock (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok))), stopset2);
+ FinalBlock (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ InitialBlock := [ 'BEGIN' InitialBlockBody ]
+
+ first symbols:begintok
+
+ reachend
+*/
+
+static void InitialBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_begintok)
+ {
+ Expect (mcReserved_begintok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ InitialBlockBody (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FinalBlock := [ 'FINALLY' FinalBlockBody ]
+
+ first symbols:finallytok
+
+ reachend
+*/
+
+static void FinalBlock (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_finallytok)
+ {
+ Expect (mcReserved_finallytok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ FinalBlockBody (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void InitialBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void FinalBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void ProcedureBlockBody (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ NormalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void NormalPart (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ StatementSequence (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ExceptionalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ExceptionalPart (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ StatementSequence (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Declaration := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration ';' } |
+ 'VAR' { VariableDeclaration ';' } |
+ ProcedureDeclaration ';' |
+ ModuleDeclaration ';'
+
+ first symbols:moduletok, proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Declaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_consttok)
+ {
+ Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ ConstantDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_typetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ TypeDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ VariableDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ ModuleDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: MODULE PROCEDURE VAR TYPE CONST", 49);
+ }
+}
+
+
+/*
+ DefFormalParameters := '(' [ DefMultiFPSection ]
+ ')' FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefFormalParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ DefMultiFPSection (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefMultiFPSection := DefExtendedFP |
+ FPSection [ ';' DefMultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefMultiFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok))
+ {
+ DefExtendedFP (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ FPSection (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ DefMultiFPSection (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38);
+ }
+}
+
+
+/*
+ FormalParameters := '(' [ MultiFPSection ] ')'
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalParameters (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ MultiFPSection (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AttributeNoReturn := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeNoReturn (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AttributeUnused := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeUnused (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ MultiFPSection := ExtendedFP | FPSection [ ';'
+ MultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void MultiFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok))
+ {
+ ExtendedFP (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ FPSection (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ MultiFPSection (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38);
+ }
+}
+
+
+/*
+ FPSection := NonVarFPSection |
+ VarFPSection
+
+ first symbols:vartok, identtok
+
+ cannot reachend
+*/
+
+static void FPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ NonVarFPSection (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ VarFPSection (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: VAR identifier", 32);
+ }
+}
+
+
+/*
+ DefExtendedFP := DefOptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefExtendedFP (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ DefOptArg (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ... [", 23);
+ }
+}
+
+
+/*
+ ExtendedFP := OptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ExtendedFP (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ OptArg (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ... [", 23);
+ }
+}
+
+
+/*
+ VarFPSection := 'VAR' IdentList ':' FormalType [
+ AttributeUnused ]
+
+ first symbols:vartok
+
+ cannot reachend
+*/
+
+static void VarFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ AttributeUnused (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void NonVarFPSection (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ AttributeUnused (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ]
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void OptArg (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefOptArg := '[' Ident ':' FormalType '=' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void DefOptArg (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FormalType := { 'ARRAY' 'OF' } Qualident
+
+ first symbols:identtok, arraytok
+
+ cannot reachend
+*/
+
+static void FormalType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ while (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ Expect (mcReserved_arraytok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ Qualident (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ModuleDeclaration := 'MODULE' Ident [ Priority ]
+ ';' { Import } [ Export ]
+ Block Ident
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ModuleDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_exporttok)
+ {
+ Export (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ Block (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Priority := '[' ConstExpression ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void Priority (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Export := 'EXPORT' ( 'QUALIFIED' IdentList |
+ 'UNQUALIFIED' IdentList |
+ IdentList ) ';'
+
+ first symbols:exporttok
+
+ cannot reachend
+*/
+
+static void Export (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_exporttok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) | (1 << (mcReserved_unqualifiedtok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_qualifiedtok)
+ {
+ Expect (mcReserved_qualifiedtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_unqualifiedtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_unqualifiedtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier UNQUALIFIED QUALIFIED", 50);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FromImport := 'FROM' Ident 'IMPORT' IdentList ';'
+
+ first symbols:fromtok
+
+ cannot reachend
+*/
+
+static void FromImport (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_fromtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImportModuleList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ImportModuleList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ WithoutFromImport := 'IMPORT' ImportModuleList ';'
+
+ first symbols:importtok
+
+ cannot reachend
+*/
+
+static void WithoutFromImport (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ImportModuleList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Import := FromImport | WithoutFromImport
+
+ first symbols:importtok, fromtok
+
+ cannot reachend
+*/
+
+static void Import (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_fromtok)
+ {
+ FromImport (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_importtok)
+ {
+ /* avoid dangling else. */
+ WithoutFromImport (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IMPORT FROM", 29);
+ }
+}
+
+
+/*
+ DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR'
+ string ]
+ Ident ';'
+ % curmodule := lookupDef (curident) %
+
+ % enterScope (curmodule) %
+ { Import } [ Export ] { Definition }
+ 'END' Ident '.'
+ % checkEndName (curmodule, curident, 'definition module') %
+
+ % leaveScope %
+
+ % setEnumsComplete (curmodule) %
+
+
+ first symbols:definitiontok
+
+ cannot reachend
+*/
+
+static void DefinitionModule (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_definitiontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_moduletok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_fortok)
+ {
+ Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ curmodule = decl_lookupDef (curident);
+ decl_enterScope (curmodule);
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_exporttok)
+ {
+ Export (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Definition (stopset0, stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "definition module", 17);
+ decl_leaveScope ();
+ decl_setEnumsComplete (curmodule);
+}
+
+
+/*
+ DefQualident := Ident
+ % typeExp := lookupSym (curident) %
+ [ '.'
+ % IF NOT isDef (typeExp)
+ THEN
+ ErrorArray ('the first component of this qualident must be a definition module')
+ END %
+ Ident
+ % typeExp := lookupInScope (typeExp, curident) ;
+ IF typeExp=NIL
+ THEN
+ ErrorArray ('identifier not found in definition module')
+ END %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefQualident (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ typeExp = decl_lookupSym (curident);
+ if (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (! (decl_isDef (typeExp)))
+ {
+ ErrorArray ((const char *) "the first component of this qualident must be a definition module", 65);
+ }
+ Ident (stopset0, stopset1, stopset2);
+ typeExp = decl_lookupInScope (typeExp, curident);
+ if (typeExp == NULL)
+ {
+ ErrorArray ((const char *) "identifier not found in definition module", 41);
+ }
+ }
+}
+
+
+/*
+ DefOptSubrange := [ SubrangeType |
+
+ % putType (typeDes, typeExp) %
+ ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void DefOptSubrange (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ decl_putType (typeDes, typeExp);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ DefTypeEquiv := DefQualident DefOptSubrange
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefTypeEquiv (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ DefQualident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ DefOptSubrange (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefEnumIdentList :=
+ % VAR n, f: node ; %
+
+ % n := makeEnum () %
+ Ident
+ % f := makeEnumField (n, curident) %
+ { ',' Ident
+ % f := makeEnumField (n, curident) %
+ }
+ % IF typeDes # NIL THEN putType (typeDes, n) END %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefEnumIdentList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ decl_node n;
+ decl_node f;
+
+ n = decl_makeEnum ();
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ f = decl_makeEnumField (n, curident);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ f = decl_makeEnumField (n, curident);
+ }
+ /* while */
+ if (typeDes != NULL)
+ {
+ decl_putType (typeDes, n);
+ }
+}
+
+
+/*
+ DefEnumeration := '(' DefEnumIdentList ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefEnumeration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefEnumIdentList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefSimpleType := DefTypeEquiv | DefEnumeration |
+ SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void DefSimpleType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ DefTypeEquiv (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ DefEnumeration (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: [ ( identifier", 32);
+ }
+}
+
+
+/*
+ DefType := DefSimpleType | ArrayType |
+ RecordType | SetType | PointerType |
+ ProcedureType
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void DefType (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ DefSimpleType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ /* avoid dangling else. */
+ ArrayType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_recordtok)
+ {
+ /* avoid dangling else. */
+ RecordType (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp2_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok))
+ {
+ /* avoid dangling else. */
+ SetType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_pointertok)
+ {
+ /* avoid dangling else. */
+ PointerType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80);
+ }
+}
+
+
+/*
+ DefTypeDeclaration := { Ident
+ % typeDes := lookupSym (curident) %
+ ( ';' | '=' DefType Alignment
+ ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void DefTypeDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ typeDes = decl_lookupSym (curident);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefType (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: = ;", 21);
+ }
+ }
+ /* while */
+}
+
+
+/*
+ DefConstantDeclaration := Ident '=' ConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefConstantDeclaration (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_equaltok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Definition := 'CONST' { DefConstantDeclaration ';' } |
+ 'TYPE' { DefTypeDeclaration } |
+ 'VAR' { DefVariableDeclaration ';' } |
+ DefProcedureHeading ';'
+
+ first symbols:proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Definition (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_consttok)
+ {
+ Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ DefConstantDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_typetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ DefTypeDeclaration (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ DefVariableDeclaration (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ DefProcedureHeading (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE VAR TYPE CONST", 42);
+ }
+}
+
+
+/*
+ AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands
+ ')'
+
+ first symbols:asmtok
+
+ cannot reachend
+*/
+
+static void AsmStatement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_asmtok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_volatiletok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_volatiletok)
+ {
+ Expect (mcReserved_volatiletok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmOperands (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AsmOperands := string [ AsmOperandSpec ]
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void AsmOperands (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ string (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ AsmOperandSpec (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AsmOperandSpec := [ ':' AsmList [ ':' AsmList [
+ ':' TrashList ] ] ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void AsmOperandSpec (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmList (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ TrashList (stopset0, stopset1, stopset2);
+ }
+ }
+ }
+}
+
+
+/*
+ AsmList := [ AsmElement ] { ',' AsmElement }
+
+ first symbols:lsbratok, stringtok, commatok
+
+ reachend
+*/
+
+static void AsmList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_stringtok))
+ {
+ AsmElement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmElement (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ NamedOperand := '[' Ident ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void NamedOperand (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AsmOperandName := [ NamedOperand ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void AsmOperandName (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ NamedOperand (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AsmElement := AsmOperandName string '(' Expression
+ ')'
+
+ first symbols:stringtok, lsbratok
+
+ cannot reachend
+*/
+
+static void AsmElement (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ AsmOperandName (stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp2_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ TrashList := [ string ] { ',' string }
+
+ first symbols:commatok, stringtok
+
+ reachend
+*/
+
+static void TrashList (mcp2_SetOfStop0 stopset0, mcp2_SetOfStop1 stopset1, mcp2_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ string (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp2_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0|(mcp2_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ CompilationUnit - returns TRUE if the input was correct enough to parse
+ in future passes.
+*/
+
+extern "C" unsigned int mcp2_CompilationUnit (void)
+{
+ WasNoError = TRUE;
+ FileUnit ((mcp2_SetOfStop0) ((1 << (mcReserved_eoftok-mcReserved_eoftok))), (mcp2_SetOfStop1) 0, (mcp2_SetOfStop2) 0);
+ return WasNoError;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcp2_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcp2_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcp3. */
+/* output from mc-3.bnf, automatically generated do not edit.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING. If not,
+see <https://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcp3_H
+#define _mcp3_C
+
+# include "GDynamicStrings.h"
+# include "GmcError.h"
+# include "GnameKey.h"
+# include "GmcPrintf.h"
+# include "GmcDebug.h"
+# include "GmcReserved.h"
+# include "GmcMetaError.h"
+# include "GmcStack.h"
+# include "GmcLexBuf.h"
+# include "Gdecl.h"
+
+# define Pass1 FALSE
+# define Debugging FALSE
+typedef unsigned int mcp3_stop0;
+
+typedef unsigned int mcp3_SetOfStop0;
+
+typedef unsigned int mcp3_stop1;
+
+typedef unsigned int mcp3_SetOfStop1;
+
+typedef unsigned int mcp3_stop2;
+
+typedef unsigned int mcp3_SetOfStop2;
+
+static unsigned int WasNoError;
+static unsigned int curisused;
+static nameKey_Name curstring;
+static nameKey_Name curident;
+static decl_node curproc;
+static decl_node frommodule;
+static decl_node typeDes;
+static decl_node typeExp;
+static decl_node curmodule;
+static mcStack_stack stk;
+
+/*
+ CompilationUnit - returns TRUE if the input was correct enough to parse
+ in future passes.
+*/
+
+extern "C" unsigned int mcp3_CompilationUnit (void);
+
+/*
+ push -
+*/
+
+static decl_node push (decl_node n);
+
+/*
+ pop -
+*/
+
+static decl_node pop (void);
+
+/*
+ replace -
+*/
+
+static decl_node replace (decl_node n);
+
+/*
+ peep - returns the top node on the stack without removing it.
+*/
+
+static decl_node peep (void);
+
+/*
+ depth - returns the depth of the stack.
+*/
+
+static unsigned int depth (void);
+
+/*
+ checkDuplicate -
+*/
+
+static void checkDuplicate (unsigned int b);
+
+/*
+ checkDuplicate -
+*/
+
+static void ErrorString (DynamicStrings_String s);
+
+/*
+ checkDuplicate -
+*/
+
+static void ErrorArray (const char *a_, unsigned int _a_high);
+
+/*
+ checkParameterAttribute -
+*/
+
+static void checkParameterAttribute (void);
+
+/*
+ checkReturnAttribute -
+*/
+
+static void checkReturnAttribute (void);
+
+/*
+ pushNunbounded -
+*/
+
+static void pushNunbounded (unsigned int c);
+
+/*
+ makeIndexedArray - builds and returns an array of type, t, with, c, indices.
+*/
+
+static decl_node makeIndexedArray (unsigned int c, decl_node t);
+
+/*
+ importInto - from, m, import, name, into module, current.
+ It checks to see if curident is an enumeration type
+ and if so automatically includes all enumeration fields
+ as well.
+*/
+
+static void importInto (decl_node m, nameKey_Name name, decl_node current);
+
+/*
+ checkEndName - if module does not have, name, then issue an error containing, desc.
+*/
+
+static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high);
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void);
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*/
+
+static void WarnMissingToken (mcReserved_toktype t);
+
+/*
+ MissingToken - generates a warning message about a missing token, t.
+*/
+
+static void MissingToken (mcReserved_toktype t);
+
+/*
+ CheckAndInsert -
+*/
+
+static unsigned int CheckAndInsert (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ InStopSet
+*/
+
+static unsigned int InStopSet (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
+ If it is not then it will insert a token providing the token
+ is one of ; ] ) } . OF END ,
+
+ if the stopset contains <identtok> then we do not insert a token
+*/
+
+static void PeepToken (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Expect -
+*/
+
+static void Expect (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ string -
+*/
+
+static void string (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Integer -
+*/
+
+static void Integer (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Real -
+*/
+
+static void Real (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FileUnit := DefinitionModule |
+ ImplementationOrProgramModule
+
+ first symbols:implementationtok, moduletok, definitiontok
+
+ cannot reachend
+*/
+
+static void FileUnit (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ProgramModule := 'MODULE' Ident
+ % curmodule := lookupModule (curident) %
+
+ % enterScope (curmodule) %
+
+ % resetEnumPos (curmodule) %
+ [ Priority ] ';' { Import } Block
+ Ident
+ % checkEndName (curmodule, curident, 'program module') %
+
+ % setConstExpComplete (curmodule) %
+
+ % leaveScope %
+ '.'
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ProgramModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ImplementationModule := 'IMPLEMENTATION' 'MODULE'
+ Ident
+ % curmodule := lookupImp (curident) %
+
+ % enterScope (lookupDef (curident)) %
+
+ % enterScope (curmodule) %
+
+ % resetEnumPos (curmodule) %
+ [ Priority ] ';' { Import }
+ Block Ident
+ % checkEndName (curmodule, curident, 'implementation module') %
+
+ % setConstExpComplete (curmodule) %
+
+ % leaveScope ; leaveScope %
+ '.'
+
+ first symbols:implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ImplementationOrProgramModule := ImplementationModule |
+ ProgramModule
+
+ first symbols:moduletok, implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationOrProgramModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Number := Integer | Real
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void Number (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Qualident := Ident { '.' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Qualident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ConstantDeclaration :=
+ % VAR d, e: node ; %
+ Ident
+ % d := lookupSym (curident) %
+ '=' ConstExpression
+ % e := pop () %
+
+ % assert (isConst (d)) %
+
+ % putConst (d, e) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ConstantDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ConstExpressionNop := SimpleConstExpr
+ % VAR n: node ; %
+ [ Relation SimpleConstExpr ]
+
+ % n := makeConstExp () %
+
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpressionNop (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ConstExpression :=
+ % VAR n: node ; %
+
+ % n := push (makeConstExp ()) %
+ SimpleConstExpr [ Relation SimpleConstExpr ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Relation := '=' | '#' | '<>' | '<' | '<=' |
+ '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void Relation (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ SimpleConstExpr := UnaryOrConstTerm { AddOperator
+ ConstTerm }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleConstExpr (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ UnaryOrConstTerm := '+' ConstTerm |
+ '-' ConstTerm |
+ ConstTerm
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrConstTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void AddOperator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ConstTerm := ConstFactor { MulOperator ConstFactor }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void ConstTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ MulOperator := '*' | '/' | 'DIV' | 'MOD' |
+ 'REM' | 'AND' | '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void MulOperator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ConstFactor := Number | ConstString |
+ ConstSetOrQualidentOrFunction |
+ '(' ConstExpressionNop ')' |
+ 'NOT' ConstFactor |
+ ConstAttribute
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void ConstFactor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void ConstString (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ComponentElement := ConstExpressionNop [ '..' ConstExpressionNop ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ComponentElement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ComponentValue := ComponentElement [ 'BY' ConstExpressionNop ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ComponentValue (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArraySetRecordValue (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Constructor := '{' [ ArraySetRecordValue ] '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void Constructor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ConstSetOrQualidentOrFunction := Qualident [ Constructor |
+ ConstActualParameters ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void ConstSetOrQualidentOrFunction (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ConstActualParameters := '(' [ ConstExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ConstActualParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ConstExpList := ConstExpressionNop { ',' ConstExpressionNop }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' ConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void ConstAttribute (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ConstAttributeExpression := Ident | '<' Qualident
+ ',' Ident '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void ConstAttributeExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ByteAlignment := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void ByteAlignment (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ OptAlignmentExpression := [ AlignmentExpression ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void OptAlignmentExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AlignmentExpression := '(' ConstExpressionNop ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void AlignmentExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Alignment := [ ByteAlignment ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void Alignment (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ IdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void IdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ PushIdentList :=
+ % VAR n: node ; %
+
+ % n := makeIdentList () %
+ Ident
+ % checkDuplicate (putIdent (n, curident)) %
+ { ',' Ident
+ % checkDuplicate (putIdent (n, curident)) %
+ }
+ % n := push (n) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void PushIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ SubrangeType :=
+ % VAR low, high: node ; d: CARDINAL ; %
+ '['
+ % d := depth () %
+ ConstExpression
+ % low := pop () %
+
+ % assert (d = depth ()) %
+ '..' ConstExpression
+ % high := pop () %
+
+ % assert (d = depth ()) %
+
+ % typeExp := push (makeSubrange (low, high)) %
+
+ % assert (d = depth () - 1) %
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void SubrangeType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ArrayType := 'ARRAY'
+ % VAR c: CARDINAL ; t, n: node ; %
+
+ % c := 0 %
+ SimpleType
+ % INC (c) %
+ { ',' SimpleType
+ % INC (c) %
+ } 'OF' Type
+ % n := push (makeIndexedArray (c, pop ())) %
+
+
+ first symbols:arraytok
+
+ cannot reachend
+*/
+
+static void ArrayType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ RecordType := 'RECORD'
+ % VAR n: node ; %
+
+ % n := push (makeRecord ()) %
+
+ % n := push (NIL) no varient %
+ [ DefaultRecordAttributes ] FieldListSequence
+
+ % assert (pop ()=NIL) %
+ 'END'
+
+ first symbols:recordtok
+
+ cannot reachend
+*/
+
+static void RecordType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ DefaultRecordAttributes := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void DefaultRecordAttributes (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ RecordFieldPragma := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void RecordFieldPragma (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FieldPragmaExpression := Ident PragmaConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FieldPragmaExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ PragmaConstExpression := [ '(' ConstExpressionNop
+ ')' ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void PragmaConstExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AttributeExpression := Ident '(' ConstExpressionNop
+ ')'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AttributeExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FieldListSequence := FieldListStatement { ';' FieldListStatement }
+
+ first symbols:casetok, identtok, semicolontok
+
+ reachend
+*/
+
+static void FieldListSequence (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FieldListStatement := [ FieldList ]
+
+ first symbols:identtok, casetok
+
+ reachend
+*/
+
+static void FieldListStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FieldList :=
+ % VAR r, i, f, t, n, v, w: node ; d: CARDINAL ; %
+
+ % d := depth () %
+
+ % v := pop () ; assert ((v=NIL) OR isVarient (v)) %
+
+ % r := peep () ; assert (isRecord (r) OR isVarientField (r)) %
+
+ % v := push (v) %
+
+ % assert (d=depth ()) %
+
+ % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isVarientField (r))) %
+ PushIdentList ':'
+ % assert (d=depth () - 1) %
+
+ % i := pop () %
+ Type
+ % assert (d=depth () - 1) %
+
+ % t := pop () %
+ RecordFieldPragma
+ % assert (d=depth ()) %
+
+ % r := addFieldsToRecord (r, v, i, t) %
+
+ % assert (d=depth ()) %
+ |
+ 'CASE'
+ % addRecordToList %
+
+ % d := depth () %
+
+ % v := pop () ; assert ((v=NIL) OR isVarient (v)) %
+
+ % r := peep () ; assert (isRecord (r) OR isVarientField (r)) %
+
+ % v := push (v) %
+
+ % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isRecordField (r))) %
+
+ % w := push (makeVarient (r)) %
+
+ % assert (d = depth () - 1) %
+
+ % addVarientToList %
+ CaseTag 'OF'
+ % assert (d = depth () - 1) %
+ Varient
+ % assert (d = depth () - 1) %
+ { '|' Varient
+ % assert (d = depth () - 1) %
+ }
+ % w := peep () ; assert (isVarient (w)) %
+
+ % assert (d = depth () - 1) %
+ [ 'ELSE' FieldListSequence ] 'END'
+
+ % w := pop () ; assert (isVarient (w)) %
+
+ % assert (d=depth ()) %
+
+
+ first symbols:casetok, identtok
+
+ cannot reachend
+*/
+
+static void FieldList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ TagIdent := Ident |
+ % curident := NulName %
+
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TagIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ CaseTag :=
+ % VAR tagident: Name ; q, v, w, r: node ; %
+
+ % w := pop () ; v := pop () ; r := peep () ; v := push (v) ; w := push (w) %
+
+ % assert (isVarient (w)) %
+
+ % assert ((v=NIL) OR isVarient (v)) %
+
+ % assert (isRecord (r) OR isVarientField (r)) %
+
+ % assert (isVarient (push (pop ()))) %
+ TagIdent
+ % tagident := curident %
+ ( ':' PushQualident
+ % q := pop () %
+
+ % assert (isVarient (push (pop ()))) %
+ |
+ % q := NIL %
+ )
+ % buildVarientSelector (r, w, tagident, q) %
+
+
+ first symbols:colontok, identtok
+
+ reachend
+*/
+
+static void CaseTag (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Varient :=
+ % VAR p, r, v, f: node ; d: CARDINAL ; %
+
+ % d := depth () %
+
+ % assert (isVarient (peep ())) %
+ [
+ % v := pop () ; assert (isVarient (v)) %
+
+ % r := pop () %
+
+ % p := peep () %
+
+ % r := push (r) %
+
+ % f := push (buildVarientFieldRecord (v, p)) %
+
+ % v := push (v) %
+ VarientCaseLabelList ':' FieldListSequence
+
+ % v := pop () %
+
+ % f := pop () %
+
+ % assert (isVarientField (f)) %
+
+ % assert (isVarient (v)) %
+
+ % v := push (v) %
+ ]
+ % assert (isVarient (peep ())) %
+
+ % assert (d=depth ()) %
+
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Varient (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ VarientCaseLabelList := VarientCaseLabels { ','
+ VarientCaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabelList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ VarientCaseLabels :=
+ % VAR l, h: node ; %
+
+ % h := NIL %
+ ConstExpression
+ % l := pop () %
+ [ '..' ConstExpression
+ % h := pop () %
+ ]
+ % l, h could be saved if necessary. %
+
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabels (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType
+
+ % VAR n: node ; %
+
+ % n := push (makeSet (pop ())) %
+
+
+ first symbols:oftok, packedsettok, settok
+
+ cannot reachend
+*/
+
+static void SetType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ PointerType := 'POINTER' 'TO' Type
+ % VAR n: node ; %
+
+ % n := push (makePointer (pop ())) %
+
+
+ first symbols:pointertok
+
+ cannot reachend
+*/
+
+static void PointerType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ProcedureType := 'PROCEDURE'
+ % curproc := push (makeProcType ()) %
+ [ FormalTypeList ]
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FormalTypeList := '(' ( ')' FormalReturn |
+ ProcedureParameters ')'
+ FormalReturn )
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalTypeList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FormalReturn := [ ':' OptReturnType ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void FormalReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ OptReturnType := '[' PushQualident
+ % putReturnType (curproc, pop ()) %
+
+ % putOptReturn (curproc) %
+ ']' | PushQualident
+ % putReturnType (curproc, pop ()) %
+
+
+ first symbols:identtok, lsbratok
+
+ cannot reachend
+*/
+
+static void OptReturnType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ProcedureParameters := ProcedureParameter
+ % addParameter (curproc, pop ()) %
+ { ',' ProcedureParameter
+
+ % addParameter (curproc, pop ()) %
+ }
+
+ first symbols:identtok, arraytok, periodperiodperiodtok, vartok
+
+ cannot reachend
+*/
+
+static void ProcedureParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ProcedureParameter := '...'
+ % VAR n: node ; %
+
+ % n := push (makeVarargs ()) %
+ | 'VAR' FormalType
+ % n := push (makeVarParameter (NIL, pop (), curproc, TRUE)) %
+ | FormalType
+ % n := push (makeNonVarParameter (NIL, pop (), curproc, TRUE)) %
+
+
+ first symbols:identtok, arraytok, vartok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ProcedureParameter (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ VarIdent :=
+ % VAR n, a: node ; %
+
+ % n := pop () %
+ Ident
+ % checkDuplicate (putIdent (n, curident)) %
+
+ % n := push (n) %
+ [ '[' ConstExpression
+ % a := pop () could store, a, into, n. %
+ ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ VarIdentList :=
+ % VAR n: node ; %
+
+ % n := makeIdentList () %
+
+ % n := push (n) %
+ VarIdent { ',' VarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ VariableDeclaration :=
+ % VAR v, d: node ; %
+ VarIdentList
+ % v := pop () %
+ ':' Type
+ % d := makeVarDecl (v, pop ()) %
+ Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VariableDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Designator := Qualident { SubDesignator }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Designator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ SubDesignator := '.' Ident | '[' ArrayExpList ']' |
+ '^'
+
+ first symbols:uparrowtok, lsbratok, periodtok
+
+ cannot reachend
+*/
+
+static void SubDesignator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ArrayExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArrayExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Expression := SimpleExpression [ Relation SimpleExpression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void Expression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ SimpleExpression := UnaryOrTerm { AddOperator Term }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ UnaryOrTerm := '+' Term | '-' Term |
+ Term
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Term := Factor { MulOperator Factor }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void Term (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Factor := Number | string | SetOrDesignatorOrFunction |
+ '(' Expression ')' |
+ 'NOT' ( Factor | ConstAttribute )
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void Factor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ SetOrDesignatorOrFunction := Qualident [ Constructor |
+ SimpleDes
+ [ ActualParameters ] ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void SetOrDesignatorOrFunction (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ SimpleDes := { SubDesignator }
+
+ first symbols:periodtok, lsbratok, uparrowtok
+
+ reachend
+*/
+
+static void SimpleDes (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ActualParameters := '(' [ ExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ActualParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ExitStatement := 'EXIT'
+
+ first symbols:exittok
+
+ cannot reachend
+*/
+
+static void ExitStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ReturnStatement := 'RETURN' [ Expression ]
+
+ first symbols:returntok
+
+ cannot reachend
+*/
+
+static void ReturnStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Statement := [ AssignmentOrProcedureCall |
+ IfStatement | CaseStatement |
+ WhileStatement |
+ RepeatStatement |
+ LoopStatement | ForStatement |
+ WithStatement | AsmStatement |
+ ExitStatement | ReturnStatement |
+ RetryStatement ]
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok
+
+ reachend
+*/
+
+static void Statement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ RetryStatement := 'RETRY'
+
+ first symbols:retrytok
+
+ cannot reachend
+*/
+
+static void RetryStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AssignmentOrProcedureCall := Designator ( ':=' Expression |
+ ActualParameters |
+
+ % epsilon %
+ )
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AssignmentOrProcedureCall (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ StatementSequence := Statement { ';' Statement }
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok
+
+ reachend
+*/
+
+static void StatementSequence (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ IfStatement := 'IF' Expression 'THEN' StatementSequence
+ { 'ELSIF' Expression 'THEN' StatementSequence }
+ [ 'ELSE' StatementSequence ] 'END'
+
+ first symbols:iftok
+
+ cannot reachend
+*/
+
+static void IfStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ CaseStatement := 'CASE' Expression 'OF' Case { '|'
+ Case }
+ CaseEndStatement
+
+ first symbols:casetok
+
+ cannot reachend
+*/
+
+static void CaseStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ CaseEndStatement := 'END' | 'ELSE' StatementSequence
+ 'END'
+
+ first symbols:elsetok, endtok
+
+ cannot reachend
+*/
+
+static void CaseEndStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Case := [ CaseLabelList ':' StatementSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Case (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ CaseLabelList := CaseLabels { ',' CaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void CaseLabelList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ CaseLabels := ConstExpressionNop [ '..' ConstExpressionNop ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void CaseLabels (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ WhileStatement := 'WHILE' Expression 'DO' StatementSequence
+ 'END'
+
+ first symbols:whiletok
+
+ cannot reachend
+*/
+
+static void WhileStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ RepeatStatement := 'REPEAT' StatementSequence 'UNTIL'
+ Expression
+
+ first symbols:repeattok
+
+ cannot reachend
+*/
+
+static void RepeatStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ForStatement := 'FOR' Ident ':=' Expression 'TO'
+ Expression [ 'BY' ConstExpressionNop ]
+ 'DO' StatementSequence 'END'
+
+ first symbols:fortok
+
+ cannot reachend
+*/
+
+static void ForStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ LoopStatement := 'LOOP' StatementSequence 'END'
+
+ first symbols:looptok
+
+ cannot reachend
+*/
+
+static void LoopStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ WithStatement := 'WITH' Designator 'DO' StatementSequence
+ 'END'
+
+ first symbols:withtok
+
+ cannot reachend
+*/
+
+static void WithStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock
+ Ident
+ % leaveScope %
+
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+ % enterScope (curproc) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ProcedureIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ DefProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefProcedureIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' Ident ')' ')' |
+ '__INLINE__' ]
+
+ first symbols:inlinetok, attributetok
+
+ reachend
+*/
+
+static void DefineBuiltinProcedure (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure
+ ( ProcedureIdent [ FormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureHeading (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Builtin := [ '__BUILTIN__' | '__INLINE__' ]
+
+ first symbols:inlinetok, builtintok
+
+ reachend
+*/
+
+static void Builtin (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent
+ [ DefFormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void DefProcedureHeading (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ]
+ 'END'
+
+ first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok
+
+ cannot reachend
+*/
+
+static void ProcedureBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Block := { Declaration } InitialBlock FinalBlock
+ 'END'
+
+ first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok
+
+ cannot reachend
+*/
+
+static void Block (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ InitialBlock := [ 'BEGIN' InitialBlockBody ]
+
+ first symbols:begintok
+
+ reachend
+*/
+
+static void InitialBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FinalBlock := [ 'FINALLY' FinalBlockBody ]
+
+ first symbols:finallytok
+
+ reachend
+*/
+
+static void FinalBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void InitialBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void FinalBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void ProcedureBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ NormalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void NormalPart (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ExceptionalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ExceptionalPart (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Declaration := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ ProcedureDeclaration ';' |
+ ModuleDeclaration ';'
+
+ first symbols:moduletok, proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Declaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ DefFormalParameters := '('
+ % paramEnter (curproc) %
+ [ DefMultiFPSection ] ')'
+
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefFormalParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ DefMultiFPSection := DefExtendedFP |
+ FPSection [ ';' DefMultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefMultiFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FormalParameters := '('
+ % paramEnter (curproc) %
+ [ MultiFPSection ] ')'
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AttributeNoReturn := [ NoReturn |
+ % setNoReturn (curproc, FALSE) %
+ ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeNoReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ NoReturn := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void NoReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AttributeUnused := [ Unused ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeUnused (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Unused := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void Unused (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ MultiFPSection := ExtendedFP | FPSection [ ';'
+ MultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void MultiFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FPSection := NonVarFPSection |
+ VarFPSection
+
+ first symbols:vartok, identtok
+
+ cannot reachend
+*/
+
+static void FPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ DefExtendedFP := DefOptArg | '...'
+ % addParameter (curproc, makeVarargs ()) %
+
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefExtendedFP (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ExtendedFP := OptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ExtendedFP (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ VarFPSection := 'VAR' PushIdentList
+ % VAR l, t: node ; %
+ ':' FormalType
+ % t := pop () %
+
+ % l := pop () %
+
+ % curisused := TRUE %
+ [ AttributeUnused ]
+ % addVarParameters (curproc, l, t, curisused) %
+
+
+ first symbols:vartok
+
+ cannot reachend
+*/
+
+static void VarFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ NonVarFPSection := PushIdentList
+ % VAR l, t: node ; %
+ ':' FormalType
+ % t := pop () %
+
+ % l := pop () %
+
+ % curisused := TRUE %
+ [ AttributeUnused ]
+ % addNonVarParameters (curproc, l, t, curisused) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void NonVarFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ OptArg :=
+ % VAR p, init, type: node ; id: Name ; %
+ '[' Ident
+ % id := curident %
+ ':' FormalType
+ % type := pop () %
+
+ % init := NIL %
+ [ '=' ConstExpression
+ % init := pop () %
+ ] ']'
+ % p := addOptParameter (curproc, id, type, init) %
+
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void OptArg (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ DefOptArg :=
+ % VAR p, init, type: node ; id: Name ; %
+ '[' Ident
+ % id := curident %
+ ':' FormalType
+ % type := pop () %
+ '=' ConstExpression
+ % init := pop () %
+ ']'
+ % p := addOptParameter (curproc, id, type, init) %
+
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void DefOptArg (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FormalType :=
+ % VAR c: CARDINAL ; %
+
+ % VAR n, a, s: node ; %
+
+ % c := 0 %
+ { 'ARRAY' 'OF'
+ % INC (c) %
+ } PushQualident
+ % pushNunbounded (c) %
+
+
+ first symbols:identtok, arraytok
+
+ cannot reachend
+*/
+
+static void FormalType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ModuleDeclaration := 'MODULE' Ident [ Priority ]
+ ';' { Import } [ Export ]
+ Block Ident
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ModuleDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Priority := '[' ConstExpressionNop ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void Priority (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Export := 'EXPORT' ( 'QUALIFIED' IdentList |
+ 'UNQUALIFIED' IdentList |
+ IdentList ) ';'
+
+ first symbols:exporttok
+
+ cannot reachend
+*/
+
+static void Export (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FromIdentList := Ident
+ % importInto (frommodule, curident, curmodule) %
+ { ',' Ident
+ % importInto (frommodule, curident, curmodule) %
+ }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FromIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ FromImport := 'FROM' Ident
+ % frommodule := lookupDef (curident) %
+ 'IMPORT' FromIdentList ';'
+
+ first symbols:fromtok
+
+ cannot reachend
+*/
+
+static void FromImport (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ ImportModuleList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ImportModuleList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ WithoutFromImport := 'IMPORT' ImportModuleList ';'
+
+ first symbols:importtok
+
+ cannot reachend
+*/
+
+static void WithoutFromImport (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Import := FromImport | WithoutFromImport
+
+ first symbols:importtok, fromtok
+
+ cannot reachend
+*/
+
+static void Import (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR'
+ string ]
+ Ident ';'
+ % curmodule := lookupDef (curident) %
+
+ % enterScope (curmodule) %
+
+ % resetEnumPos (curmodule) %
+ { Import } [ Export ] { Definition }
+ 'END' Ident '.'
+ % checkEndName (curmodule, curident, 'definition module') %
+
+ % setConstExpComplete (curmodule) %
+
+ % leaveScope %
+
+
+ first symbols:definitiontok
+
+ cannot reachend
+*/
+
+static void DefinitionModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ PushQualident := Ident
+ % typeExp := push (lookupSym (curident)) %
+
+ % IF typeExp = NIL
+ THEN
+ metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident)
+ END %
+ [ '.'
+ % IF NOT isDef (typeExp)
+ THEN
+ ErrorArray ('the first component of this qualident must be a definition module')
+ END %
+ Ident
+ % typeExp := replace (lookupInScope (typeExp, curident)) ;
+ IF typeExp=NIL
+ THEN
+ ErrorArray ('identifier not found in definition module')
+ END %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void PushQualident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ OptSubrange := [ SubrangeType
+ % VAR q, s: node ; %
+
+ % s := pop () %
+
+ % q := pop () %
+
+ % putSubrangeType (s, q) %
+
+ % typeExp := push (s) %
+ ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void OptSubrange (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ TypeEquiv := PushQualident OptSubrange
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void TypeEquiv (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ EnumIdentList :=
+ % VAR f: node ; %
+
+ % typeExp := push (makeEnum ()) %
+ Ident
+ % f := makeEnumField (typeExp, curident) %
+ { ',' Ident
+ % f := makeEnumField (typeExp, curident) %
+ }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void EnumIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Enumeration := '(' EnumIdentList ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void Enumeration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ SimpleType :=
+ % VAR d: CARDINAL ; %
+
+ % d := depth () %
+ ( TypeEquiv | Enumeration |
+ SubrangeType )
+ % assert (d = depth () - 1) %
+
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void SimpleType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Type := SimpleType | ArrayType | RecordType |
+ SetType | PointerType | ProcedureType
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void Type (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ TypeDeclaration := { Ident
+ % typeDes := lookupSym (curident) %
+ ( ';' | '=' Type
+ % putType (typeDes, pop ()) %
+ Alignment ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TypeDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ Definition := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ DefProcedureHeading ';'
+
+ first symbols:proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Definition (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands
+ ')'
+
+ first symbols:asmtok
+
+ cannot reachend
+*/
+
+static void AsmStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AsmOperands := string [ AsmOperandSpec ]
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void AsmOperands (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AsmOperandSpec := [ ':' AsmList [ ':' AsmList [
+ ':' TrashList ] ] ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void AsmOperandSpec (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AsmList := [ AsmElement ] { ',' AsmElement }
+
+ first symbols:lsbratok, stringtok, commatok
+
+ reachend
+*/
+
+static void AsmList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ NamedOperand := '[' Ident ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void NamedOperand (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AsmOperandName := [ NamedOperand ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void AsmOperandName (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ AsmElement := AsmOperandName string '(' Expression
+ ')'
+
+ first symbols:stringtok, lsbratok
+
+ cannot reachend
+*/
+
+static void AsmElement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+/*
+ TrashList := [ string ] { ',' string }
+
+ first symbols:commatok, stringtok
+
+ reachend
+*/
+
+static void TrashList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2);
+
+
+/*
+ push -
+*/
+
+static decl_node push (decl_node n)
+{
+ return static_cast<decl_node> (mcStack_push (stk, reinterpret_cast<void *> (n)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ pop -
+*/
+
+static decl_node pop (void)
+{
+ return static_cast<decl_node> (mcStack_pop (stk));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ replace -
+*/
+
+static decl_node replace (decl_node n)
+{
+ return static_cast<decl_node> (mcStack_replace (stk, reinterpret_cast<void *> (n)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ peep - returns the top node on the stack without removing it.
+*/
+
+static decl_node peep (void)
+{
+ return push (pop ());
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ depth - returns the depth of the stack.
+*/
+
+static unsigned int depth (void)
+{
+ return mcStack_depth (stk);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ checkDuplicate -
+*/
+
+static void checkDuplicate (unsigned int b)
+{
+}
+
+
+/*
+ checkDuplicate -
+*/
+
+static void ErrorString (DynamicStrings_String s)
+{
+ mcError_errorStringAt (s, mcLexBuf_getTokenNo ());
+ WasNoError = FALSE;
+}
+
+
+/*
+ checkDuplicate -
+*/
+
+static void ErrorArray (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ ErrorString (DynamicStrings_InitString ((const char *) a, _a_high));
+}
+
+
+/*
+ checkParameterAttribute -
+*/
+
+static void checkParameterAttribute (void)
+{
+ if ((nameKey_makeKey ((const char *) "unused", 6)) != curident)
+ {
+ mcMetaError_metaError1 ((const char *) "attribute {%1k} is not allowed in the formal parameter section, currently only unused is allowed", 96, (const unsigned char *) &curident, (sizeof (curident)-1));
+ }
+}
+
+
+/*
+ checkReturnAttribute -
+*/
+
+static void checkReturnAttribute (void)
+{
+ if ((nameKey_makeKey ((const char *) "noreturn", 8)) != curident)
+ {
+ mcMetaError_metaError1 ((const char *) "attribute {%1k} is not allowed in the procedure return type, only noreturn is allowed", 85, (const unsigned char *) &curident, (sizeof (curident)-1));
+ }
+}
+
+
+/*
+ pushNunbounded -
+*/
+
+static void pushNunbounded (unsigned int c)
+{
+ decl_node type;
+ decl_node array;
+ decl_node subrange;
+
+ while (c != 0)
+ {
+ type = pop ();
+ subrange = decl_makeSubrange (static_cast<decl_node> (NULL), static_cast<decl_node> (NULL));
+ decl_putSubrangeType (subrange, decl_getCardinal ());
+ array = decl_makeArray (subrange, type);
+ decl_putUnbounded (array);
+ type = push (array);
+ c -= 1;
+ }
+}
+
+
+/*
+ makeIndexedArray - builds and returns an array of type, t, with, c, indices.
+*/
+
+static decl_node makeIndexedArray (unsigned int c, decl_node t)
+{
+ decl_node i;
+
+ while (c > 0)
+ {
+ t = decl_makeArray (pop (), t);
+ c -= 1;
+ }
+ return t;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ importInto - from, m, import, name, into module, current.
+ It checks to see if curident is an enumeration type
+ and if so automatically includes all enumeration fields
+ as well.
+*/
+
+static void importInto (decl_node m, nameKey_Name name, decl_node current)
+{
+ decl_node s;
+ decl_node o;
+
+ mcDebug_assert (decl_isDef (m));
+ mcDebug_assert (((decl_isDef (current)) || (decl_isModule (current))) || (decl_isImp (current)));
+ s = decl_lookupExported (m, name);
+ if (s == NULL)
+ {
+ mcMetaError_metaError2 ((const char *) "{%1k} was not exported from definition module {%2a}", 51, (const unsigned char *) &name, (sizeof (name)-1), (const unsigned char *) &m, (sizeof (m)-1));
+ }
+ else
+ {
+ o = decl_import (current, s);
+ if (s != o)
+ {
+ mcMetaError_metaError2 ((const char *) "{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}", 87, (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &o, (sizeof (o)-1));
+ }
+ }
+}
+
+
+/*
+ checkEndName - if module does not have, name, then issue an error containing, desc.
+*/
+
+static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high)
+{
+ DynamicStrings_String s;
+ char desc[_desc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (desc, desc_, _desc_high+1);
+
+ if ((decl_getSymName (module)) != name)
+ {
+ s = DynamicStrings_InitString ((const char *) "inconsistent module name found with this ", 41);
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) desc, _desc_high)));
+ ErrorString (s);
+ }
+}
+
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ unsigned int n;
+ DynamicStrings_String str;
+ DynamicStrings_String message;
+
+ n = 0;
+ message = DynamicStrings_InitString ((const char *) "", 0);
+ if ((((1 << (mcReserved_stringtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "string", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_realtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "real number", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_identtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_integertok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "integer number", 14)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_inlinetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__INLINE__", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_builtintok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__BUILTIN__", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_attributetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__ATTRIBUTE__", 13)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_filetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__FILE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_linetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__LINE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_datetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__DATE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "...", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_volatiletok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VOLATILE", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_asmtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ASM", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_withtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WITH", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_whiletok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WHILE", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_vartok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VAR", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_untiltok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNTIL", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_typetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TYPE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_totok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TO", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_thentok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "THEN", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_settok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "SET", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_returntok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETURN", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_retrytok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETRY", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_repeattok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REPEAT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_remtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REM", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_recordtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RECORD", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_unqualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNQUALIFIED", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "QUALIFIED", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_proceduretok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PROCEDURE", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_pointertok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "POINTER", 7)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_packedsettok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PACKEDSET", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ortok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OR", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_oftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OF", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_nottok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "NOT", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_moduletok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MODULE", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_modtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MOD", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_looptok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "LOOP", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_intok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IN", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_importtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPORT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_implementationtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPLEMENTATION", 14)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_iftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IF", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_fromtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FROM", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_fortok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FOR", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_finallytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FINALLY", 7)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_exporttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXPORT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_exittok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXIT", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_excepttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXCEPT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_endtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "END", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_elsiftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSIF", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_elsetok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_dotok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DO", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_divtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DIV", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_definitiontok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DEFINITION", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_consttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CONST", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_casetok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CASE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_bytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BY", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_begintok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BEGIN", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_arraytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ARRAY", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_andtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "AND", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_colontok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodperiodtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "..", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*>", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<*", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lessequaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<>", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_hashtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "#", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_equaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "^", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_semicolontok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ";", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_commatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ",", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "&", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_dividetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "/", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_timestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_minustok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_plustok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "+", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_doublequotestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ',');
+ n += 1;
+ }
+ if ((((1 << (mcReserved_singlequotetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ',');
+ n += 1;
+ }
+ if ((((1 << (mcReserved_greatertok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lesstok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rparatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lparatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rcbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lcbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rsbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lsbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_bartok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_becomestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_eoftok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {} /* empty. */
+ /* eoftok has no token name (needed to generate error messages) */
+ if (n == 0)
+ {
+ str = DynamicStrings_InitString ((const char *) " syntax error", 13);
+ message = DynamicStrings_KillString (message);
+ }
+ else if (n == 1)
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message);
+ message = DynamicStrings_KillString (message);
+ }
+ return str;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void)
+{
+ DynamicStrings_String str;
+
+ str = DynamicStrings_InitString ((const char *) "", 0);
+ switch (mcLexBuf_currenttoken)
+ {
+ case mcReserved_stringtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found string", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_realtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found real number", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_identtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_integertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found integer number", 34), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_inlinetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __INLINE__", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_builtintok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __BUILTIN__", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_attributetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __ATTRIBUTE__", 33), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_filetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __FILE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_linetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __LINE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_datetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __DATE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodperiodperiodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ...", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_volatiletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VOLATILE", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_asmtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ASM", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_withtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WITH", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_whiletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WHILE", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_vartok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VAR", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_untiltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNTIL", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_typetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TYPE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_totok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TO", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_thentok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found THEN", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_settok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found SET", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_returntok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETURN", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_retrytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETRY", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_repeattok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REPEAT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_remtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REM", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_recordtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RECORD", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_unqualifiedtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNQUALIFIED", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_qualifiedtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found QUALIFIED", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_proceduretok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PROCEDURE", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_pointertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found POINTER", 27), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_packedsettok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PACKEDSET", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ortok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OR", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_oftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OF", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_nottok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found NOT", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_moduletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MODULE", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_modtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MOD", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_looptok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found LOOP", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_intok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IN", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_importtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPORT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_implementationtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPLEMENTATION", 34), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_iftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IF", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_fromtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FROM", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_fortok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FOR", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_finallytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FINALLY", 27), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_exporttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXPORT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_exittok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXIT", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_excepttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXCEPT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_endtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found END", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_elsiftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSIF", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_elsetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_dotok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DO", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_divtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DIV", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_definitiontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DEFINITION", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_consttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CONST", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_casetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CASE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_bytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BY", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_begintok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BEGIN", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_arraytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ARRAY", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_andtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found AND", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_colontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodperiodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ..", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rdirectivetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *>", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ldirectivetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <*", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_greaterequaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lessequaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lessgreatertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <>", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_hashtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found #", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_equaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_uparrowtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ^", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_semicolontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ;", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_commatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ,", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found .", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ambersandtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found &", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_dividetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found /", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_timestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_minustok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found -", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_plustok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found +", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_doublequotestok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_singlequotetok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_greatertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lesstok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rcbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lcbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rsbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lsbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_bartok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_becomestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_eoftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str));
+ break;
+
+
+ default:
+ break;
+ }
+ ErrorString (str);
+}
+
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ DescribeError ();
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "\\nskipping token *** ", 21);
+ }
+ /*
+ yes the ORD(currenttoken) looks ugly, but it is *much* safer than
+ using currenttoken<sometok as a change to the ordering of the
+ token declarations below would cause this to break. Using ORD() we are
+ immune from such changes
+ */
+ while (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0)))))
+ {
+ mcLexBuf_getToken ();
+ }
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) " ***\\n", 6);
+ }
+}
+
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ /* and again (see above re: ORD)
+ */
+ if (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0)))))
+ {
+ SyntaxError (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*/
+
+static void WarnMissingToken (mcReserved_toktype t)
+{
+ mcp3_SetOfStop0 s0;
+ mcp3_SetOfStop1 s1;
+ mcp3_SetOfStop2 s2;
+ DynamicStrings_String str;
+
+ s0 = (mcp3_SetOfStop0) 0;
+ s1 = (mcp3_SetOfStop1) 0;
+ s2 = (mcp3_SetOfStop2) 0;
+ if ( ((unsigned int) (t)) < 32)
+ {
+ s0 = (mcp3_SetOfStop0) ((1 << (t-mcReserved_eoftok)));
+ }
+ else if ( ((unsigned int) (t)) < 64)
+ {
+ /* avoid dangling else. */
+ s1 = (mcp3_SetOfStop1) ((1 << (t-mcReserved_arraytok)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ s2 = (mcp3_SetOfStop2) ((1 << (t-mcReserved_recordtok)));
+ }
+ str = DescribeStop (s0, s1, s2);
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error,", 13), DynamicStrings_Mark (str));
+ mcError_errorStringAt (str, mcLexBuf_getTokenNo ());
+}
+
+
+/*
+ MissingToken - generates a warning message about a missing token, t.
+*/
+
+static void MissingToken (mcReserved_toktype t)
+{
+ WarnMissingToken (t);
+ if ((((t != mcReserved_identtok) && (t != mcReserved_integertok)) && (t != mcReserved_realtok)) && (t != mcReserved_stringtok))
+ {
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "inserting token\\n", 17);
+ }
+ mcLexBuf_insertToken (t);
+ }
+}
+
+
+/*
+ CheckAndInsert -
+*/
+
+static unsigned int CheckAndInsert (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0))))
+ {
+ WarnMissingToken (t);
+ mcLexBuf_insertTokenAndRewind (t);
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InStopSet
+*/
+
+static unsigned int InStopSet (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0))))
+ {
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
+ If it is not then it will insert a token providing the token
+ is one of ; ] ) } . OF END ,
+
+ if the stopset contains <identtok> then we do not insert a token
+*/
+
+static void PeepToken (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ /* and again (see above re: ORD)
+ */
+ if ((! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) && (! (InStopSet (mcReserved_identtok, stopset0, stopset1, stopset2))))
+ {
+ /* SyntaxCheck would fail since currentoken is not part of the stopset
+ we check to see whether any of currenttoken might be a commonly omitted token */
+ if ((((((((CheckAndInsert (mcReserved_semicolontok, stopset0, stopset1, stopset2)) || (CheckAndInsert (mcReserved_rsbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rparatok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rcbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_periodtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_oftok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_endtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_commatok, stopset0, stopset1, stopset2)))
+ {} /* empty. */
+ }
+}
+
+
+/*
+ Expect -
+*/
+
+static void Expect (mcReserved_toktype t, mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == t)
+ {
+ /* avoid dangling else. */
+ mcLexBuf_getToken ();
+ if (Pass1)
+ {
+ PeepToken (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ MissingToken (t);
+ }
+ SyntaxCheck (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ curident = nameKey_makekey (mcLexBuf_currentstring);
+ Expect (mcReserved_identtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ string -
+*/
+
+static void string (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ curstring = nameKey_makekey (mcLexBuf_currentstring);
+ Expect (mcReserved_stringtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Integer -
+*/
+
+static void Integer (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_integertok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Real -
+*/
+
+static void Real (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_realtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FileUnit := DefinitionModule |
+ ImplementationOrProgramModule
+
+ first symbols:implementationtok, moduletok, definitiontok
+
+ cannot reachend
+*/
+
+static void FileUnit (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_definitiontok)
+ {
+ DefinitionModule (stopset0, stopset1, stopset2);
+ }
+ else if (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_implementationtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ ImplementationOrProgramModule (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IMPLEMENTATION MODULE DEFINITION", 50);
+ }
+}
+
+
+/*
+ ProgramModule := 'MODULE' Ident
+ % curmodule := lookupModule (curident) %
+
+ % enterScope (curmodule) %
+
+ % resetEnumPos (curmodule) %
+ [ Priority ] ';' { Import } Block
+ Ident
+ % checkEndName (curmodule, curident, 'program module') %
+
+ % setConstExpComplete (curmodule) %
+
+ % leaveScope %
+ '.'
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ProgramModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ curmodule = decl_lookupModule (curident);
+ decl_enterScope (curmodule);
+ decl_resetEnumPos (curmodule);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ Block (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "program module", 14);
+ decl_setConstExpComplete (curmodule);
+ decl_leaveScope ();
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImplementationModule := 'IMPLEMENTATION' 'MODULE'
+ Ident
+ % curmodule := lookupImp (curident) %
+
+ % enterScope (lookupDef (curident)) %
+
+ % enterScope (curmodule) %
+
+ % resetEnumPos (curmodule) %
+ [ Priority ] ';' { Import }
+ Block Ident
+ % checkEndName (curmodule, curident, 'implementation module') %
+
+ % setConstExpComplete (curmodule) %
+
+ % leaveScope ; leaveScope %
+ '.'
+
+ first symbols:implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_implementationtok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ curmodule = decl_lookupImp (curident);
+ decl_enterScope (decl_lookupDef (curident));
+ decl_enterScope (curmodule);
+ decl_resetEnumPos (curmodule);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ Block (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "implementation module", 21);
+ decl_setConstExpComplete (curmodule);
+ decl_leaveScope ();
+ decl_leaveScope ();
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImplementationOrProgramModule := ImplementationModule |
+ ProgramModule
+
+ first symbols:moduletok, implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationOrProgramModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_implementationtok)
+ {
+ ImplementationModule (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ ProgramModule (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: MODULE IMPLEMENTATION", 39);
+ }
+}
+
+
+/*
+ Number := Integer | Real
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void Number (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_integertok)
+ {
+ Integer (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_realtok)
+ {
+ /* avoid dangling else. */
+ Real (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: real number integer number", 44);
+ }
+}
+
+
+/*
+ Qualident := Ident { '.' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Qualident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ConstantDeclaration :=
+ % VAR d, e: node ; %
+ Ident
+ % d := lookupSym (curident) %
+ '=' ConstExpression
+ % e := pop () %
+
+ % assert (isConst (d)) %
+
+ % putConst (d, e) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ConstantDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node d;
+ decl_node e;
+
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ d = decl_lookupSym (curident);
+ Expect (mcReserved_equaltok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ e = pop ();
+ mcDebug_assert (decl_isConst (d));
+ decl_putConst (d, e);
+}
+
+
+/*
+ ConstExpressionNop := SimpleConstExpr
+ % VAR n: node ; %
+ [ Relation SimpleConstExpr ]
+
+ % n := makeConstExp () %
+
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpressionNop (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ SimpleConstExpr (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SimpleConstExpr (stopset0, stopset1, stopset2);
+ }
+ n = decl_makeConstExp ();
+}
+
+
+/*
+ ConstExpression :=
+ % VAR n: node ; %
+
+ % n := push (makeConstExp ()) %
+ SimpleConstExpr [ Relation SimpleConstExpr ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ n = push (decl_makeConstExp ());
+ SimpleConstExpr (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SimpleConstExpr (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Relation := '=' | '#' | '<>' | '<' | '<=' |
+ '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void Relation (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_hashtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_hashtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_intok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_intok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37);
+ }
+}
+
+
+/*
+ SimpleConstExpr := UnaryOrConstTerm { AddOperator
+ ConstTerm }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleConstExpr (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ UnaryOrConstTerm (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ AddOperator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ UnaryOrConstTerm := '+' ConstTerm |
+ '-' ConstTerm |
+ ConstTerm
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrConstTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ identifier { string - +", 88);
+ }
+}
+
+
+/*
+ AddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void AddOperator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ortok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ortok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: OR - +", 24);
+ }
+}
+
+
+/*
+ ConstTerm := ConstFactor { MulOperator ConstFactor }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void ConstTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ ConstFactor (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ MulOperator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstFactor (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ }
+ /* while */
+}
+
+
+/*
+ MulOperator := '*' | '/' | 'DIV' | 'MOD' |
+ 'REM' | 'AND' | '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void MulOperator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_timestok)
+ {
+ Expect (mcReserved_timestok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_dividetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_dividetok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_divtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_divtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_modtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_modtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_remtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_remtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_andtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_andtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ambersandtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39);
+ }
+}
+
+
+/*
+ ConstFactor := Number | ConstString |
+ ConstSetOrQualidentOrFunction |
+ '(' ConstExpressionNop ')' |
+ 'NOT' ConstFactor |
+ ConstAttribute
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void ConstFactor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ Number (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ ConstString (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ ConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_nottok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstFactor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ ConstAttribute (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( identifier { string integer number real number", 84);
+ }
+}
+
+
+/*
+ ConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void ConstString (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ string (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ComponentElement := ConstExpressionNop [ '..' ConstExpressionNop ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ComponentElement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ComponentValue := ComponentElement [ 'BY' ConstExpressionNop ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ComponentValue (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ ComponentElement (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArraySetRecordValue (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ ComponentValue (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ComponentValue (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ Constructor := '{' [ ArraySetRecordValue ] '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void Constructor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lcbratok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ ArraySetRecordValue (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstSetOrQualidentOrFunction := Qualident [ Constructor |
+ ConstActualParameters ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void ConstSetOrQualidentOrFunction (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ ConstActualParameters (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( {", 21);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ /* avoid dangling else. */
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: { identifier", 30);
+ }
+}
+
+
+/*
+ ConstActualParameters := '(' [ ConstExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ConstActualParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ ConstExpList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstExpList := ConstExpressionNop { ',' ConstExpressionNop }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' ConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void ConstAttribute (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstAttributeExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstAttributeExpression := Ident | '<' Qualident
+ ',' Ident '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void ConstAttributeExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: < identifier", 30);
+ }
+}
+
+
+/*
+ ByteAlignment := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void ByteAlignment (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ AttributeExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ OptAlignmentExpression := [ AlignmentExpression ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void OptAlignmentExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ AlignmentExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AlignmentExpression := '(' ConstExpressionNop ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void AlignmentExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Alignment := [ ByteAlignment ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void Alignment (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ ByteAlignment (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ IdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void IdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ PushIdentList :=
+ % VAR n: node ; %
+
+ % n := makeIdentList () %
+ Ident
+ % checkDuplicate (putIdent (n, curident)) %
+ { ',' Ident
+ % checkDuplicate (putIdent (n, curident)) %
+ }
+ % n := push (n) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void PushIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ n = decl_makeIdentList ();
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ checkDuplicate (decl_putIdent (n, curident));
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ checkDuplicate (decl_putIdent (n, curident));
+ }
+ /* while */
+ n = push (n);
+}
+
+
+/*
+ SubrangeType :=
+ % VAR low, high: node ; d: CARDINAL ; %
+ '['
+ % d := depth () %
+ ConstExpression
+ % low := pop () %
+
+ % assert (d = depth ()) %
+ '..' ConstExpression
+ % high := pop () %
+
+ % assert (d = depth ()) %
+
+ % typeExp := push (makeSubrange (low, high)) %
+
+ % assert (d = depth () - 1) %
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void SubrangeType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node low;
+ decl_node high;
+ unsigned int d;
+
+ Expect (mcReserved_lsbratok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ d = depth ();
+ ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ low = pop ();
+ mcDebug_assert (d == (depth ()));
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ high = pop ();
+ mcDebug_assert (d == (depth ()));
+ typeExp = push (decl_makeSubrange (low, high));
+ mcDebug_assert (d == ((depth ())-1));
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ArrayType := 'ARRAY'
+ % VAR c: CARDINAL ; t, n: node ; %
+
+ % c := 0 %
+ SimpleType
+ % INC (c) %
+ { ',' SimpleType
+ % INC (c) %
+ } 'OF' Type
+ % n := push (makeIndexedArray (c, pop ())) %
+
+
+ first symbols:arraytok
+
+ cannot reachend
+*/
+
+static void ArrayType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ unsigned int c;
+ decl_node t;
+ decl_node n;
+
+ Expect (mcReserved_arraytok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ c = 0;
+ SimpleType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ c += 1;
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ c += 1;
+ }
+ /* while */
+ Expect (mcReserved_oftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0, stopset1, stopset2);
+ n = push (makeIndexedArray (c, pop ()));
+}
+
+
+/*
+ RecordType := 'RECORD'
+ % VAR n: node ; %
+
+ % n := push (makeRecord ()) %
+
+ % n := push (NIL) no varient %
+ [ DefaultRecordAttributes ] FieldListSequence
+
+ % assert (pop ()=NIL) %
+ 'END'
+
+ first symbols:recordtok
+
+ cannot reachend
+*/
+
+static void RecordType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Expect (mcReserved_recordtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ n = push (decl_makeRecord ());
+ n = push (static_cast<decl_node> (NULL)); /* no varient */
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ DefaultRecordAttributes (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ FieldListSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ mcDebug_assert ((pop ()) == NULL);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefaultRecordAttributes := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void DefaultRecordAttributes (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ AttributeExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RecordFieldPragma := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void RecordFieldPragma (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldPragmaExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldPragmaExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FieldPragmaExpression := Ident PragmaConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FieldPragmaExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ PragmaConstExpression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ PragmaConstExpression := [ '(' ConstExpressionNop
+ ')' ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void PragmaConstExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AttributeExpression := Ident '(' ConstExpressionNop
+ ')'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AttributeExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FieldListSequence := FieldListStatement { ';' FieldListStatement }
+
+ first symbols:casetok, identtok, semicolontok
+
+ reachend
+*/
+
+static void FieldListSequence (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ FieldListStatement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListStatement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ FieldListStatement := [ FieldList ]
+
+ first symbols:identtok, casetok
+
+ reachend
+*/
+
+static void FieldListStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_casetok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ FieldList (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FieldList :=
+ % VAR r, i, f, t, n, v, w: node ; d: CARDINAL ; %
+
+ % d := depth () %
+
+ % v := pop () ; assert ((v=NIL) OR isVarient (v)) %
+
+ % r := peep () ; assert (isRecord (r) OR isVarientField (r)) %
+
+ % v := push (v) %
+
+ % assert (d=depth ()) %
+
+ % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isVarientField (r))) %
+ PushIdentList ':'
+ % assert (d=depth () - 1) %
+
+ % i := pop () %
+ Type
+ % assert (d=depth () - 1) %
+
+ % t := pop () %
+ RecordFieldPragma
+ % assert (d=depth ()) %
+
+ % r := addFieldsToRecord (r, v, i, t) %
+
+ % assert (d=depth ()) %
+ |
+ 'CASE'
+ % addRecordToList %
+
+ % d := depth () %
+
+ % v := pop () ; assert ((v=NIL) OR isVarient (v)) %
+
+ % r := peep () ; assert (isRecord (r) OR isVarientField (r)) %
+
+ % v := push (v) %
+
+ % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isRecordField (r))) %
+
+ % w := push (makeVarient (r)) %
+
+ % assert (d = depth () - 1) %
+
+ % addVarientToList %
+ CaseTag 'OF'
+ % assert (d = depth () - 1) %
+ Varient
+ % assert (d = depth () - 1) %
+ { '|' Varient
+ % assert (d = depth () - 1) %
+ }
+ % w := peep () ; assert (isVarient (w)) %
+
+ % assert (d = depth () - 1) %
+ [ 'ELSE' FieldListSequence ] 'END'
+
+ % w := pop () ; assert (isVarient (w)) %
+
+ % assert (d=depth ()) %
+
+
+ first symbols:casetok, identtok
+
+ cannot reachend
+*/
+
+static void FieldList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node r;
+ decl_node i;
+ decl_node f;
+ decl_node t;
+ decl_node n;
+ decl_node v;
+ decl_node w;
+ unsigned int d;
+
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ d = depth ();
+ v = pop ();
+ mcDebug_assert ((v == NULL) || (decl_isVarient (v)));
+ r = peep ();
+ mcDebug_assert ((decl_isRecord (r)) || (decl_isVarientField (r)));
+ v = push (v);
+ mcDebug_assert (d == (depth ()));
+ mcDebug_assert (((v == NULL) && (decl_isRecord (r))) || ((v != NULL) && (decl_isVarientField (r))));
+ PushIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ mcDebug_assert (d == ((depth ())-1));
+ i = pop ();
+ Type (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ mcDebug_assert (d == ((depth ())-1));
+ t = pop ();
+ RecordFieldPragma (stopset0, stopset1, stopset2);
+ mcDebug_assert (d == (depth ()));
+ r = decl_addFieldsToRecord (r, v, i, t);
+ mcDebug_assert (d == (depth ()));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_casetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_casetok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ /* addRecordToList */
+ d = depth ();
+ v = pop ();
+ mcDebug_assert ((v == NULL) || (decl_isVarient (v)));
+ r = peep ();
+ mcDebug_assert ((decl_isRecord (r)) || (decl_isVarientField (r)));
+ v = push (v);
+ mcDebug_assert (((v == NULL) && (decl_isRecord (r))) || ((v != NULL) && (decl_isRecordField (r))));
+ w = push (decl_makeVarient (r));
+ mcDebug_assert (d == ((depth ())-1));
+ /* addVarientToList */
+ CaseTag (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ mcDebug_assert (d == ((depth ())-1));
+ Varient (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ mcDebug_assert (d == ((depth ())-1));
+ while (mcLexBuf_currenttoken == mcReserved_bartok)
+ {
+ Expect (mcReserved_bartok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Varient (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2);
+ mcDebug_assert (d == ((depth ())-1));
+ }
+ /* while */
+ w = peep ();
+ mcDebug_assert (decl_isVarient (w));
+ mcDebug_assert (d == ((depth ())-1));
+ if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ Expect (mcReserved_elsetok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ w = pop ();
+ mcDebug_assert (decl_isVarient (w));
+ mcDebug_assert (d == (depth ()));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: CASE identifier", 33);
+ }
+}
+
+
+/*
+ TagIdent := Ident |
+ % curident := NulName %
+
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TagIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ curident = nameKey_NulName;
+ }
+}
+
+
+/*
+ CaseTag :=
+ % VAR tagident: Name ; q, v, w, r: node ; %
+
+ % w := pop () ; v := pop () ; r := peep () ; v := push (v) ; w := push (w) %
+
+ % assert (isVarient (w)) %
+
+ % assert ((v=NIL) OR isVarient (v)) %
+
+ % assert (isRecord (r) OR isVarientField (r)) %
+
+ % assert (isVarient (push (pop ()))) %
+ TagIdent
+ % tagident := curident %
+ ( ':' PushQualident
+ % q := pop () %
+
+ % assert (isVarient (push (pop ()))) %
+ |
+ % q := NIL %
+ )
+ % buildVarientSelector (r, w, tagident, q) %
+
+
+ first symbols:colontok, identtok
+
+ reachend
+*/
+
+static void CaseTag (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ nameKey_Name tagident;
+ decl_node q;
+ decl_node v;
+ decl_node w;
+ decl_node r;
+
+ w = pop ();
+ v = pop ();
+ r = peep ();
+ v = push (v);
+ w = push (w);
+ mcDebug_assert (decl_isVarient (w));
+ mcDebug_assert ((v == NULL) || (decl_isVarient (v)));
+ mcDebug_assert ((decl_isRecord (r)) || (decl_isVarientField (r)));
+ mcDebug_assert (decl_isVarient (push (pop ())));
+ TagIdent (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ tagident = curident;
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ PushQualident (stopset0, stopset1, stopset2);
+ q = pop ();
+ mcDebug_assert (decl_isVarient (push (pop ())));
+ }
+ else
+ {
+ q = static_cast<decl_node> (NULL);
+ }
+ decl_buildVarientSelector (r, w, tagident, q);
+}
+
+
+/*
+ Varient :=
+ % VAR p, r, v, f: node ; d: CARDINAL ; %
+
+ % d := depth () %
+
+ % assert (isVarient (peep ())) %
+ [
+ % v := pop () ; assert (isVarient (v)) %
+
+ % r := pop () %
+
+ % p := peep () %
+
+ % r := push (r) %
+
+ % f := push (buildVarientFieldRecord (v, p)) %
+
+ % v := push (v) %
+ VarientCaseLabelList ':' FieldListSequence
+
+ % v := pop () %
+
+ % f := pop () %
+
+ % assert (isVarientField (f)) %
+
+ % assert (isVarient (v)) %
+
+ % v := push (v) %
+ ]
+ % assert (isVarient (peep ())) %
+
+ % assert (d=depth ()) %
+
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Varient (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node p;
+ decl_node r;
+ decl_node v;
+ decl_node f;
+ unsigned int d;
+
+ d = depth ();
+ mcDebug_assert (decl_isVarient (peep ()));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))))
+ {
+ v = pop ();
+ mcDebug_assert (decl_isVarient (v));
+ r = pop ();
+ p = peep ();
+ r = push (r);
+ f = push (decl_buildVarientFieldRecord (v, p));
+ v = push (v);
+ VarientCaseLabelList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListSequence (stopset0, stopset1, stopset2);
+ v = pop ();
+ f = pop ();
+ mcDebug_assert (decl_isVarientField (f));
+ mcDebug_assert (decl_isVarient (v));
+ v = push (v);
+ }
+ mcDebug_assert (decl_isVarient (peep ()));
+ mcDebug_assert (d == (depth ()));
+}
+
+
+/*
+ VarientCaseLabelList := VarientCaseLabels { ','
+ VarientCaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabelList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ VarientCaseLabels (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ VarientCaseLabels (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ VarientCaseLabels :=
+ % VAR l, h: node ; %
+
+ % h := NIL %
+ ConstExpression
+ % l := pop () %
+ [ '..' ConstExpression
+ % h := pop () %
+ ]
+ % l, h could be saved if necessary. %
+
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabels (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node l;
+ decl_node h;
+
+ h = static_cast<decl_node> (NULL);
+ ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ l = pop ();
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ h = pop ();
+ }
+}
+
+
+/*
+ SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType
+
+ % VAR n: node ; %
+
+ % n := push (makeSet (pop ())) %
+
+
+ first symbols:oftok, packedsettok, settok
+
+ cannot reachend
+*/
+
+static void SetType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ if (mcLexBuf_currenttoken == mcReserved_settok)
+ {
+ Expect (mcReserved_settok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_packedsettok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_packedsettok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PACKEDSET SET", 31);
+ }
+ Expect (mcReserved_oftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0, stopset1, stopset2);
+ n = push (decl_makeSet (pop ()));
+}
+
+
+/*
+ PointerType := 'POINTER' 'TO' Type
+ % VAR n: node ; %
+
+ % n := push (makePointer (pop ())) %
+
+
+ first symbols:pointertok
+
+ cannot reachend
+*/
+
+static void PointerType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Expect (mcReserved_pointertok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok))));
+ Expect (mcReserved_totok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0, stopset1, stopset2);
+ n = push (decl_makePointer (pop ()));
+}
+
+
+/*
+ ProcedureType := 'PROCEDURE'
+ % curproc := push (makeProcType ()) %
+ [ FormalTypeList ]
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ curproc = push (decl_makeProcType ());
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ FormalTypeList (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FormalTypeList := '(' ( ')' FormalReturn |
+ ProcedureParameters ')'
+ FormalReturn )
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalTypeList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_rparatok)
+ {
+ Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ ProcedureParameters (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: VAR ... ARRAY identifier )", 44);
+ }
+}
+
+
+/*
+ FormalReturn := [ ':' OptReturnType ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void FormalReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ OptReturnType (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ OptReturnType := '[' PushQualident
+ % putReturnType (curproc, pop ()) %
+
+ % putOptReturn (curproc) %
+ ']' | PushQualident
+ % putReturnType (curproc, pop ()) %
+
+
+ first symbols:identtok, lsbratok
+
+ cannot reachend
+*/
+
+static void OptReturnType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ PushQualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_putReturnType (curproc, pop ());
+ decl_putOptReturn (curproc);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ PushQualident (stopset0, stopset1, stopset2);
+ decl_putReturnType (curproc, pop ());
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier [", 30);
+ }
+}
+
+
+/*
+ ProcedureParameters := ProcedureParameter
+ % addParameter (curproc, pop ()) %
+ { ',' ProcedureParameter
+
+ % addParameter (curproc, pop ()) %
+ }
+
+ first symbols:identtok, arraytok, periodperiodperiodtok, vartok
+
+ cannot reachend
+*/
+
+static void ProcedureParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ ProcedureParameter (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_addParameter (curproc, pop ());
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureParameter (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_addParameter (curproc, pop ());
+ }
+ /* while */
+}
+
+
+/*
+ ProcedureParameter := '...'
+ % VAR n: node ; %
+
+ % n := push (makeVarargs ()) %
+ | 'VAR' FormalType
+ % n := push (makeVarParameter (NIL, pop (), curproc, TRUE)) %
+ | FormalType
+ % n := push (makeNonVarParameter (NIL, pop (), curproc, TRUE)) %
+
+
+ first symbols:identtok, arraytok, vartok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ProcedureParameter (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ n = push (decl_makeVarargs ());
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0, stopset1, stopset2);
+ n = push (decl_makeVarParameter (static_cast<decl_node> (NULL), pop (), curproc, TRUE));
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ FormalType (stopset0, stopset1, stopset2);
+ n = push (decl_makeNonVarParameter (static_cast<decl_node> (NULL), pop (), curproc, TRUE));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ARRAY identifier VAR ...", 42);
+ }
+}
+
+
+/*
+ VarIdent :=
+ % VAR n, a: node ; %
+
+ % n := pop () %
+ Ident
+ % checkDuplicate (putIdent (n, curident)) %
+
+ % n := push (n) %
+ [ '[' ConstExpression
+ % a := pop () could store, a, into, n. %
+ ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node n;
+ decl_node a;
+
+ n = pop ();
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ checkDuplicate (decl_putIdent (n, curident));
+ n = push (n);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Expect (mcReserved_lsbratok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ a = pop (); /* could store, a, into, n. */
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ VarIdentList :=
+ % VAR n: node ; %
+
+ % n := makeIdentList () %
+
+ % n := push (n) %
+ VarIdent { ',' VarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ n = decl_makeIdentList ();
+ n = push (n);
+ VarIdent (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ VarIdent (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ VariableDeclaration :=
+ % VAR v, d: node ; %
+ VarIdentList
+ % v := pop () %
+ ':' Type
+ % d := makeVarDecl (v, pop ()) %
+ Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VariableDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node v;
+ decl_node d;
+
+ VarIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ v = pop ();
+ Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ d = decl_makeVarDecl (v, pop ());
+ Alignment (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Designator := Qualident { SubDesignator }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Designator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Qualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0)))
+ {
+ SubDesignator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SubDesignator := '.' Ident | '[' ArrayExpList ']' |
+ '^'
+
+ first symbols:uparrowtok, lsbratok, periodtok
+
+ cannot reachend
+*/
+
+static void SubDesignator (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lsbratok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ArrayExpList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_uparrowtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_uparrowtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ^ [ .", 23);
+ }
+}
+
+
+/*
+ ArrayExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArrayExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ExpList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ Expression := SimpleExpression [ Relation SimpleExpression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void Expression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ SimpleExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SimpleExpression := UnaryOrTerm { AddOperator Term }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleExpression (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ UnaryOrTerm (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ AddOperator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ UnaryOrTerm := '+' Term | '-' Term |
+ Term
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrTerm (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ Term (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( string integer number real number identifier { - +", 74);
+ }
+}
+
+
+/*
+ Term := Factor { MulOperator Factor }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void Term (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Factor (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ MulOperator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Factor (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ }
+ /* while */
+}
+
+
+/*
+ Factor := Number | string | SetOrDesignatorOrFunction |
+ '(' Expression ')' |
+ 'NOT' ( Factor | ConstAttribute )
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void Factor (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ Number (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ string (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ SetOrDesignatorOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_nottok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ Factor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ ConstAttribute (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ real number integer number string ( NOT { identifier", 84);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( identifier { string integer number real number", 70);
+ }
+}
+
+
+/*
+ SetOrDesignatorOrFunction := Qualident [ Constructor |
+ SimpleDes
+ [ ActualParameters ] ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void SetOrDesignatorOrFunction (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ SimpleDes (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ ActualParameters (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( ^ [ . {", 27);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ /* avoid dangling else. */
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: { identifier", 30);
+ }
+}
+
+
+/*
+ SimpleDes := { SubDesignator }
+
+ first symbols:periodtok, lsbratok, uparrowtok
+
+ reachend
+*/
+
+static void SimpleDes (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0)))
+ {
+ SubDesignator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ActualParameters := '(' [ ExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ActualParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ ExpList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ExitStatement := 'EXIT'
+
+ first symbols:exittok
+
+ cannot reachend
+*/
+
+static void ExitStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_exittok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ReturnStatement := 'RETURN' [ Expression ]
+
+ first symbols:returntok
+
+ cannot reachend
+*/
+
+static void ReturnStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_returntok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ Expression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Statement := [ AssignmentOrProcedureCall |
+ IfStatement | CaseStatement |
+ WhileStatement |
+ RepeatStatement |
+ LoopStatement | ForStatement |
+ WithStatement | AsmStatement |
+ ExitStatement | ReturnStatement |
+ RetryStatement ]
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok
+
+ reachend
+*/
+
+static void Statement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ AssignmentOrProcedureCall (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_iftok)
+ {
+ /* avoid dangling else. */
+ IfStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_casetok)
+ {
+ /* avoid dangling else. */
+ CaseStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_whiletok)
+ {
+ /* avoid dangling else. */
+ WhileStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_repeattok)
+ {
+ /* avoid dangling else. */
+ RepeatStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_looptok)
+ {
+ /* avoid dangling else. */
+ LoopStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_fortok)
+ {
+ /* avoid dangling else. */
+ ForStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_withtok)
+ {
+ /* avoid dangling else. */
+ WithStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_asmtok)
+ {
+ /* avoid dangling else. */
+ AsmStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_exittok)
+ {
+ /* avoid dangling else. */
+ ExitStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_returntok)
+ {
+ /* avoid dangling else. */
+ ReturnStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_retrytok)
+ {
+ /* avoid dangling else. */
+ RetryStatement (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: RETRY RETURN EXIT ASM WITH FOR LOOP REPEAT WHILE CASE IF identifier", 85);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ RetryStatement := 'RETRY'
+
+ first symbols:retrytok
+
+ cannot reachend
+*/
+
+static void RetryStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_retrytok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AssignmentOrProcedureCall := Designator ( ':=' Expression |
+ ActualParameters |
+
+ % epsilon %
+ )
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AssignmentOrProcedureCall (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Designator (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_becomestok)
+ {
+ Expect (mcReserved_becomestok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ ActualParameters (stopset0, stopset1, stopset2);
+ }
+ /* epsilon */
+}
+
+
+/*
+ StatementSequence := Statement { ';' Statement }
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok
+
+ reachend
+*/
+
+static void StatementSequence (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Statement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Statement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ IfStatement := 'IF' Expression 'THEN' StatementSequence
+ { 'ELSIF' Expression 'THEN' StatementSequence }
+ [ 'ELSE' StatementSequence ] 'END'
+
+ first symbols:iftok
+
+ cannot reachend
+*/
+
+static void IfStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_iftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok))));
+ Expect (mcReserved_thentok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_elsiftok)
+ {
+ Expect (mcReserved_elsiftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok))));
+ Expect (mcReserved_thentok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ Expect (mcReserved_elsetok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ CaseStatement := 'CASE' Expression 'OF' Case { '|'
+ Case }
+ CaseEndStatement
+
+ first symbols:casetok
+
+ cannot reachend
+*/
+
+static void CaseStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_casetok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Case (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_bartok)
+ {
+ Expect (mcReserved_bartok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Case (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ CaseEndStatement (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ CaseEndStatement := 'END' | 'ELSE' StatementSequence
+ 'END'
+
+ first symbols:elsetok, endtok
+
+ cannot reachend
+*/
+
+static void CaseEndStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_endtok)
+ {
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_elsetok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ELSE END", 26);
+ }
+}
+
+
+/*
+ Case := [ CaseLabelList ':' StatementSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Case (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))))
+ {
+ CaseLabelList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ CaseLabelList := CaseLabels { ',' CaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void CaseLabelList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ CaseLabels (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ CaseLabels (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ CaseLabels := ConstExpressionNop [ '..' ConstExpressionNop ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void CaseLabels (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ WhileStatement := 'WHILE' Expression 'DO' StatementSequence
+ 'END'
+
+ first symbols:whiletok
+
+ cannot reachend
+*/
+
+static void WhileStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_whiletok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_dotok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RepeatStatement := 'REPEAT' StatementSequence 'UNTIL'
+ Expression
+
+ first symbols:repeattok
+
+ cannot reachend
+*/
+
+static void RepeatStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_repeattok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_untiltok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_untiltok-mcReserved_recordtok))));
+ Expect (mcReserved_untiltok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ForStatement := 'FOR' Ident ':=' Expression 'TO'
+ Expression [ 'BY' ConstExpressionNop ]
+ 'DO' StatementSequence 'END'
+
+ first symbols:fortok
+
+ cannot reachend
+*/
+
+static void ForStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_becomestok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok))));
+ Expect (mcReserved_totok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok)) | (1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_dotok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ LoopStatement := 'LOOP' StatementSequence 'END'
+
+ first symbols:looptok
+
+ cannot reachend
+*/
+
+static void LoopStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_looptok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ WithStatement := 'WITH' Designator 'DO' StatementSequence
+ 'END'
+
+ first symbols:withtok
+
+ cannot reachend
+*/
+
+static void WithStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_withtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Designator (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_dotok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock
+ Ident
+ % leaveScope %
+
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ ProcedureHeading (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ ProcedureBlock (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+ decl_leaveScope ();
+}
+
+
+/*
+ ProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+ % enterScope (curproc) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ProcedureIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Ident (stopset0, stopset1, stopset2);
+ curproc = decl_lookupSym (curident);
+ decl_enterScope (curproc);
+}
+
+
+/*
+ DefProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefProcedureIdent (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Ident (stopset0, stopset1, stopset2);
+ curproc = decl_lookupSym (curident);
+}
+
+
+/*
+ DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' Ident ')' ')' |
+ '__INLINE__' ]
+
+ first symbols:inlinetok, attributetok
+
+ reachend
+*/
+
+static void DefineBuiltinProcedure (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_inlinetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __INLINE__ __ATTRIBUTE__", 42);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure
+ ( ProcedureIdent [ FormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureHeading (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefineBuiltinProcedure (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureIdent (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ FormalParameters (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ AttributeNoReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Builtin := [ '__BUILTIN__' | '__INLINE__' ]
+
+ first symbols:inlinetok, builtintok
+
+ reachend
+*/
+
+static void Builtin (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_builtintok)
+ {
+ Expect (mcReserved_builtintok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_inlinetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __INLINE__ __BUILTIN__", 40);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent
+ [ DefFormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void DefProcedureHeading (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Builtin (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefProcedureIdent (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ DefFormalParameters (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ AttributeNoReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ]
+ 'END'
+
+ first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok
+
+ cannot reachend
+*/
+
+static void ProcedureBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Declaration (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_begintok)
+ {
+ Expect (mcReserved_begintok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ ProcedureBlockBody (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Block := { Declaration } InitialBlock FinalBlock
+ 'END'
+
+ first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok
+
+ cannot reachend
+*/
+
+static void Block (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Declaration (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ InitialBlock (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok))), stopset2);
+ FinalBlock (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ InitialBlock := [ 'BEGIN' InitialBlockBody ]
+
+ first symbols:begintok
+
+ reachend
+*/
+
+static void InitialBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_begintok)
+ {
+ Expect (mcReserved_begintok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ InitialBlockBody (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FinalBlock := [ 'FINALLY' FinalBlockBody ]
+
+ first symbols:finallytok
+
+ reachend
+*/
+
+static void FinalBlock (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_finallytok)
+ {
+ Expect (mcReserved_finallytok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ FinalBlockBody (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void InitialBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void FinalBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void ProcedureBlockBody (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ NormalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void NormalPart (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ StatementSequence (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ExceptionalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ExceptionalPart (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ StatementSequence (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Declaration := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ ProcedureDeclaration ';' |
+ ModuleDeclaration ';'
+
+ first symbols:moduletok, proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Declaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_consttok)
+ {
+ Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ ConstantDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_typetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ TypeDeclaration (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ VariableDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ ModuleDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: MODULE PROCEDURE VAR TYPE CONST", 49);
+ }
+}
+
+
+/*
+ DefFormalParameters := '('
+ % paramEnter (curproc) %
+ [ DefMultiFPSection ] ')'
+
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefFormalParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ decl_paramEnter (curproc);
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ DefMultiFPSection (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_paramLeave (curproc);
+ FormalReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefMultiFPSection := DefExtendedFP |
+ FPSection [ ';' DefMultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefMultiFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok))
+ {
+ DefExtendedFP (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ FPSection (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ DefMultiFPSection (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38);
+ }
+}
+
+
+/*
+ FormalParameters := '('
+ % paramEnter (curproc) %
+ [ MultiFPSection ] ')'
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalParameters (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ decl_paramEnter (curproc);
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ MultiFPSection (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_paramLeave (curproc);
+ FormalReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AttributeNoReturn := [ NoReturn |
+ % setNoReturn (curproc, FALSE) %
+ ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeNoReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ NoReturn (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ decl_setNoReturn (curproc, FALSE);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ NoReturn := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void NoReturn (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_setNoReturn (curproc, TRUE);
+ checkReturnAttribute ();
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AttributeUnused := [ Unused ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeUnused (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Unused (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Unused := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void Unused (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ curisused = FALSE;
+ checkParameterAttribute ();
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ MultiFPSection := ExtendedFP | FPSection [ ';'
+ MultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void MultiFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok))
+ {
+ ExtendedFP (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ FPSection (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ MultiFPSection (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38);
+ }
+}
+
+
+/*
+ FPSection := NonVarFPSection |
+ VarFPSection
+
+ first symbols:vartok, identtok
+
+ cannot reachend
+*/
+
+static void FPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ NonVarFPSection (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ VarFPSection (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: VAR identifier", 32);
+ }
+}
+
+
+/*
+ DefExtendedFP := DefOptArg | '...'
+ % addParameter (curproc, makeVarargs ()) %
+
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefExtendedFP (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ DefOptArg (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ decl_addParameter (curproc, decl_makeVarargs ());
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ... [", 23);
+ }
+}
+
+
+/*
+ ExtendedFP := OptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ExtendedFP (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ OptArg (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ... [", 23);
+ }
+}
+
+
+/*
+ VarFPSection := 'VAR' PushIdentList
+ % VAR l, t: node ; %
+ ':' FormalType
+ % t := pop () %
+
+ % l := pop () %
+
+ % curisused := TRUE %
+ [ AttributeUnused ]
+ % addVarParameters (curproc, l, t, curisused) %
+
+
+ first symbols:vartok
+
+ cannot reachend
+*/
+
+static void VarFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node l;
+ decl_node t;
+
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ PushIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ t = pop ();
+ l = pop ();
+ curisused = TRUE;
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ AttributeUnused (stopset0, stopset1, stopset2);
+ }
+ decl_addVarParameters (curproc, l, t, curisused);
+}
+
+
+/*
+ NonVarFPSection := PushIdentList
+ % VAR l, t: node ; %
+ ':' FormalType
+ % t := pop () %
+
+ % l := pop () %
+
+ % curisused := TRUE %
+ [ AttributeUnused ]
+ % addNonVarParameters (curproc, l, t, curisused) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void NonVarFPSection (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node l;
+ decl_node t;
+
+ PushIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ t = pop ();
+ l = pop ();
+ curisused = TRUE;
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ AttributeUnused (stopset0, stopset1, stopset2);
+ }
+ decl_addNonVarParameters (curproc, l, t, curisused);
+}
+
+
+/*
+ OptArg :=
+ % VAR p, init, type: node ; id: Name ; %
+ '[' Ident
+ % id := curident %
+ ':' FormalType
+ % type := pop () %
+
+ % init := NIL %
+ [ '=' ConstExpression
+ % init := pop () %
+ ] ']'
+ % p := addOptParameter (curproc, id, type, init) %
+
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void OptArg (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node p;
+ decl_node init;
+ decl_node type;
+ nameKey_Name id;
+
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ id = curident;
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ type = pop ();
+ init = static_cast<decl_node> (NULL);
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ init = pop ();
+ }
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ p = decl_addOptParameter (curproc, id, type, init);
+}
+
+
+/*
+ DefOptArg :=
+ % VAR p, init, type: node ; id: Name ; %
+ '[' Ident
+ % id := curident %
+ ':' FormalType
+ % type := pop () %
+ '=' ConstExpression
+ % init := pop () %
+ ']'
+ % p := addOptParameter (curproc, id, type, init) %
+
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void DefOptArg (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node p;
+ decl_node init;
+ decl_node type;
+ nameKey_Name id;
+
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ id = curident;
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ type = pop ();
+ Expect (mcReserved_equaltok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ init = pop ();
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ p = decl_addOptParameter (curproc, id, type, init);
+}
+
+
+/*
+ FormalType :=
+ % VAR c: CARDINAL ; %
+
+ % VAR n, a, s: node ; %
+
+ % c := 0 %
+ { 'ARRAY' 'OF'
+ % INC (c) %
+ } PushQualident
+ % pushNunbounded (c) %
+
+
+ first symbols:identtok, arraytok
+
+ cannot reachend
+*/
+
+static void FormalType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ unsigned int c;
+ decl_node n;
+ decl_node a;
+ decl_node s;
+
+ c = 0;
+ while (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ Expect (mcReserved_arraytok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ c += 1;
+ }
+ /* while */
+ PushQualident (stopset0, stopset1, stopset2);
+ pushNunbounded (c);
+}
+
+
+/*
+ ModuleDeclaration := 'MODULE' Ident [ Priority ]
+ ';' { Import } [ Export ]
+ Block Ident
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ModuleDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_exporttok)
+ {
+ Export (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ Block (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Priority := '[' ConstExpressionNop ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void Priority (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Export := 'EXPORT' ( 'QUALIFIED' IdentList |
+ 'UNQUALIFIED' IdentList |
+ IdentList ) ';'
+
+ first symbols:exporttok
+
+ cannot reachend
+*/
+
+static void Export (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_exporttok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) | (1 << (mcReserved_unqualifiedtok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_qualifiedtok)
+ {
+ Expect (mcReserved_qualifiedtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_unqualifiedtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_unqualifiedtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ IdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier UNQUALIFIED QUALIFIED", 50);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FromIdentList := Ident
+ % importInto (frommodule, curident, curmodule) %
+ { ',' Ident
+ % importInto (frommodule, curident, curmodule) %
+ }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FromIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ importInto (frommodule, curident, curmodule);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ importInto (frommodule, curident, curmodule);
+ }
+ /* while */
+}
+
+
+/*
+ FromImport := 'FROM' Ident
+ % frommodule := lookupDef (curident) %
+ 'IMPORT' FromIdentList ';'
+
+ first symbols:fromtok
+
+ cannot reachend
+*/
+
+static void FromImport (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_fromtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok))), stopset2);
+ frommodule = decl_lookupDef (curident);
+ Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FromIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImportModuleList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ImportModuleList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ WithoutFromImport := 'IMPORT' ImportModuleList ';'
+
+ first symbols:importtok
+
+ cannot reachend
+*/
+
+static void WithoutFromImport (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ImportModuleList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Import := FromImport | WithoutFromImport
+
+ first symbols:importtok, fromtok
+
+ cannot reachend
+*/
+
+static void Import (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_fromtok)
+ {
+ FromImport (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_importtok)
+ {
+ /* avoid dangling else. */
+ WithoutFromImport (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IMPORT FROM", 29);
+ }
+}
+
+
+/*
+ DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR'
+ string ]
+ Ident ';'
+ % curmodule := lookupDef (curident) %
+
+ % enterScope (curmodule) %
+
+ % resetEnumPos (curmodule) %
+ { Import } [ Export ] { Definition }
+ 'END' Ident '.'
+ % checkEndName (curmodule, curident, 'definition module') %
+
+ % setConstExpComplete (curmodule) %
+
+ % leaveScope %
+
+
+ first symbols:definitiontok
+
+ cannot reachend
+*/
+
+static void DefinitionModule (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_definitiontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_moduletok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_fortok)
+ {
+ Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ curmodule = decl_lookupDef (curident);
+ decl_enterScope (curmodule);
+ decl_resetEnumPos (curmodule);
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_exporttok)
+ {
+ Export (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Definition (stopset0, stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "definition module", 17);
+ decl_setConstExpComplete (curmodule);
+ decl_leaveScope ();
+}
+
+
+/*
+ PushQualident := Ident
+ % typeExp := push (lookupSym (curident)) %
+
+ % IF typeExp = NIL
+ THEN
+ metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident)
+ END %
+ [ '.'
+ % IF NOT isDef (typeExp)
+ THEN
+ ErrorArray ('the first component of this qualident must be a definition module')
+ END %
+ Ident
+ % typeExp := replace (lookupInScope (typeExp, curident)) ;
+ IF typeExp=NIL
+ THEN
+ ErrorArray ('identifier not found in definition module')
+ END %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void PushQualident (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ typeExp = push (decl_lookupSym (curident));
+ if (typeExp == NULL)
+ {
+ mcMetaError_metaError1 ((const char *) "the symbol {%1k} is not visible in this scope (or any other nested scope)", 73, (const unsigned char *) &curident, (sizeof (curident)-1));
+ }
+ if (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (! (decl_isDef (typeExp)))
+ {
+ ErrorArray ((const char *) "the first component of this qualident must be a definition module", 65);
+ }
+ Ident (stopset0, stopset1, stopset2);
+ typeExp = replace (decl_lookupInScope (typeExp, curident));
+ if (typeExp == NULL)
+ {
+ ErrorArray ((const char *) "identifier not found in definition module", 41);
+ }
+ }
+}
+
+
+/*
+ OptSubrange := [ SubrangeType
+ % VAR q, s: node ; %
+
+ % s := pop () %
+
+ % q := pop () %
+
+ % putSubrangeType (s, q) %
+
+ % typeExp := push (s) %
+ ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void OptSubrange (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node q;
+ decl_node s;
+
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ SubrangeType (stopset0, stopset1, stopset2);
+ s = pop ();
+ q = pop ();
+ decl_putSubrangeType (s, q);
+ typeExp = push (s);
+ }
+}
+
+
+/*
+ TypeEquiv := PushQualident OptSubrange
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void TypeEquiv (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ PushQualident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ OptSubrange (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ EnumIdentList :=
+ % VAR f: node ; %
+
+ % typeExp := push (makeEnum ()) %
+ Ident
+ % f := makeEnumField (typeExp, curident) %
+ { ',' Ident
+ % f := makeEnumField (typeExp, curident) %
+ }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void EnumIdentList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ decl_node f;
+
+ typeExp = push (decl_makeEnum ());
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ f = decl_makeEnumField (typeExp, curident);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ f = decl_makeEnumField (typeExp, curident);
+ }
+ /* while */
+}
+
+
+/*
+ Enumeration := '(' EnumIdentList ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void Enumeration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ EnumIdentList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SimpleType :=
+ % VAR d: CARDINAL ; %
+
+ % d := depth () %
+ ( TypeEquiv | Enumeration |
+ SubrangeType )
+ % assert (d = depth () - 1) %
+
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void SimpleType (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ unsigned int d;
+
+ d = depth ();
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ TypeEquiv (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Enumeration (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: [ ( identifier", 32);
+ }
+ mcDebug_assert (d == ((depth ())-1));
+}
+
+
+/*
+ Type := SimpleType | ArrayType | RecordType |
+ SetType | PointerType | ProcedureType
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void Type (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ SimpleType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ /* avoid dangling else. */
+ ArrayType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_recordtok)
+ {
+ /* avoid dangling else. */
+ RecordType (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp3_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok))
+ {
+ /* avoid dangling else. */
+ SetType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_pointertok)
+ {
+ /* avoid dangling else. */
+ PointerType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80);
+ }
+}
+
+
+/*
+ TypeDeclaration := { Ident
+ % typeDes := lookupSym (curident) %
+ ( ';' | '=' Type
+ % putType (typeDes, pop ()) %
+ Alignment ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TypeDeclaration (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ typeDes = decl_lookupSym (curident);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_equaltok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_putType (typeDes, pop ());
+ Alignment (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: = ;", 21);
+ }
+ }
+ /* while */
+}
+
+
+/*
+ Definition := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ DefProcedureHeading ';'
+
+ first symbols:proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Definition (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_consttok)
+ {
+ Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ ConstantDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_typetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ TypeDeclaration (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ VariableDeclaration (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ DefProcedureHeading (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE VAR TYPE CONST", 42);
+ }
+}
+
+
+/*
+ AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands
+ ')'
+
+ first symbols:asmtok
+
+ cannot reachend
+*/
+
+static void AsmStatement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_asmtok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_volatiletok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_volatiletok)
+ {
+ Expect (mcReserved_volatiletok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmOperands (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AsmOperands := string [ AsmOperandSpec ]
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void AsmOperands (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ string (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ AsmOperandSpec (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AsmOperandSpec := [ ':' AsmList [ ':' AsmList [
+ ':' TrashList ] ] ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void AsmOperandSpec (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmList (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ TrashList (stopset0, stopset1, stopset2);
+ }
+ }
+ }
+}
+
+
+/*
+ AsmList := [ AsmElement ] { ',' AsmElement }
+
+ first symbols:lsbratok, stringtok, commatok
+
+ reachend
+*/
+
+static void AsmList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_stringtok))
+ {
+ AsmElement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmElement (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ NamedOperand := '[' Ident ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void NamedOperand (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AsmOperandName := [ NamedOperand ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void AsmOperandName (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ NamedOperand (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AsmElement := AsmOperandName string '(' Expression
+ ')'
+
+ first symbols:stringtok, lsbratok
+
+ cannot reachend
+*/
+
+static void AsmElement (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ AsmOperandName (stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp3_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ TrashList := [ string ] { ',' string }
+
+ first symbols:commatok, stringtok
+
+ reachend
+*/
+
+static void TrashList (mcp3_SetOfStop0 stopset0, mcp3_SetOfStop1 stopset1, mcp3_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ string (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp3_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0|(mcp3_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ CompilationUnit - returns TRUE if the input was correct enough to parse
+ in future passes.
+*/
+
+extern "C" unsigned int mcp3_CompilationUnit (void)
+{
+ stk = mcStack_init ();
+ WasNoError = TRUE;
+ FileUnit ((mcp3_SetOfStop0) ((1 << (mcReserved_eoftok-mcReserved_eoftok))), (mcp3_SetOfStop1) 0, (mcp3_SetOfStop2) 0);
+ mcStack_kill (&stk);
+ return WasNoError;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcp3_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcp3_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcp4. */
+/* output from mc-4.bnf, automatically generated do not edit.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING. If not,
+see <https://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcp4_H
+#define _mcp4_C
+
+# include "GDynamicStrings.h"
+# include "GmcError.h"
+# include "GnameKey.h"
+# include "GmcPrintf.h"
+# include "GmcDebug.h"
+# include "GmcReserved.h"
+# include "GmcMetaError.h"
+# include "GmcStack.h"
+# include "GmcLexBuf.h"
+# include "Gdecl.h"
+
+# define Pass1 FALSE
+# define Debugging FALSE
+typedef unsigned int mcp4_stop0;
+
+typedef unsigned int mcp4_SetOfStop0;
+
+typedef unsigned int mcp4_stop1;
+
+typedef unsigned int mcp4_SetOfStop1;
+
+typedef unsigned int mcp4_stop2;
+
+typedef unsigned int mcp4_SetOfStop2;
+
+static unsigned int WasNoError;
+static nameKey_Name curstring;
+static nameKey_Name curident;
+static decl_node curproc;
+static decl_node typeDes;
+static decl_node typeExp;
+static decl_node curmodule;
+static mcStack_stack stk;
+
+/*
+ CompilationUnit - returns TRUE if the input was correct enough to parse
+ in future passes.
+*/
+
+extern "C" unsigned int mcp4_CompilationUnit (void);
+
+/*
+ push -
+*/
+
+static decl_node push (decl_node n);
+
+/*
+ pop -
+*/
+
+static decl_node pop (void);
+
+/*
+ replace -
+*/
+
+static decl_node replace (decl_node n);
+
+/*
+ peep - returns the top node on the stack without removing it.
+*/
+
+static decl_node peep (void);
+
+/*
+ depth - returns the depth of the stack.
+*/
+
+static unsigned int depth (void);
+
+/*
+ checkDuplicate -
+*/
+
+static void checkDuplicate (unsigned int b);
+
+/*
+ checkDuplicate -
+*/
+
+static void ErrorString (DynamicStrings_String s);
+
+/*
+ checkDuplicate -
+*/
+
+static void ErrorArray (const char *a_, unsigned int _a_high);
+
+/*
+ pushNunbounded -
+*/
+
+static void pushNunbounded (unsigned int c);
+
+/*
+ makeIndexedArray - builds and returns an array of type, t, with, c, indices.
+*/
+
+static decl_node makeIndexedArray (unsigned int c, decl_node t);
+
+/*
+ importInto - from, m, import, name, into module, current.
+ It checks to see if curident is an enumeration type
+ and if so automatically includes all enumeration fields
+ as well.
+*/
+
+static void importInto (decl_node m, nameKey_Name name, decl_node current);
+
+/*
+ checkEndName - if module does not have, name, then issue an error containing, desc.
+*/
+
+static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high);
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void);
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*/
+
+static void WarnMissingToken (mcReserved_toktype t);
+
+/*
+ MissingToken - generates a warning message about a missing token, t.
+*/
+
+static void MissingToken (mcReserved_toktype t);
+
+/*
+ CheckAndInsert -
+*/
+
+static unsigned int CheckAndInsert (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ InStopSet
+*/
+
+static unsigned int InStopSet (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
+ If it is not then it will insert a token providing the token
+ is one of ; ] ) } . OF END ,
+
+ if the stopset contains <identtok> then we do not insert a token
+*/
+
+static void PeepToken (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Expect -
+*/
+
+static void Expect (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ string -
+*/
+
+static void string (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Integer -
+*/
+
+static void Integer (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Real -
+*/
+
+static void Real (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FileUnit := DefinitionModule |
+ ImplementationOrProgramModule
+
+ first symbols:implementationtok, moduletok, definitiontok
+
+ cannot reachend
+*/
+
+static void FileUnit (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ProgramModule := 'MODULE' Ident
+ % curmodule := lookupModule (curident) %
+
+ % enterScope (curmodule) %
+
+ % resetConstExpPos (curmodule) %
+ [ Priority ] ';' { Import } Block
+ Ident
+ % checkEndName (curmodule, curident, 'program module') %
+
+ % leaveScope %
+ '.'
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ProgramModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ImplementationModule := 'IMPLEMENTATION' 'MODULE'
+ Ident
+ % curmodule := lookupImp (curident) %
+
+ % enterScope (lookupDef (curident)) %
+
+ % enterScope (curmodule) %
+
+ % resetConstExpPos (curmodule) %
+ [ Priority ] ';' { Import }
+ Block Ident
+ % checkEndName (curmodule, curident, 'implementation module') %
+
+ % leaveScope ; leaveScope %
+ '.'
+
+ first symbols:implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ImplementationOrProgramModule := ImplementationModule |
+ ProgramModule
+
+ first symbols:moduletok, implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationOrProgramModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Number := Integer | Real
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void Number (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Qualident := Ident { '.' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Qualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstantDeclaration :=
+ % VAR d, e: node ; %
+ Ident
+ % d := lookupSym (curident) %
+ '=' ConstExpression
+ % e := pop () %
+
+ % assert (isConst (d)) %
+
+ % putConst (d, e) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ConstantDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstExpression :=
+ % VAR c, l, r: node ; op: toktype ; d: CARDINAL ; %
+
+ % d := depth () %
+
+ % c := push (getNextConstExp ()) %
+ SimpleConstExpr
+ % op := currenttoken %
+ [ Relation SimpleConstExpr
+ % r := pop () %
+
+ % l := pop () %
+
+ % l := push (makeBinaryTok (op, l, r)) %
+ ]
+ % c := replace (fixupConstExp (c, pop ())) %
+
+ % assert (d+1 = depth ()) %
+
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Relation := '=' | '#' | '<>' | '<' | '<=' |
+ '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void Relation (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ SimpleConstExpr :=
+ % VAR op: toktype ; n: node ; %
+ UnaryOrConstTerm
+ % n := pop () %
+ {
+ % op := currenttoken %
+ AddOperator ConstTerm
+ % n := makeBinaryTok (op, n, pop ()) %
+ }
+ % n := push (n) %
+
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleConstExpr (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ UnaryOrConstTerm :=
+ % VAR n: node ; %
+ '+' ConstTerm
+ % n := push (makeUnaryTok (plustok, pop ())) %
+ | '-' ConstTerm
+ % n := push (makeUnaryTok (minustok, pop ())) %
+ | ConstTerm
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrConstTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void AddOperator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstTerm :=
+ % VAR op: toktype ; n: node ; %
+ ConstFactor
+ % n := pop () %
+ {
+ % op := currenttoken %
+ MulOperator ConstFactor
+ % n := makeBinaryTok (op, n, pop ()) %
+ }
+ % n := push (n) %
+
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void ConstTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ MulOperator := '*' | '/' | 'DIV' | 'MOD' |
+ 'REM' | 'AND' | '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void MulOperator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ NotConstFactor := 'NOT' ConstFactor
+ % VAR n: node ; %
+
+ % n := push (makeUnaryTok (nottok, pop ())) %
+
+
+ first symbols:nottok
+
+ cannot reachend
+*/
+
+static void NotConstFactor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstFactor := Number | ConstString |
+ ConstSetOrQualidentOrFunction |
+ '(' ConstExpression ')' |
+ NotConstFactor |
+ ConstAttribute
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void ConstFactor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstString := string
+ % VAR n: node ; %
+
+ % n := push (makeString (curstring)) %
+
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void ConstString (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstComponentElement := ConstExpression
+ % VAR l, h, n: node ; %
+
+ % l := pop () %
+
+ % h := NIL %
+ [ '..' ConstExpression
+
+ % h := pop () %
+
+ % ErrorArray ('implementation restriction range is not allowed') %
+ ]
+ % n := push (includeSetValue (pop (), l, h)) %
+
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstComponentElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstComponentValue := ConstComponentElement [ 'BY'
+
+ % ErrorArray ('implementation restriction BY not allowed') %
+ ConstExpression ]
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstComponentValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstArraySetRecordValue := ConstComponentValue
+ { ',' ConstComponentValue }
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstArraySetRecordValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstConstructor := '{'
+ % VAR n: node ; %
+
+ % n := push (makeSetValue ()) %
+ [ ConstArraySetRecordValue ]
+ '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void ConstConstructor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstSetOrQualidentOrFunction :=
+ % VAR q, p, n: node ; d: CARDINAL ; %
+
+ % d := depth () %
+ PushQualident
+ % assert (d+1 = depth ()) %
+ [ ConstConstructor
+
+ % p := pop () %
+
+ % q := pop () %
+
+ % n := push (putSetValue (p, q)) %
+
+ % assert (d+1 = depth ()) %
+ |
+ ConstActualParameters
+
+ % p := pop () %
+
+ % q := pop () %
+
+ % n := push (makeFuncCall (q, p)) %
+
+ % assert (d+1 = depth ()) %
+ ] |
+
+ % d := depth () %
+ ConstConstructor
+
+ % assert (d+1 = depth ()) %
+
+
+ first symbols:identtok, lcbratok
+
+ cannot reachend
+*/
+
+static void ConstSetOrQualidentOrFunction (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstActualParameters := '('
+ % VAR n: node ; %
+
+ % n := push (makeExpList ()) %
+ [ ConstExpList ] ')'
+ % assert (isExpList (peep ())) %
+
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ConstActualParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstExpList :=
+ % VAR p, n: node ; %
+
+ % p := peep () %
+
+ % assert (isExpList (p)) %
+ ConstExpression
+ % putExpList (p, pop ()) %
+
+ % assert (p = peep ()) %
+
+ % assert (isExpList (peep ())) %
+ { ',' ConstExpression
+ % putExpList (p, pop ()) %
+
+ % assert (isExpList (peep ())) %
+ }
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' ConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void ConstAttribute (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ConstAttributeExpression := Ident
+ % VAR n: node ; %
+
+ % n := push (getBuiltinConst (curident)) %
+ | '<' Qualident ','
+ Ident '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void ConstAttributeExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ByteAlignment := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void ByteAlignment (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ OptAlignmentExpression := [ AlignmentExpression ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void OptAlignmentExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AlignmentExpression := '(' ConstExpression ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void AlignmentExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Alignment := [ ByteAlignment ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void Alignment (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ IdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void IdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ PushIdentList :=
+ % VAR n: node ; %
+
+ % n := makeIdentList () %
+ Ident
+ % checkDuplicate (putIdent (n, curident)) %
+ { ',' Ident
+ % checkDuplicate (putIdent (n, curident)) %
+ }
+ % n := push (n) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void PushIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ SubrangeType := '[' ConstExpression '..' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void SubrangeType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ArrayType := 'ARRAY' SimpleType { ',' SimpleType }
+ 'OF' Type
+
+ first symbols:arraytok
+
+ cannot reachend
+*/
+
+static void ArrayType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ RecordType := 'RECORD' [ DefaultRecordAttributes ]
+ FieldListSequence 'END'
+
+ first symbols:recordtok
+
+ cannot reachend
+*/
+
+static void RecordType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefaultRecordAttributes := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void DefaultRecordAttributes (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ RecordFieldPragma := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void RecordFieldPragma (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FieldPragmaExpression := Ident PragmaConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FieldPragmaExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ PragmaConstExpression := [ '(' ConstExpression ')' ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void PragmaConstExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AttributeExpression := Ident '(' ConstExpression
+ ')'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AttributeExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FieldListSequence := FieldListStatement { ';' FieldListStatement }
+
+ first symbols:casetok, identtok, semicolontok
+
+ reachend
+*/
+
+static void FieldListSequence (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FieldListStatement := [ FieldList ]
+
+ first symbols:identtok, casetok
+
+ reachend
+*/
+
+static void FieldListStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FieldList := IdentList ':' Type RecordFieldPragma |
+ 'CASE' CaseTag 'OF' Varient { '|' Varient }
+ [ 'ELSE' FieldListSequence ] 'END'
+
+ first symbols:casetok, identtok
+
+ cannot reachend
+*/
+
+static void FieldList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ TagIdent := Ident |
+ % curident := NulName %
+
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TagIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ CaseTag := TagIdent [ ':' Qualident ]
+
+ first symbols:colontok, identtok
+
+ reachend
+*/
+
+static void CaseTag (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Varient := [ VarientCaseLabelList ':' FieldListSequence ]
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Varient (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ VarientCaseLabelList := VarientCaseLabels { ','
+ VarientCaseLabels }
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabelList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ VarientCaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabels (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType
+
+ first symbols:oftok, packedsettok, settok
+
+ cannot reachend
+*/
+
+static void SetType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ PointerType := 'POINTER' 'TO' Type
+
+ first symbols:pointertok
+
+ cannot reachend
+*/
+
+static void PointerType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ProcedureType := 'PROCEDURE' [ FormalTypeList ]
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FormalTypeList := '(' ( ')' FormalReturn |
+ ProcedureParameters ')'
+ FormalReturn )
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalTypeList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FormalReturn := [ ':' OptReturnType ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void FormalReturn (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ OptReturnType := '[' Qualident ']' |
+ Qualident
+
+ first symbols:identtok, lsbratok
+
+ cannot reachend
+*/
+
+static void OptReturnType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ProcedureParameters := ProcedureParameter { ','
+ ProcedureParameter }
+
+ first symbols:identtok, arraytok, periodperiodperiodtok, vartok
+
+ cannot reachend
+*/
+
+static void ProcedureParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ProcedureParameter := '...' | 'VAR' FormalType |
+ FormalType
+
+ first symbols:identtok, arraytok, vartok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ProcedureParameter (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ VarIdent := Ident [ '[' ConstExpression
+ % VAR n: node ; %
+
+ % n := pop () %
+ ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ VarIdentList := VarIdent { ',' VarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ VariableDeclaration := VarIdentList ':' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VariableDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Designator := Qualident { SubDesignator }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Designator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ SubDesignator := '.' Ident | '[' ArrayExpList ']' |
+ '^'
+
+ first symbols:uparrowtok, lsbratok, periodtok
+
+ cannot reachend
+*/
+
+static void SubDesignator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ArrayExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArrayExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Expression := SimpleExpression [ Relation SimpleExpression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void Expression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ SimpleExpression := UnaryOrTerm { AddOperator Term }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ UnaryOrTerm := '+' Term | '-' Term |
+ Term
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Term := Factor { MulOperator Factor }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void Term (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Factor := Number | string | SetOrDesignatorOrFunction |
+ '(' Expression ')' |
+ 'NOT' ( Factor | ConstAttribute )
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void Factor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ComponentElement := Expression [ '..' Expression
+
+ % ErrorArray ('implementation restriction range not allowed') %
+ ]
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ComponentElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ComponentValue := ComponentElement [ 'BY'
+ % ErrorArray ('implementation restriction BY not allowed') %
+ Expression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ComponentValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArraySetRecordValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Constructor := '{' [ ArraySetRecordValue ] '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void Constructor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ SetOrDesignatorOrFunction := Qualident [ Constructor |
+ SimpleDes
+ [ ActualParameters ] ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void SetOrDesignatorOrFunction (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ SimpleDes := { SubDesignator }
+
+ first symbols:periodtok, lsbratok, uparrowtok
+
+ reachend
+*/
+
+static void SimpleDes (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ActualParameters := '(' [ ExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ActualParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ExitStatement := 'EXIT'
+
+ first symbols:exittok
+
+ cannot reachend
+*/
+
+static void ExitStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ReturnStatement := 'RETURN' [ Expression ]
+
+ first symbols:returntok
+
+ cannot reachend
+*/
+
+static void ReturnStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Statement := [ AssignmentOrProcedureCall |
+ IfStatement | CaseStatement |
+ WhileStatement |
+ RepeatStatement |
+ LoopStatement | ForStatement |
+ WithStatement | AsmStatement |
+ ExitStatement | ReturnStatement |
+ RetryStatement ]
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok
+
+ reachend
+*/
+
+static void Statement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ RetryStatement := 'RETRY'
+
+ first symbols:retrytok
+
+ cannot reachend
+*/
+
+static void RetryStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AssignmentOrProcedureCall := Designator ( ':=' Expression |
+ ActualParameters |
+
+ % epsilon %
+ )
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AssignmentOrProcedureCall (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ StatementSequence := Statement { ';' Statement }
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok
+
+ reachend
+*/
+
+static void StatementSequence (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ IfStatement := 'IF' Expression 'THEN' StatementSequence
+ { 'ELSIF' Expression 'THEN' StatementSequence }
+ [ 'ELSE' StatementSequence ] 'END'
+
+ first symbols:iftok
+
+ cannot reachend
+*/
+
+static void IfStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ CaseStatement := 'CASE' Expression 'OF' Case { '|'
+ Case }
+ CaseEndStatement
+
+ first symbols:casetok
+
+ cannot reachend
+*/
+
+static void CaseStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ CaseEndStatement := 'END' | 'ELSE' StatementSequence
+ 'END'
+
+ first symbols:elsetok, endtok
+
+ cannot reachend
+*/
+
+static void CaseEndStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Case := [ CaseLabelList ':' StatementSequence ]
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Case (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ CaseLabelList := CaseLabels { ',' CaseLabels }
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void CaseLabelList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ CaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void CaseLabels (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ WhileStatement := 'WHILE' Expression 'DO' StatementSequence
+ 'END'
+
+ first symbols:whiletok
+
+ cannot reachend
+*/
+
+static void WhileStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ RepeatStatement := 'REPEAT' StatementSequence 'UNTIL'
+ Expression
+
+ first symbols:repeattok
+
+ cannot reachend
+*/
+
+static void RepeatStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ForStatement := 'FOR' Ident ':=' Expression 'TO'
+ Expression [ 'BY' ConstExpression ]
+ 'DO' StatementSequence 'END'
+
+ first symbols:fortok
+
+ cannot reachend
+*/
+
+static void ForStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ LoopStatement := 'LOOP' StatementSequence 'END'
+
+ first symbols:looptok
+
+ cannot reachend
+*/
+
+static void LoopStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ WithStatement := 'WITH' Designator 'DO' StatementSequence
+ 'END'
+
+ first symbols:withtok
+
+ cannot reachend
+*/
+
+static void WithStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock
+ Ident
+ % leaveScope %
+
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+ % enterScope (curproc) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ProcedureIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefProcedureIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' Ident ')' ')' |
+ '__INLINE__' ]
+
+ first symbols:inlinetok, attributetok
+
+ reachend
+*/
+
+static void DefineBuiltinProcedure (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure
+ ( ProcedureIdent [ FormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureHeading (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Builtin := [ '__BUILTIN__' | '__INLINE__' ]
+
+ first symbols:inlinetok, builtintok
+
+ reachend
+*/
+
+static void Builtin (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent
+ [ DefFormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void DefProcedureHeading (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ]
+ 'END'
+
+ first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok
+
+ cannot reachend
+*/
+
+static void ProcedureBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Block := { Declaration } InitialBlock FinalBlock
+ 'END'
+
+ first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok
+
+ cannot reachend
+*/
+
+static void Block (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ InitialBlock := [ 'BEGIN' InitialBlockBody ]
+
+ first symbols:begintok
+
+ reachend
+*/
+
+static void InitialBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FinalBlock := [ 'FINALLY' FinalBlockBody ]
+
+ first symbols:finallytok
+
+ reachend
+*/
+
+static void FinalBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void InitialBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void FinalBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void ProcedureBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ NormalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void NormalPart (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ExceptionalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ExceptionalPart (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Declaration := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ ProcedureDeclaration ';' |
+ ModuleDeclaration ';'
+
+ first symbols:moduletok, proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Declaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefFormalParameters := '('
+ % paramEnter (curproc) %
+ [ DefMultiFPSection ] ')'
+
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefFormalParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefMultiFPSection := DefExtendedFP |
+ FPSection [ ';' DefMultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefMultiFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FormalParameters := '('
+ % paramEnter (curproc) %
+ [ MultiFPSection ] ')'
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AttributeNoReturn := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeNoReturn (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AttributeUnused := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeUnused (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ MultiFPSection := ExtendedFP | FPSection [ ';'
+ MultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void MultiFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FPSection := NonVarFPSection |
+ VarFPSection
+
+ first symbols:vartok, identtok
+
+ cannot reachend
+*/
+
+static void FPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefExtendedFP := DefOptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefExtendedFP (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ExtendedFP := OptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ExtendedFP (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ VarFPSection := 'VAR' PushIdentList ':' FormalType
+ [ AttributeUnused ]
+
+ first symbols:vartok
+
+ cannot reachend
+*/
+
+static void VarFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ NonVarFPSection := PushIdentList ':' FormalType
+ [ AttributeUnused ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void NonVarFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ]
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void OptArg (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefOptArg := '[' Ident ':' FormalType '=' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void DefOptArg (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FormalType := { 'ARRAY' 'OF' } PushQualident
+
+ first symbols:identtok, arraytok
+
+ cannot reachend
+*/
+
+static void FormalType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ModuleDeclaration := 'MODULE' Ident [ Priority ]
+ ';' { Import } [ Export ]
+ Block Ident
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ModuleDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Priority := '[' ConstExpression ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void Priority (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Export := 'EXPORT' ( 'QUALIFIED' IdentList |
+ 'UNQUALIFIED' IdentList |
+ IdentList ) ';'
+
+ first symbols:exporttok
+
+ cannot reachend
+*/
+
+static void Export (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FromIdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FromIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ FromImport := 'FROM' Ident 'IMPORT' FromIdentList
+ ';'
+
+ first symbols:fromtok
+
+ cannot reachend
+*/
+
+static void FromImport (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ ImportModuleList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ImportModuleList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ WithoutFromImport := 'IMPORT' ImportModuleList ';'
+
+ first symbols:importtok
+
+ cannot reachend
+*/
+
+static void WithoutFromImport (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Import := FromImport | WithoutFromImport
+
+ first symbols:importtok, fromtok
+
+ cannot reachend
+*/
+
+static void Import (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR'
+ string ]
+ Ident
+ % curmodule := lookupDef (curident) %
+
+ % addCommentBody (curmodule) %
+ ';'
+ % enterScope (curmodule) %
+
+ % resetConstExpPos (curmodule) %
+ { Import } [ Export ] { Definition }
+ 'END' Ident '.'
+ % checkEndName (curmodule, curident, 'definition module') %
+
+ % leaveScope %
+
+
+ first symbols:definitiontok
+
+ cannot reachend
+*/
+
+static void DefinitionModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ PushQualident := Ident
+ % typeExp := push (lookupSym (curident)) %
+
+ % IF typeExp = NIL
+ THEN
+ metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident)
+ END %
+ [ '.'
+ % IF NOT isDef (typeExp)
+ THEN
+ ErrorArray ('the first component of this qualident must be a definition module')
+ END %
+ Ident
+ % typeExp := replace (lookupInScope (typeExp, curident)) ;
+ IF typeExp=NIL
+ THEN
+ ErrorArray ('identifier not found in definition module')
+ END %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void PushQualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ OptSubrange := [ SubrangeType ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void OptSubrange (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ TypeEquiv := PushQualident OptSubrange
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void TypeEquiv (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ EnumIdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void EnumIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Enumeration := '(' EnumIdentList ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void Enumeration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ SimpleType := TypeEquiv | Enumeration |
+ SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void SimpleType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Type := SimpleType | ArrayType | RecordType |
+ SetType | PointerType | ProcedureType
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void Type (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ TypeDeclaration := { Ident ( ';' | '=' Type Alignment
+ ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TypeDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefQualident := Ident
+ % typeExp := lookupSym (curident) %
+ [ '.'
+ % IF NOT isDef (typeExp)
+ THEN
+ ErrorArray ('the first component of this qualident must be a definition module')
+ END %
+ Ident
+ % typeExp := lookupInScope (typeExp, curident) ;
+ IF typeExp=NIL
+ THEN
+ ErrorArray ('identifier not found in definition module')
+ END %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefQualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefTypeEquiv := DefQualident OptSubrange
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefTypeEquiv (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefEnumIdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefEnumIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefEnumeration := '(' DefEnumIdentList ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefEnumeration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefSimpleType := DefTypeEquiv | DefEnumeration |
+ SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void DefSimpleType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefType := DefSimpleType | ArrayType |
+ RecordType | SetType | PointerType |
+ ProcedureType
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void DefType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefTypeDeclaration := { Ident ( ';' | '=' DefType
+ Alignment ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void DefTypeDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ DefConstantDeclaration := Ident '=' ConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefConstantDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ Definition := 'CONST' { DefConstantDeclaration ';' } |
+ 'TYPE' { DefTypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ DefProcedureHeading ';'
+
+ first symbols:proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Definition (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands
+ ')'
+
+ first symbols:asmtok
+
+ cannot reachend
+*/
+
+static void AsmStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AsmOperands := string [ AsmOperandSpec ]
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void AsmOperands (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AsmOperandSpec := [ ':' AsmList [ ':' AsmList [
+ ':' TrashList ] ] ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void AsmOperandSpec (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AsmList := [ AsmElement ] { ',' AsmElement }
+
+ first symbols:lsbratok, stringtok, commatok
+
+ reachend
+*/
+
+static void AsmList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ NamedOperand := '[' Ident ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void NamedOperand (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AsmOperandName := [ NamedOperand ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void AsmOperandName (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ AsmElement := AsmOperandName string '(' Expression
+ ')'
+
+ first symbols:stringtok, lsbratok
+
+ cannot reachend
+*/
+
+static void AsmElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+/*
+ TrashList := [ string ] { ',' string }
+
+ first symbols:commatok, stringtok
+
+ reachend
+*/
+
+static void TrashList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2);
+
+
+/*
+ push -
+*/
+
+static decl_node push (decl_node n)
+{
+ return static_cast<decl_node> (mcStack_push (stk, reinterpret_cast<void *> (n)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ pop -
+*/
+
+static decl_node pop (void)
+{
+ return static_cast<decl_node> (mcStack_pop (stk));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ replace -
+*/
+
+static decl_node replace (decl_node n)
+{
+ return static_cast<decl_node> (mcStack_replace (stk, reinterpret_cast<void *> (n)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ peep - returns the top node on the stack without removing it.
+*/
+
+static decl_node peep (void)
+{
+ return push (pop ());
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ depth - returns the depth of the stack.
+*/
+
+static unsigned int depth (void)
+{
+ return mcStack_depth (stk);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ checkDuplicate -
+*/
+
+static void checkDuplicate (unsigned int b)
+{
+}
+
+
+/*
+ checkDuplicate -
+*/
+
+static void ErrorString (DynamicStrings_String s)
+{
+ mcError_errorStringAt (s, mcLexBuf_getTokenNo ());
+ WasNoError = FALSE;
+}
+
+
+/*
+ checkDuplicate -
+*/
+
+static void ErrorArray (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ ErrorString (DynamicStrings_InitString ((const char *) a, _a_high));
+}
+
+
+/*
+ pushNunbounded -
+*/
+
+static void pushNunbounded (unsigned int c)
+{
+ decl_node type;
+ decl_node array;
+ decl_node subrange;
+
+ while (c != 0)
+ {
+ type = pop ();
+ subrange = decl_makeSubrange (static_cast<decl_node> (NULL), static_cast<decl_node> (NULL));
+ decl_putSubrangeType (subrange, decl_getCardinal ());
+ array = decl_makeArray (subrange, type);
+ decl_putUnbounded (array);
+ type = push (array);
+ c -= 1;
+ }
+}
+
+
+/*
+ makeIndexedArray - builds and returns an array of type, t, with, c, indices.
+*/
+
+static decl_node makeIndexedArray (unsigned int c, decl_node t)
+{
+ decl_node i;
+
+ while (c > 0)
+ {
+ t = decl_makeArray (pop (), t);
+ c -= 1;
+ }
+ return t;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ importInto - from, m, import, name, into module, current.
+ It checks to see if curident is an enumeration type
+ and if so automatically includes all enumeration fields
+ as well.
+*/
+
+static void importInto (decl_node m, nameKey_Name name, decl_node current)
+{
+ decl_node s;
+ decl_node o;
+
+ mcDebug_assert (decl_isDef (m));
+ mcDebug_assert (((decl_isDef (current)) || (decl_isModule (current))) || (decl_isImp (current)));
+ s = decl_lookupExported (m, name);
+ if (s == NULL)
+ {
+ mcMetaError_metaError2 ((const char *) "{%1k} was not exported from definition module {%2a}", 51, (const unsigned char *) &name, (sizeof (name)-1), (const unsigned char *) &m, (sizeof (m)-1));
+ }
+ else
+ {
+ o = decl_import (current, s);
+ if (s != o)
+ {
+ mcMetaError_metaError2 ((const char *) "{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}", 87, (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &o, (sizeof (o)-1));
+ }
+ }
+}
+
+
+/*
+ checkEndName - if module does not have, name, then issue an error containing, desc.
+*/
+
+static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high)
+{
+ DynamicStrings_String s;
+ char desc[_desc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (desc, desc_, _desc_high+1);
+
+ if ((decl_getSymName (module)) != name)
+ {
+ s = DynamicStrings_InitString ((const char *) "inconsistent module name found with this ", 41);
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) desc, _desc_high)));
+ ErrorString (s);
+ }
+}
+
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ unsigned int n;
+ DynamicStrings_String str;
+ DynamicStrings_String message;
+
+ n = 0;
+ message = DynamicStrings_InitString ((const char *) "", 0);
+ if ((((1 << (mcReserved_stringtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "string", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_realtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "real number", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_identtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_integertok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "integer number", 14)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_inlinetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__INLINE__", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_builtintok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__BUILTIN__", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_attributetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__ATTRIBUTE__", 13)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_filetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__FILE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_linetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__LINE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_datetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__DATE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "...", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_volatiletok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VOLATILE", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_asmtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ASM", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_withtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WITH", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_whiletok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WHILE", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_vartok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VAR", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_untiltok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNTIL", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_typetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TYPE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_totok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TO", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_thentok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "THEN", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_settok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "SET", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_returntok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETURN", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_retrytok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETRY", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_repeattok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REPEAT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_remtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REM", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_recordtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RECORD", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_unqualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNQUALIFIED", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "QUALIFIED", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_proceduretok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PROCEDURE", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_pointertok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "POINTER", 7)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_packedsettok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PACKEDSET", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ortok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OR", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_oftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OF", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_nottok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "NOT", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_moduletok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MODULE", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_modtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MOD", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_looptok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "LOOP", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_intok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IN", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_importtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPORT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_implementationtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPLEMENTATION", 14)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_iftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IF", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_fromtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FROM", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_fortok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FOR", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_finallytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FINALLY", 7)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_exporttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXPORT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_exittok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXIT", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_excepttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXCEPT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_endtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "END", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_elsiftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSIF", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_elsetok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_dotok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DO", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_divtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DIV", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_definitiontok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DEFINITION", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_consttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CONST", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_casetok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CASE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_bytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BY", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_begintok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BEGIN", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_arraytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ARRAY", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_andtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "AND", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_colontok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodperiodtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "..", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*>", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<*", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lessequaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<>", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_hashtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "#", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_equaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "^", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_semicolontok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ";", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_commatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ",", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "&", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_dividetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "/", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_timestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_minustok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_plustok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "+", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_doublequotestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ',');
+ n += 1;
+ }
+ if ((((1 << (mcReserved_singlequotetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ',');
+ n += 1;
+ }
+ if ((((1 << (mcReserved_greatertok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lesstok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rparatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lparatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rcbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lcbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rsbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lsbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_bartok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_becomestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_eoftok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {} /* empty. */
+ /* eoftok has no token name (needed to generate error messages) */
+ if (n == 0)
+ {
+ str = DynamicStrings_InitString ((const char *) " syntax error", 13);
+ message = DynamicStrings_KillString (message);
+ }
+ else if (n == 1)
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message);
+ message = DynamicStrings_KillString (message);
+ }
+ return str;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void)
+{
+ DynamicStrings_String str;
+
+ str = DynamicStrings_InitString ((const char *) "", 0);
+ switch (mcLexBuf_currenttoken)
+ {
+ case mcReserved_stringtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found string", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_realtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found real number", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_identtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_integertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found integer number", 34), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_inlinetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __INLINE__", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_builtintok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __BUILTIN__", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_attributetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __ATTRIBUTE__", 33), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_filetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __FILE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_linetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __LINE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_datetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __DATE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodperiodperiodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ...", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_volatiletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VOLATILE", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_asmtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ASM", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_withtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WITH", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_whiletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WHILE", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_vartok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VAR", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_untiltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNTIL", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_typetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TYPE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_totok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TO", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_thentok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found THEN", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_settok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found SET", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_returntok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETURN", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_retrytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETRY", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_repeattok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REPEAT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_remtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REM", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_recordtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RECORD", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_unqualifiedtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNQUALIFIED", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_qualifiedtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found QUALIFIED", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_proceduretok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PROCEDURE", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_pointertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found POINTER", 27), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_packedsettok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PACKEDSET", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ortok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OR", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_oftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OF", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_nottok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found NOT", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_moduletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MODULE", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_modtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MOD", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_looptok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found LOOP", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_intok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IN", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_importtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPORT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_implementationtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPLEMENTATION", 34), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_iftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IF", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_fromtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FROM", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_fortok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FOR", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_finallytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FINALLY", 27), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_exporttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXPORT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_exittok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXIT", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_excepttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXCEPT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_endtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found END", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_elsiftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSIF", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_elsetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_dotok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DO", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_divtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DIV", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_definitiontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DEFINITION", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_consttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CONST", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_casetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CASE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_bytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BY", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_begintok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BEGIN", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_arraytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ARRAY", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_andtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found AND", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_colontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodperiodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ..", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rdirectivetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *>", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ldirectivetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <*", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_greaterequaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lessequaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lessgreatertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <>", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_hashtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found #", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_equaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_uparrowtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ^", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_semicolontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ;", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_commatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ,", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found .", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ambersandtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found &", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_dividetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found /", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_timestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_minustok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found -", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_plustok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found +", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_doublequotestok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_singlequotetok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_greatertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lesstok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rcbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lcbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rsbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lsbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_bartok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_becomestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_eoftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str));
+ break;
+
+
+ default:
+ break;
+ }
+ ErrorString (str);
+}
+
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ DescribeError ();
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "\\nskipping token *** ", 21);
+ }
+ /*
+ yes the ORD(currenttoken) looks ugly, but it is *much* safer than
+ using currenttoken<sometok as a change to the ordering of the
+ token declarations below would cause this to break. Using ORD() we are
+ immune from such changes
+ */
+ while (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0)))))
+ {
+ mcLexBuf_getToken ();
+ }
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) " ***\\n", 6);
+ }
+}
+
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ /* and again (see above re: ORD)
+ */
+ if (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0)))))
+ {
+ SyntaxError (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*/
+
+static void WarnMissingToken (mcReserved_toktype t)
+{
+ mcp4_SetOfStop0 s0;
+ mcp4_SetOfStop1 s1;
+ mcp4_SetOfStop2 s2;
+ DynamicStrings_String str;
+
+ s0 = (mcp4_SetOfStop0) 0;
+ s1 = (mcp4_SetOfStop1) 0;
+ s2 = (mcp4_SetOfStop2) 0;
+ if ( ((unsigned int) (t)) < 32)
+ {
+ s0 = (mcp4_SetOfStop0) ((1 << (t-mcReserved_eoftok)));
+ }
+ else if ( ((unsigned int) (t)) < 64)
+ {
+ /* avoid dangling else. */
+ s1 = (mcp4_SetOfStop1) ((1 << (t-mcReserved_arraytok)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ s2 = (mcp4_SetOfStop2) ((1 << (t-mcReserved_recordtok)));
+ }
+ str = DescribeStop (s0, s1, s2);
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error,", 13), DynamicStrings_Mark (str));
+ mcError_errorStringAt (str, mcLexBuf_getTokenNo ());
+}
+
+
+/*
+ MissingToken - generates a warning message about a missing token, t.
+*/
+
+static void MissingToken (mcReserved_toktype t)
+{
+ WarnMissingToken (t);
+ if ((((t != mcReserved_identtok) && (t != mcReserved_integertok)) && (t != mcReserved_realtok)) && (t != mcReserved_stringtok))
+ {
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "inserting token\\n", 17);
+ }
+ mcLexBuf_insertToken (t);
+ }
+}
+
+
+/*
+ CheckAndInsert -
+*/
+
+static unsigned int CheckAndInsert (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0))))
+ {
+ WarnMissingToken (t);
+ mcLexBuf_insertTokenAndRewind (t);
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InStopSet
+*/
+
+static unsigned int InStopSet (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0))))
+ {
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
+ If it is not then it will insert a token providing the token
+ is one of ; ] ) } . OF END ,
+
+ if the stopset contains <identtok> then we do not insert a token
+*/
+
+static void PeepToken (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ /* and again (see above re: ORD)
+ */
+ if ((! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) && (! (InStopSet (mcReserved_identtok, stopset0, stopset1, stopset2))))
+ {
+ /* SyntaxCheck would fail since currentoken is not part of the stopset
+ we check to see whether any of currenttoken might be a commonly omitted token */
+ if ((((((((CheckAndInsert (mcReserved_semicolontok, stopset0, stopset1, stopset2)) || (CheckAndInsert (mcReserved_rsbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rparatok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rcbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_periodtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_oftok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_endtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_commatok, stopset0, stopset1, stopset2)))
+ {} /* empty. */
+ }
+}
+
+
+/*
+ Expect -
+*/
+
+static void Expect (mcReserved_toktype t, mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == t)
+ {
+ /* avoid dangling else. */
+ mcLexBuf_getToken ();
+ if (Pass1)
+ {
+ PeepToken (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ MissingToken (t);
+ }
+ SyntaxCheck (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ curident = nameKey_makekey (mcLexBuf_currentstring);
+ Expect (mcReserved_identtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ string -
+*/
+
+static void string (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ curstring = nameKey_makekey (mcLexBuf_currentstring);
+ Expect (mcReserved_stringtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Integer -
+*/
+
+static void Integer (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ n = push (decl_makeLiteralInt (nameKey_makekey (mcLexBuf_currentstring)));
+ Expect (mcReserved_integertok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Real -
+*/
+
+static void Real (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ n = push (decl_makeLiteralReal (nameKey_makekey (mcLexBuf_currentstring)));
+ Expect (mcReserved_realtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FileUnit := DefinitionModule |
+ ImplementationOrProgramModule
+
+ first symbols:implementationtok, moduletok, definitiontok
+
+ cannot reachend
+*/
+
+static void FileUnit (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_definitiontok)
+ {
+ DefinitionModule (stopset0, stopset1, stopset2);
+ }
+ else if (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_implementationtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ ImplementationOrProgramModule (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IMPLEMENTATION MODULE DEFINITION", 50);
+ }
+}
+
+
+/*
+ ProgramModule := 'MODULE' Ident
+ % curmodule := lookupModule (curident) %
+
+ % enterScope (curmodule) %
+
+ % resetConstExpPos (curmodule) %
+ [ Priority ] ';' { Import } Block
+ Ident
+ % checkEndName (curmodule, curident, 'program module') %
+
+ % leaveScope %
+ '.'
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ProgramModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ curmodule = decl_lookupModule (curident);
+ decl_enterScope (curmodule);
+ decl_resetConstExpPos (curmodule);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ Block (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "program module", 14);
+ decl_leaveScope ();
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImplementationModule := 'IMPLEMENTATION' 'MODULE'
+ Ident
+ % curmodule := lookupImp (curident) %
+
+ % enterScope (lookupDef (curident)) %
+
+ % enterScope (curmodule) %
+
+ % resetConstExpPos (curmodule) %
+ [ Priority ] ';' { Import }
+ Block Ident
+ % checkEndName (curmodule, curident, 'implementation module') %
+
+ % leaveScope ; leaveScope %
+ '.'
+
+ first symbols:implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_implementationtok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ curmodule = decl_lookupImp (curident);
+ decl_enterScope (decl_lookupDef (curident));
+ decl_enterScope (curmodule);
+ decl_resetConstExpPos (curmodule);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ Block (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "implementation module", 21);
+ decl_leaveScope ();
+ decl_leaveScope ();
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImplementationOrProgramModule := ImplementationModule |
+ ProgramModule
+
+ first symbols:moduletok, implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationOrProgramModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_implementationtok)
+ {
+ ImplementationModule (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ ProgramModule (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: MODULE IMPLEMENTATION", 39);
+ }
+}
+
+
+/*
+ Number := Integer | Real
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void Number (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_integertok)
+ {
+ Integer (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_realtok)
+ {
+ /* avoid dangling else. */
+ Real (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: real number integer number", 44);
+ }
+}
+
+
+/*
+ Qualident := Ident { '.' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Qualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ConstantDeclaration :=
+ % VAR d, e: node ; %
+ Ident
+ % d := lookupSym (curident) %
+ '=' ConstExpression
+ % e := pop () %
+
+ % assert (isConst (d)) %
+
+ % putConst (d, e) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ConstantDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node d;
+ decl_node e;
+
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ d = decl_lookupSym (curident);
+ Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ e = pop ();
+ mcDebug_assert (decl_isConst (d));
+ decl_putConst (d, e);
+}
+
+
+/*
+ ConstExpression :=
+ % VAR c, l, r: node ; op: toktype ; d: CARDINAL ; %
+
+ % d := depth () %
+
+ % c := push (getNextConstExp ()) %
+ SimpleConstExpr
+ % op := currenttoken %
+ [ Relation SimpleConstExpr
+ % r := pop () %
+
+ % l := pop () %
+
+ % l := push (makeBinaryTok (op, l, r)) %
+ ]
+ % c := replace (fixupConstExp (c, pop ())) %
+
+ % assert (d+1 = depth ()) %
+
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node c;
+ decl_node l;
+ decl_node r;
+ mcReserved_toktype op;
+ unsigned int d;
+
+ d = depth ();
+ c = push (decl_getNextConstExp ());
+ SimpleConstExpr (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ op = mcLexBuf_currenttoken;
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleConstExpr (stopset0, stopset1, stopset2);
+ r = pop ();
+ l = pop ();
+ l = push (decl_makeBinaryTok (op, l, r));
+ }
+ c = replace (decl_fixupConstExp (c, pop ()));
+ mcDebug_assert ((d+1) == (depth ()));
+}
+
+
+/*
+ Relation := '=' | '#' | '<>' | '<' | '<=' |
+ '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void Relation (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_hashtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_hashtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_intok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_intok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37);
+ }
+}
+
+
+/*
+ SimpleConstExpr :=
+ % VAR op: toktype ; n: node ; %
+ UnaryOrConstTerm
+ % n := pop () %
+ {
+ % op := currenttoken %
+ AddOperator ConstTerm
+ % n := makeBinaryTok (op, n, pop ()) %
+ }
+ % n := push (n) %
+
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleConstExpr (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ mcReserved_toktype op;
+ decl_node n;
+
+ UnaryOrConstTerm (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ n = pop ();
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ op = mcLexBuf_currenttoken;
+ AddOperator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstTerm (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ n = decl_makeBinaryTok (op, n, pop ());
+ }
+ /* while */
+ n = push (n);
+}
+
+
+/*
+ UnaryOrConstTerm :=
+ % VAR n: node ; %
+ '+' ConstTerm
+ % n := push (makeUnaryTok (plustok, pop ())) %
+ | '-' ConstTerm
+ % n := push (makeUnaryTok (minustok, pop ())) %
+ | ConstTerm
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrConstTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstTerm (stopset0, stopset1, stopset2);
+ n = push (decl_makeUnaryTok (mcReserved_plustok, pop ()));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstTerm (stopset0, stopset1, stopset2);
+ n = push (decl_makeUnaryTok (mcReserved_minustok, pop ()));
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ { string identifier - +", 88);
+ }
+}
+
+
+/*
+ AddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void AddOperator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ortok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ortok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: OR - +", 24);
+ }
+}
+
+
+/*
+ ConstTerm :=
+ % VAR op: toktype ; n: node ; %
+ ConstFactor
+ % n := pop () %
+ {
+ % op := currenttoken %
+ MulOperator ConstFactor
+ % n := makeBinaryTok (op, n, pop ()) %
+ }
+ % n := push (n) %
+
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void ConstTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ mcReserved_toktype op;
+ decl_node n;
+
+ ConstFactor (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ n = pop ();
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ op = mcLexBuf_currenttoken;
+ MulOperator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstFactor (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ n = decl_makeBinaryTok (op, n, pop ());
+ }
+ /* while */
+ n = push (n);
+}
+
+
+/*
+ MulOperator := '*' | '/' | 'DIV' | 'MOD' |
+ 'REM' | 'AND' | '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void MulOperator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_timestok)
+ {
+ Expect (mcReserved_timestok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_dividetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_dividetok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_divtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_divtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_modtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_modtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_remtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_remtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_andtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_andtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ambersandtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39);
+ }
+}
+
+
+/*
+ NotConstFactor := 'NOT' ConstFactor
+ % VAR n: node ; %
+
+ % n := push (makeUnaryTok (nottok, pop ())) %
+
+
+ first symbols:nottok
+
+ cannot reachend
+*/
+
+static void NotConstFactor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Expect (mcReserved_nottok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstFactor (stopset0, stopset1, stopset2);
+ n = push (decl_makeUnaryTok (mcReserved_nottok, pop ()));
+}
+
+
+/*
+ ConstFactor := Number | ConstString |
+ ConstSetOrQualidentOrFunction |
+ '(' ConstExpression ')' |
+ NotConstFactor |
+ ConstAttribute
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void ConstFactor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ Number (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ ConstString (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ ConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ NotConstFactor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ ConstAttribute (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( { identifier string integer number real number", 84);
+ }
+}
+
+
+/*
+ ConstString := string
+ % VAR n: node ; %
+
+ % n := push (makeString (curstring)) %
+
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void ConstString (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ string (stopset0, stopset1, stopset2);
+ n = push (decl_makeString (curstring));
+}
+
+
+/*
+ ConstComponentElement := ConstExpression
+ % VAR l, h, n: node ; %
+
+ % l := pop () %
+
+ % h := NIL %
+ [ '..' ConstExpression
+
+ % h := pop () %
+
+ % ErrorArray ('implementation restriction range is not allowed') %
+ ]
+ % n := push (includeSetValue (pop (), l, h)) %
+
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstComponentElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node l;
+ decl_node h;
+ decl_node n;
+
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ l = pop ();
+ h = static_cast<decl_node> (NULL);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ h = pop ();
+ ErrorArray ((const char *) "implementation restriction range is not allowed", 47);
+ }
+ n = push (decl_includeSetValue (pop (), l, h));
+}
+
+
+/*
+ ConstComponentValue := ConstComponentElement [ 'BY'
+
+ % ErrorArray ('implementation restriction BY not allowed') %
+ ConstExpression ]
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstComponentValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ ConstComponentElement (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ErrorArray ((const char *) "implementation restriction BY not allowed", 41);
+ ConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ConstArraySetRecordValue := ConstComponentValue
+ { ',' ConstComponentValue }
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstArraySetRecordValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ ConstComponentValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstComponentValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ConstConstructor := '{'
+ % VAR n: node ; %
+
+ % n := push (makeSetValue ()) %
+ [ ConstArraySetRecordValue ]
+ '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void ConstConstructor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Expect (mcReserved_lcbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ n = push (decl_makeSetValue ());
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ ConstArraySetRecordValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstSetOrQualidentOrFunction :=
+ % VAR q, p, n: node ; d: CARDINAL ; %
+
+ % d := depth () %
+ PushQualident
+ % assert (d+1 = depth ()) %
+ [ ConstConstructor
+
+ % p := pop () %
+
+ % q := pop () %
+
+ % n := push (putSetValue (p, q)) %
+
+ % assert (d+1 = depth ()) %
+ |
+ ConstActualParameters
+
+ % p := pop () %
+
+ % q := pop () %
+
+ % n := push (makeFuncCall (q, p)) %
+
+ % assert (d+1 = depth ()) %
+ ] |
+
+ % d := depth () %
+ ConstConstructor
+
+ % assert (d+1 = depth ()) %
+
+
+ first symbols:identtok, lcbratok
+
+ cannot reachend
+*/
+
+static void ConstSetOrQualidentOrFunction (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node q;
+ decl_node p;
+ decl_node n;
+ unsigned int d;
+
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ d = depth ();
+ PushQualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ mcDebug_assert ((d+1) == (depth ()));
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ ConstConstructor (stopset0, stopset1, stopset2);
+ p = pop ();
+ q = pop ();
+ n = push (decl_putSetValue (p, q));
+ mcDebug_assert ((d+1) == (depth ()));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ ConstActualParameters (stopset0, stopset1, stopset2);
+ p = pop ();
+ q = pop ();
+ n = push (decl_makeFuncCall (q, p));
+ mcDebug_assert ((d+1) == (depth ()));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( {", 21);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else
+ {
+ d = depth ();
+ ConstConstructor (stopset0, stopset1, stopset2);
+ mcDebug_assert ((d+1) == (depth ()));
+ }
+}
+
+
+/*
+ ConstActualParameters := '('
+ % VAR n: node ; %
+
+ % n := push (makeExpList ()) %
+ [ ConstExpList ] ')'
+ % assert (isExpList (peep ())) %
+
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ConstActualParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ n = push (decl_makeExpList ());
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ ConstExpList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ mcDebug_assert (decl_isExpList (peep ()));
+}
+
+
+/*
+ ConstExpList :=
+ % VAR p, n: node ; %
+
+ % p := peep () %
+
+ % assert (isExpList (p)) %
+ ConstExpression
+ % putExpList (p, pop ()) %
+
+ % assert (p = peep ()) %
+
+ % assert (isExpList (peep ())) %
+ { ',' ConstExpression
+ % putExpList (p, pop ()) %
+
+ % assert (isExpList (peep ())) %
+ }
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node p;
+ decl_node n;
+
+ p = peep ();
+ mcDebug_assert (decl_isExpList (p));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_putExpList (p, pop ());
+ mcDebug_assert (p == (peep ()));
+ mcDebug_assert (decl_isExpList (peep ()));
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_putExpList (p, pop ());
+ mcDebug_assert (decl_isExpList (peep ()));
+ }
+ /* while */
+}
+
+
+/*
+ ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' ConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void ConstAttribute (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstAttributeExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstAttributeExpression := Ident
+ % VAR n: node ; %
+
+ % n := push (getBuiltinConst (curident)) %
+ | '<' Qualident ','
+ Ident '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void ConstAttributeExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ n = push (decl_getBuiltinConst (curident));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: < identifier", 30);
+ }
+}
+
+
+/*
+ ByteAlignment := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void ByteAlignment (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ AttributeExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ OptAlignmentExpression := [ AlignmentExpression ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void OptAlignmentExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ AlignmentExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AlignmentExpression := '(' ConstExpression ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void AlignmentExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Alignment := [ ByteAlignment ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void Alignment (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ ByteAlignment (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ IdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void IdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ PushIdentList :=
+ % VAR n: node ; %
+
+ % n := makeIdentList () %
+ Ident
+ % checkDuplicate (putIdent (n, curident)) %
+ { ',' Ident
+ % checkDuplicate (putIdent (n, curident)) %
+ }
+ % n := push (n) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void PushIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ n = decl_makeIdentList ();
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ checkDuplicate (decl_putIdent (n, curident));
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ checkDuplicate (decl_putIdent (n, curident));
+ }
+ /* while */
+ n = push (n);
+}
+
+
+/*
+ SubrangeType := '[' ConstExpression '..' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void SubrangeType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ArrayType := 'ARRAY' SimpleType { ',' SimpleType }
+ 'OF' Type
+
+ first symbols:arraytok
+
+ cannot reachend
+*/
+
+static void ArrayType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_arraytok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ Expect (mcReserved_oftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RecordType := 'RECORD' [ DefaultRecordAttributes ]
+ FieldListSequence 'END'
+
+ first symbols:recordtok
+
+ cannot reachend
+*/
+
+static void RecordType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_recordtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ DefaultRecordAttributes (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ FieldListSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefaultRecordAttributes := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void DefaultRecordAttributes (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ AttributeExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RecordFieldPragma := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void RecordFieldPragma (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldPragmaExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldPragmaExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FieldPragmaExpression := Ident PragmaConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FieldPragmaExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ PragmaConstExpression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ PragmaConstExpression := [ '(' ConstExpression ')' ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void PragmaConstExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AttributeExpression := Ident '(' ConstExpression
+ ')'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AttributeExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FieldListSequence := FieldListStatement { ';' FieldListStatement }
+
+ first symbols:casetok, identtok, semicolontok
+
+ reachend
+*/
+
+static void FieldListSequence (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ FieldListStatement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListStatement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ FieldListStatement := [ FieldList ]
+
+ first symbols:identtok, casetok
+
+ reachend
+*/
+
+static void FieldListStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_casetok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ FieldList (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FieldList := IdentList ':' Type RecordFieldPragma |
+ 'CASE' CaseTag 'OF' Varient { '|' Varient }
+ [ 'ELSE' FieldListSequence ] 'END'
+
+ first symbols:casetok, identtok
+
+ cannot reachend
+*/
+
+static void FieldList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ IdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ RecordFieldPragma (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_casetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_casetok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ CaseTag (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Varient (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_bartok)
+ {
+ Expect (mcReserved_bartok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Varient (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ Expect (mcReserved_elsetok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: CASE identifier", 33);
+ }
+}
+
+
+/*
+ TagIdent := Ident |
+ % curident := NulName %
+
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TagIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ curident = nameKey_NulName;
+ }
+}
+
+
+/*
+ CaseTag := TagIdent [ ':' Qualident ]
+
+ first symbols:colontok, identtok
+
+ reachend
+*/
+
+static void CaseTag (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ TagIdent (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Varient := [ VarientCaseLabelList ':' FieldListSequence ]
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Varient (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ VarientCaseLabelList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListSequence (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ VarientCaseLabelList := VarientCaseLabels { ','
+ VarientCaseLabels }
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabelList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ VarientCaseLabels (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ VarientCaseLabels (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ VarientCaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabels (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType
+
+ first symbols:oftok, packedsettok, settok
+
+ cannot reachend
+*/
+
+static void SetType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_settok)
+ {
+ Expect (mcReserved_settok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_packedsettok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_packedsettok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PACKEDSET SET", 31);
+ }
+ Expect (mcReserved_oftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ PointerType := 'POINTER' 'TO' Type
+
+ first symbols:pointertok
+
+ cannot reachend
+*/
+
+static void PointerType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_pointertok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok))));
+ Expect (mcReserved_totok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureType := 'PROCEDURE' [ FormalTypeList ]
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ FormalTypeList (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FormalTypeList := '(' ( ')' FormalReturn |
+ ProcedureParameters ')'
+ FormalReturn )
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalTypeList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_rparatok)
+ {
+ Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ ProcedureParameters (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: VAR ... ARRAY identifier )", 44);
+ }
+}
+
+
+/*
+ FormalReturn := [ ':' OptReturnType ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void FormalReturn (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ OptReturnType (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ OptReturnType := '[' Qualident ']' |
+ Qualident
+
+ first symbols:identtok, lsbratok
+
+ cannot reachend
+*/
+
+static void OptReturnType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier [", 30);
+ }
+}
+
+
+/*
+ ProcedureParameters := ProcedureParameter { ','
+ ProcedureParameter }
+
+ first symbols:identtok, arraytok, periodperiodperiodtok, vartok
+
+ cannot reachend
+*/
+
+static void ProcedureParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ ProcedureParameter (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureParameter (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ProcedureParameter := '...' | 'VAR' FormalType |
+ FormalType
+
+ first symbols:identtok, arraytok, vartok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ProcedureParameter (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ FormalType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ARRAY identifier VAR ...", 42);
+ }
+}
+
+
+/*
+ VarIdent := Ident [ '[' ConstExpression
+ % VAR n: node ; %
+
+ % n := pop () %
+ ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Expect (mcReserved_lsbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ n = pop ();
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ VarIdentList := VarIdent { ',' VarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ VarIdent (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ VarIdent (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ VariableDeclaration := VarIdentList ':' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VariableDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ VarIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Designator := Qualident { SubDesignator }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Designator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Qualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0)))
+ {
+ SubDesignator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SubDesignator := '.' Ident | '[' ArrayExpList ']' |
+ '^'
+
+ first symbols:uparrowtok, lsbratok, periodtok
+
+ cannot reachend
+*/
+
+static void SubDesignator (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lsbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ArrayExpList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_uparrowtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_uparrowtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ^ [ .", 23);
+ }
+}
+
+
+/*
+ ArrayExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArrayExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ExpList := Expression { ',' Expression }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ExpList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ Expression := SimpleExpression [ Relation SimpleExpression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void Expression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ SimpleExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SimpleExpression := UnaryOrTerm { AddOperator Term }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleExpression (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ UnaryOrTerm (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ AddOperator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ UnaryOrTerm := '+' Term | '-' Term |
+ Term
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrTerm (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ Term (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( string integer number real number identifier { - +", 74);
+ }
+}
+
+
+/*
+ Term := Factor { MulOperator Factor }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void Term (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Factor (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ MulOperator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Factor (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ }
+ /* while */
+}
+
+
+/*
+ Factor := Number | string | SetOrDesignatorOrFunction |
+ '(' Expression ')' |
+ 'NOT' ( Factor | ConstAttribute )
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void Factor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ Number (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ string (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ SetOrDesignatorOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_nottok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ Factor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ ConstAttribute (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ real number integer number string ( NOT { identifier", 84);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( identifier { string integer number real number", 70);
+ }
+}
+
+
+/*
+ ComponentElement := Expression [ '..' Expression
+
+ % ErrorArray ('implementation restriction range not allowed') %
+ ]
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ComponentElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+ ErrorArray ((const char *) "implementation restriction range not allowed", 44);
+ }
+}
+
+
+/*
+ ComponentValue := ComponentElement [ 'BY'
+ % ErrorArray ('implementation restriction BY not allowed') %
+ Expression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ComponentValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ ComponentElement (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ErrorArray ((const char *) "implementation restriction BY not allowed", 41);
+ Expression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+
+ first symbols:lcbratok, identtok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArraySetRecordValue (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ ComponentValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ComponentValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ Constructor := '{' [ ArraySetRecordValue ] '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void Constructor (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lcbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ ArraySetRecordValue (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SetOrDesignatorOrFunction := Qualident [ Constructor |
+ SimpleDes
+ [ ActualParameters ] ] |
+ Constructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void SetOrDesignatorOrFunction (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ SimpleDes (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ ActualParameters (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( ^ [ . {", 27);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ /* avoid dangling else. */
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: { identifier", 30);
+ }
+}
+
+
+/*
+ SimpleDes := { SubDesignator }
+
+ first symbols:periodtok, lsbratok, uparrowtok
+
+ reachend
+*/
+
+static void SimpleDes (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0)))
+ {
+ SubDesignator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ActualParameters := '(' [ ExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ActualParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ ExpList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ExitStatement := 'EXIT'
+
+ first symbols:exittok
+
+ cannot reachend
+*/
+
+static void ExitStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_exittok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ReturnStatement := 'RETURN' [ Expression ]
+
+ first symbols:returntok
+
+ cannot reachend
+*/
+
+static void ReturnStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_returntok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ Expression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Statement := [ AssignmentOrProcedureCall |
+ IfStatement | CaseStatement |
+ WhileStatement |
+ RepeatStatement |
+ LoopStatement | ForStatement |
+ WithStatement | AsmStatement |
+ ExitStatement | ReturnStatement |
+ RetryStatement ]
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok
+
+ reachend
+*/
+
+static void Statement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ AssignmentOrProcedureCall (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_iftok)
+ {
+ /* avoid dangling else. */
+ IfStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_casetok)
+ {
+ /* avoid dangling else. */
+ CaseStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_whiletok)
+ {
+ /* avoid dangling else. */
+ WhileStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_repeattok)
+ {
+ /* avoid dangling else. */
+ RepeatStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_looptok)
+ {
+ /* avoid dangling else. */
+ LoopStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_fortok)
+ {
+ /* avoid dangling else. */
+ ForStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_withtok)
+ {
+ /* avoid dangling else. */
+ WithStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_asmtok)
+ {
+ /* avoid dangling else. */
+ AsmStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_exittok)
+ {
+ /* avoid dangling else. */
+ ExitStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_returntok)
+ {
+ /* avoid dangling else. */
+ ReturnStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_retrytok)
+ {
+ /* avoid dangling else. */
+ RetryStatement (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: RETRY RETURN EXIT ASM WITH FOR LOOP REPEAT WHILE CASE IF identifier", 85);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ RetryStatement := 'RETRY'
+
+ first symbols:retrytok
+
+ cannot reachend
+*/
+
+static void RetryStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_retrytok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AssignmentOrProcedureCall := Designator ( ':=' Expression |
+ ActualParameters |
+
+ % epsilon %
+ )
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AssignmentOrProcedureCall (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Designator (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_becomestok)
+ {
+ Expect (mcReserved_becomestok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ ActualParameters (stopset0, stopset1, stopset2);
+ }
+ /* epsilon */
+}
+
+
+/*
+ StatementSequence := Statement { ';' Statement }
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok
+
+ reachend
+*/
+
+static void StatementSequence (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Statement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Statement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ IfStatement := 'IF' Expression 'THEN' StatementSequence
+ { 'ELSIF' Expression 'THEN' StatementSequence }
+ [ 'ELSE' StatementSequence ] 'END'
+
+ first symbols:iftok
+
+ cannot reachend
+*/
+
+static void IfStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_iftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok))));
+ Expect (mcReserved_thentok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_elsiftok)
+ {
+ Expect (mcReserved_elsiftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok))));
+ Expect (mcReserved_thentok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ Expect (mcReserved_elsetok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ CaseStatement := 'CASE' Expression 'OF' Case { '|'
+ Case }
+ CaseEndStatement
+
+ first symbols:casetok
+
+ cannot reachend
+*/
+
+static void CaseStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_casetok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Case (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_bartok)
+ {
+ Expect (mcReserved_bartok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Case (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ CaseEndStatement (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ CaseEndStatement := 'END' | 'ELSE' StatementSequence
+ 'END'
+
+ first symbols:elsetok, endtok
+
+ cannot reachend
+*/
+
+static void CaseEndStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_endtok)
+ {
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_elsetok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ELSE END", 26);
+ }
+}
+
+
+/*
+ Case := [ CaseLabelList ':' StatementSequence ]
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Case (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ CaseLabelList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ CaseLabelList := CaseLabels { ',' CaseLabels }
+
+ first symbols:identtok, attributetok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void CaseLabelList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ CaseLabels (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ CaseLabels (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ CaseLabels := ConstExpression [ '..' ConstExpression ]
+
+ first symbols:identtok, stringtok, lcbratok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void CaseLabels (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ WhileStatement := 'WHILE' Expression 'DO' StatementSequence
+ 'END'
+
+ first symbols:whiletok
+
+ cannot reachend
+*/
+
+static void WhileStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_whiletok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_dotok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RepeatStatement := 'REPEAT' StatementSequence 'UNTIL'
+ Expression
+
+ first symbols:repeattok
+
+ cannot reachend
+*/
+
+static void RepeatStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_repeattok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_untiltok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_untiltok-mcReserved_recordtok))));
+ Expect (mcReserved_untiltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ForStatement := 'FOR' Ident ':=' Expression 'TO'
+ Expression [ 'BY' ConstExpression ]
+ 'DO' StatementSequence 'END'
+
+ first symbols:fortok
+
+ cannot reachend
+*/
+
+static void ForStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_becomestok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok))));
+ Expect (mcReserved_totok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok)) | (1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_dotok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ LoopStatement := 'LOOP' StatementSequence 'END'
+
+ first symbols:looptok
+
+ cannot reachend
+*/
+
+static void LoopStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_looptok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ WithStatement := 'WITH' Designator 'DO' StatementSequence
+ 'END'
+
+ first symbols:withtok
+
+ cannot reachend
+*/
+
+static void WithStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_withtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Designator (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_dotok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock
+ Ident
+ % leaveScope %
+
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ ProcedureHeading (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ ProcedureBlock (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+ decl_leaveScope ();
+}
+
+
+/*
+ ProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+ % enterScope (curproc) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ProcedureIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0, stopset1, stopset2);
+ curproc = decl_lookupSym (curident);
+ decl_enterScope (curproc);
+}
+
+
+/*
+ DefProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefProcedureIdent (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0, stopset1, stopset2);
+ curproc = decl_lookupSym (curident);
+}
+
+
+/*
+ DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' Ident ')' ')' |
+ '__INLINE__' ]
+
+ first symbols:inlinetok, attributetok
+
+ reachend
+*/
+
+static void DefineBuiltinProcedure (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_inlinetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __INLINE__ __ATTRIBUTE__", 42);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure
+ ( ProcedureIdent [ FormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureHeading (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefineBuiltinProcedure (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureIdent (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ FormalParameters (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ AttributeNoReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Builtin := [ '__BUILTIN__' | '__INLINE__' ]
+
+ first symbols:inlinetok, builtintok
+
+ reachend
+*/
+
+static void Builtin (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_builtintok)
+ {
+ Expect (mcReserved_builtintok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_inlinetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __INLINE__ __BUILTIN__", 40);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent
+ [ DefFormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void DefProcedureHeading (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Builtin (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefProcedureIdent (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ DefFormalParameters (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ AttributeNoReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ]
+ 'END'
+
+ first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok
+
+ cannot reachend
+*/
+
+static void ProcedureBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Declaration (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_begintok)
+ {
+ Expect (mcReserved_begintok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ ProcedureBlockBody (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Block := { Declaration } InitialBlock FinalBlock
+ 'END'
+
+ first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok
+
+ cannot reachend
+*/
+
+static void Block (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Declaration (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ InitialBlock (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok))), stopset2);
+ FinalBlock (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ InitialBlock := [ 'BEGIN' InitialBlockBody ]
+
+ first symbols:begintok
+
+ reachend
+*/
+
+static void InitialBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_begintok)
+ {
+ Expect (mcReserved_begintok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ InitialBlockBody (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FinalBlock := [ 'FINALLY' FinalBlockBody ]
+
+ first symbols:finallytok
+
+ reachend
+*/
+
+static void FinalBlock (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_finallytok)
+ {
+ Expect (mcReserved_finallytok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok))));
+ FinalBlockBody (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ InitialBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void InitialBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FinalBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void FinalBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ProcedureBlockBody := NormalPart [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void ProcedureBlockBody (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ NormalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void NormalPart (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ StatementSequence (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ExceptionalPart := StatementSequence
+
+ first symbols:retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, identtok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ExceptionalPart (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ StatementSequence (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Declaration := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ ProcedureDeclaration ';' |
+ ModuleDeclaration ';'
+
+ first symbols:moduletok, proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Declaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_consttok)
+ {
+ Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ ConstantDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_typetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ TypeDeclaration (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ VariableDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ ModuleDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: MODULE PROCEDURE VAR TYPE CONST", 49);
+ }
+}
+
+
+/*
+ DefFormalParameters := '('
+ % paramEnter (curproc) %
+ [ DefMultiFPSection ] ')'
+
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefFormalParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ decl_paramEnter (curproc);
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ DefMultiFPSection (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_paramLeave (curproc);
+ FormalReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefMultiFPSection := DefExtendedFP |
+ FPSection [ ';' DefMultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefMultiFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok))
+ {
+ DefExtendedFP (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ FPSection (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ DefMultiFPSection (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38);
+ }
+}
+
+
+/*
+ FormalParameters := '('
+ % paramEnter (curproc) %
+ [ MultiFPSection ] ')'
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalParameters (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ decl_paramEnter (curproc);
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ MultiFPSection (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_paramLeave (curproc);
+ FormalReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AttributeNoReturn := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeNoReturn (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AttributeUnused := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeUnused (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ MultiFPSection := ExtendedFP | FPSection [ ';'
+ MultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void MultiFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok))
+ {
+ ExtendedFP (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ FPSection (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ MultiFPSection (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38);
+ }
+}
+
+
+/*
+ FPSection := NonVarFPSection |
+ VarFPSection
+
+ first symbols:vartok, identtok
+
+ cannot reachend
+*/
+
+static void FPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ NonVarFPSection (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ VarFPSection (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: VAR identifier", 32);
+ }
+}
+
+
+/*
+ DefExtendedFP := DefOptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefExtendedFP (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ DefOptArg (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ... [", 23);
+ }
+}
+
+
+/*
+ ExtendedFP := OptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ExtendedFP (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ OptArg (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ... [", 23);
+ }
+}
+
+
+/*
+ VarFPSection := 'VAR' PushIdentList ':' FormalType
+ [ AttributeUnused ]
+
+ first symbols:vartok
+
+ cannot reachend
+*/
+
+static void VarFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ PushIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ AttributeUnused (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ NonVarFPSection := PushIdentList ':' FormalType
+ [ AttributeUnused ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void NonVarFPSection (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ PushIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ AttributeUnused (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ OptArg := '[' Ident ':' FormalType [ '=' ConstExpression ]
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void OptArg (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefOptArg := '[' Ident ':' FormalType '=' ConstExpression
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void DefOptArg (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FormalType := { 'ARRAY' 'OF' } PushQualident
+
+ first symbols:identtok, arraytok
+
+ cannot reachend
+*/
+
+static void FormalType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ while (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ Expect (mcReserved_arraytok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ PushQualident (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ModuleDeclaration := 'MODULE' Ident [ Priority ]
+ ';' { Import } [ Export ]
+ Block Ident
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ModuleDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_exporttok)
+ {
+ Export (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ Block (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Priority := '[' ConstExpression ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void Priority (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Export := 'EXPORT' ( 'QUALIFIED' IdentList |
+ 'UNQUALIFIED' IdentList |
+ IdentList ) ';'
+
+ first symbols:exporttok
+
+ cannot reachend
+*/
+
+static void Export (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_exporttok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) | (1 << (mcReserved_unqualifiedtok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_qualifiedtok)
+ {
+ Expect (mcReserved_qualifiedtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_unqualifiedtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_unqualifiedtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ IdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier UNQUALIFIED QUALIFIED", 50);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FromIdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FromIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ FromImport := 'FROM' Ident 'IMPORT' FromIdentList
+ ';'
+
+ first symbols:fromtok
+
+ cannot reachend
+*/
+
+static void FromImport (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_fromtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FromIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImportModuleList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ImportModuleList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ WithoutFromImport := 'IMPORT' ImportModuleList ';'
+
+ first symbols:importtok
+
+ cannot reachend
+*/
+
+static void WithoutFromImport (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ImportModuleList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Import := FromImport | WithoutFromImport
+
+ first symbols:importtok, fromtok
+
+ cannot reachend
+*/
+
+static void Import (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_fromtok)
+ {
+ FromImport (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_importtok)
+ {
+ /* avoid dangling else. */
+ WithoutFromImport (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IMPORT FROM", 29);
+ }
+}
+
+
+/*
+ DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR'
+ string ]
+ Ident
+ % curmodule := lookupDef (curident) %
+
+ % addCommentBody (curmodule) %
+ ';'
+ % enterScope (curmodule) %
+
+ % resetConstExpPos (curmodule) %
+ { Import } [ Export ] { Definition }
+ 'END' Ident '.'
+ % checkEndName (curmodule, curident, 'definition module') %
+
+ % leaveScope %
+
+
+ first symbols:definitiontok
+
+ cannot reachend
+*/
+
+static void DefinitionModule (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_definitiontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_moduletok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_fortok)
+ {
+ Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ curmodule = decl_lookupDef (curident);
+ decl_addCommentBody (curmodule);
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ decl_enterScope (curmodule);
+ decl_resetConstExpPos (curmodule);
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_exporttok)
+ {
+ Export (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Definition (stopset0, stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "definition module", 17);
+ decl_leaveScope ();
+}
+
+
+/*
+ PushQualident := Ident
+ % typeExp := push (lookupSym (curident)) %
+
+ % IF typeExp = NIL
+ THEN
+ metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident)
+ END %
+ [ '.'
+ % IF NOT isDef (typeExp)
+ THEN
+ ErrorArray ('the first component of this qualident must be a definition module')
+ END %
+ Ident
+ % typeExp := replace (lookupInScope (typeExp, curident)) ;
+ IF typeExp=NIL
+ THEN
+ ErrorArray ('identifier not found in definition module')
+ END %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void PushQualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ typeExp = push (decl_lookupSym (curident));
+ if (typeExp == NULL)
+ {
+ mcMetaError_metaError1 ((const char *) "the symbol {%1k} is not visible in this scope (or any other nested scope)", 73, (const unsigned char *) &curident, (sizeof (curident)-1));
+ }
+ if (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (! (decl_isDef (typeExp)))
+ {
+ ErrorArray ((const char *) "the first component of this qualident must be a definition module", 65);
+ }
+ Ident (stopset0, stopset1, stopset2);
+ typeExp = replace (decl_lookupInScope (typeExp, curident));
+ if (typeExp == NULL)
+ {
+ ErrorArray ((const char *) "identifier not found in definition module", 41);
+ }
+ }
+}
+
+
+/*
+ OptSubrange := [ SubrangeType ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void OptSubrange (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ TypeEquiv := PushQualident OptSubrange
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void TypeEquiv (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ PushQualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ OptSubrange (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ EnumIdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void EnumIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ Enumeration := '(' EnumIdentList ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void Enumeration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ EnumIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SimpleType := TypeEquiv | Enumeration |
+ SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void SimpleType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ TypeEquiv (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Enumeration (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: [ ( identifier", 32);
+ }
+}
+
+
+/*
+ Type := SimpleType | ArrayType | RecordType |
+ SetType | PointerType | ProcedureType
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void Type (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ SimpleType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ /* avoid dangling else. */
+ ArrayType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_recordtok)
+ {
+ /* avoid dangling else. */
+ RecordType (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok))
+ {
+ /* avoid dangling else. */
+ SetType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_pointertok)
+ {
+ /* avoid dangling else. */
+ PointerType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80);
+ }
+}
+
+
+/*
+ TypeDeclaration := { Ident ( ';' | '=' Type Alignment
+ ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TypeDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: = ;", 21);
+ }
+ }
+ /* while */
+}
+
+
+/*
+ DefQualident := Ident
+ % typeExp := lookupSym (curident) %
+ [ '.'
+ % IF NOT isDef (typeExp)
+ THEN
+ ErrorArray ('the first component of this qualident must be a definition module')
+ END %
+ Ident
+ % typeExp := lookupInScope (typeExp, curident) ;
+ IF typeExp=NIL
+ THEN
+ ErrorArray ('identifier not found in definition module')
+ END %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefQualident (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ typeExp = decl_lookupSym (curident);
+ if (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (! (decl_isDef (typeExp)))
+ {
+ ErrorArray ((const char *) "the first component of this qualident must be a definition module", 65);
+ }
+ Ident (stopset0, stopset1, stopset2);
+ typeExp = decl_lookupInScope (typeExp, curident);
+ if (typeExp == NULL)
+ {
+ ErrorArray ((const char *) "identifier not found in definition module", 41);
+ }
+ }
+}
+
+
+/*
+ DefTypeEquiv := DefQualident OptSubrange
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefTypeEquiv (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ DefQualident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ OptSubrange (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefEnumIdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefEnumIdentList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ DefEnumeration := '(' DefEnumIdentList ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefEnumeration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefEnumIdentList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefSimpleType := DefTypeEquiv | DefEnumeration |
+ SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void DefSimpleType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ DefTypeEquiv (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ DefEnumeration (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: [ ( identifier", 32);
+ }
+}
+
+
+/*
+ DefType := DefSimpleType | ArrayType |
+ RecordType | SetType | PointerType |
+ ProcedureType
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void DefType (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ DefSimpleType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ /* avoid dangling else. */
+ ArrayType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_recordtok)
+ {
+ /* avoid dangling else. */
+ RecordType (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp4_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok))
+ {
+ /* avoid dangling else. */
+ SetType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_pointertok)
+ {
+ /* avoid dangling else. */
+ PointerType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80);
+ }
+}
+
+
+/*
+ DefTypeDeclaration := { Ident ( ';' | '=' DefType
+ Alignment ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void DefTypeDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefType (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: = ;", 21);
+ }
+ }
+ /* while */
+}
+
+
+/*
+ DefConstantDeclaration := Ident '=' ConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefConstantDeclaration (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_equaltok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Definition := 'CONST' { DefConstantDeclaration ';' } |
+ 'TYPE' { DefTypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ DefProcedureHeading ';'
+
+ first symbols:proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Definition (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_consttok)
+ {
+ Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ DefConstantDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_typetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ DefTypeDeclaration (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ VariableDeclaration (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ DefProcedureHeading (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE VAR TYPE CONST", 42);
+ }
+}
+
+
+/*
+ AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands
+ ')'
+
+ first symbols:asmtok
+
+ cannot reachend
+*/
+
+static void AsmStatement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_asmtok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_volatiletok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_volatiletok)
+ {
+ Expect (mcReserved_volatiletok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmOperands (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AsmOperands := string [ AsmOperandSpec ]
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void AsmOperands (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ string (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ AsmOperandSpec (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AsmOperandSpec := [ ':' AsmList [ ':' AsmList [
+ ':' TrashList ] ] ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void AsmOperandSpec (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmList (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ TrashList (stopset0, stopset1, stopset2);
+ }
+ }
+ }
+}
+
+
+/*
+ AsmList := [ AsmElement ] { ',' AsmElement }
+
+ first symbols:lsbratok, stringtok, commatok
+
+ reachend
+*/
+
+static void AsmList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_stringtok))
+ {
+ AsmElement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmElement (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ NamedOperand := '[' Ident ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void NamedOperand (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AsmOperandName := [ NamedOperand ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void AsmOperandName (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ NamedOperand (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AsmElement := AsmOperandName string '(' Expression
+ ')'
+
+ first symbols:stringtok, lsbratok
+
+ cannot reachend
+*/
+
+static void AsmElement (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ AsmOperandName (stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp4_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ TrashList := [ string ] { ',' string }
+
+ first symbols:commatok, stringtok
+
+ reachend
+*/
+
+static void TrashList (mcp4_SetOfStop0 stopset0, mcp4_SetOfStop1 stopset1, mcp4_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ string (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp4_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0|(mcp4_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ CompilationUnit - returns TRUE if the input was correct enough to parse
+ in future passes.
+*/
+
+extern "C" unsigned int mcp4_CompilationUnit (void)
+{
+ stk = mcStack_init ();
+ WasNoError = TRUE;
+ FileUnit ((mcp4_SetOfStop0) ((1 << (mcReserved_eoftok-mcReserved_eoftok))), (mcp4_SetOfStop1) 0, (mcp4_SetOfStop2) 0);
+ mcStack_kill (&stk);
+ return WasNoError;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcp4_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcp4_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from mcp5. */
+/* output from mc-5.bnf, automatically generated do not edit.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING. If not,
+see <https://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _mcp5_H
+#define _mcp5_C
+
+# include "GDynamicStrings.h"
+# include "GmcError.h"
+# include "GnameKey.h"
+# include "GmcPrintf.h"
+# include "GmcDebug.h"
+# include "GmcReserved.h"
+# include "GmcComment.h"
+# include "GmcMetaError.h"
+# include "GmcStack.h"
+# include "GmcLexBuf.h"
+# include "Gdecl.h"
+
+# define Pass1 FALSE
+# define Debugging FALSE
+typedef unsigned int mcp5_stop0;
+
+typedef unsigned int mcp5_SetOfStop0;
+
+typedef unsigned int mcp5_stop1;
+
+typedef unsigned int mcp5_SetOfStop1;
+
+typedef unsigned int mcp5_stop2;
+
+typedef unsigned int mcp5_SetOfStop2;
+
+static unsigned int WasNoError;
+static nameKey_Name curstring;
+static nameKey_Name curident;
+static decl_node curproc;
+static decl_node frommodule;
+static decl_node qualid;
+static decl_node typeDes;
+static decl_node typeExp;
+static decl_node curmodule;
+static unsigned int loopNo;
+static mcStack_stack loopStk;
+static mcStack_stack stmtStk;
+static mcStack_stack withStk;
+static mcStack_stack stk;
+
+/*
+ CompilationUnit - returns TRUE if the input was correct enough to parse
+ in future passes.
+*/
+
+extern "C" unsigned int mcp5_CompilationUnit (void);
+
+/*
+ followNode -
+*/
+
+static void followNode (decl_node n);
+
+/*
+ push -
+*/
+
+static decl_node push (decl_node n);
+
+/*
+ pop -
+*/
+
+static decl_node pop (void);
+
+/*
+ replace -
+*/
+
+static decl_node replace (decl_node n);
+
+/*
+ peep - returns the top node on the stack without removing it.
+*/
+
+static decl_node peep (void);
+
+/*
+ depth - returns the depth of the stack.
+*/
+
+static unsigned int depth (void);
+
+/*
+ checkDuplicate -
+*/
+
+static void checkDuplicate (unsigned int b);
+
+/*
+ isQualident - returns TRUE if, n, is a qualident.
+*/
+
+static unsigned int isQualident (decl_node n);
+
+/*
+ startWith -
+*/
+
+static void startWith (decl_node n);
+
+/*
+ endWith -
+*/
+
+static void endWith (void);
+
+/*
+ lookupWithSym -
+*/
+
+static decl_node lookupWithSym (nameKey_Name i);
+
+/*
+ pushStmt - push a node, n, to the statement stack and return node, n.
+*/
+
+static decl_node pushStmt (decl_node n);
+
+/*
+ popStmt - pop the top node from the statement stack.
+*/
+
+static decl_node popStmt (void);
+
+/*
+ peepStmt - return the top node from the statement stack,
+ but leave the stack unchanged.
+*/
+
+static decl_node peepStmt (void);
+
+/*
+ pushLoop - push a node, n, to the loop stack and return node, n.
+*/
+
+static decl_node pushLoop (decl_node n);
+
+/*
+ popLoop - pop the top node from the loop stack.
+*/
+
+static decl_node popLoop (void);
+
+/*
+ peepLoop - return the top node from the loop stack,
+ but leave the stack unchanged.
+*/
+
+static decl_node peepLoop (void);
+
+/*
+ peepLoop - return the top node from the loop stack,
+ but leave the stack unchanged.
+*/
+
+static void ErrorString (DynamicStrings_String s);
+
+/*
+ peepLoop - return the top node from the loop stack,
+ but leave the stack unchanged.
+*/
+
+static void ErrorArray (const char *a_, unsigned int _a_high);
+
+/*
+ pushNunbounded -
+*/
+
+static void pushNunbounded (unsigned int c);
+
+/*
+ makeIndexedArray - builds and returns an array of type, t, with, c, indices.
+*/
+
+static decl_node makeIndexedArray (unsigned int c, decl_node t);
+
+/*
+ importInto - from, m, import, name, into module, current.
+ It checks to see if curident is an enumeration type
+ and if so automatically includes all enumeration fields
+ as well.
+*/
+
+static void importInto (decl_node m, nameKey_Name name, decl_node current);
+
+/*
+ checkEndName - if module does not have, name, then issue an error containing, desc.
+*/
+
+static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high);
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void);
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*/
+
+static void WarnMissingToken (mcReserved_toktype t);
+
+/*
+ MissingToken - generates a warning message about a missing token, t.
+*/
+
+static void MissingToken (mcReserved_toktype t);
+
+/*
+ CheckAndInsert -
+*/
+
+static unsigned int CheckAndInsert (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ InStopSet
+*/
+
+static unsigned int InStopSet (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
+ If it is not then it will insert a token providing the token
+ is one of ; ] ) } . OF END ,
+
+ if the stopset contains <identtok> then we do not insert a token
+*/
+
+static void PeepToken (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Expect -
+*/
+
+static void Expect (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ string -
+*/
+
+static void string (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Integer -
+*/
+
+static void Integer (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Real -
+*/
+
+static void Real (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FileUnit := DefinitionModule |
+ ImplementationOrProgramModule
+
+ first symbols:implementationtok, moduletok, definitiontok
+
+ cannot reachend
+*/
+
+static void FileUnit (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ProgramModule := 'MODULE' Ident
+ % curmodule := lookupModule (curident) %
+
+ % addCommentBody (curmodule) %
+
+ % enterScope (curmodule) %
+
+ % resetConstExpPos (curmodule) %
+ [ Priority ] ';' { Import } Block
+ Ident
+ % checkEndName (curmodule, curident, 'program module') %
+
+ % leaveScope %
+ '.'
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ProgramModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ImplementationModule := 'IMPLEMENTATION' 'MODULE'
+ Ident
+ % curmodule := lookupImp (curident) %
+
+ % addCommentBody (curmodule) %
+
+ % enterScope (lookupDef (curident)) %
+
+ % enterScope (curmodule) %
+
+ % resetConstExpPos (curmodule) %
+ [ Priority ] ';' { Import }
+ Block Ident
+ % checkEndName (curmodule, curident, 'implementation module') %
+
+ % leaveScope ; leaveScope %
+ '.'
+
+ first symbols:implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ImplementationOrProgramModule := ImplementationModule |
+ ProgramModule
+
+ first symbols:moduletok, implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationOrProgramModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstInteger := Integer
+ % VAR i: node ; %
+
+ % i := pop () %
+
+
+ first symbols:integertok
+
+ cannot reachend
+*/
+
+static void ConstInteger (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstReal := Real
+ % VAR r: node ; %
+
+ % r := pop () %
+
+
+ first symbols:realtok
+
+ cannot reachend
+*/
+
+static void ConstReal (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstNumber := ConstInteger | ConstReal
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void ConstNumber (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Number := Integer | Real
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void Number (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Qualident := Ident { '.' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Qualident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstantDeclaration := Ident '=' ConstExpressionNop
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ConstantDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstExpressionNop :=
+ % VAR c: node ; %
+
+ % c := getNextConstExp () %
+ SimpleConstExpr [ Relation
+ SimpleConstExpr ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpressionNop (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstExpression :=
+ % VAR c: node ; %
+
+ % c := push (getNextConstExp ()) %
+ SimpleConstExpr [ Relation SimpleConstExpr ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Relation := '=' | '#' | '<>' | '<' | '<=' |
+ '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void Relation (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ SimpleConstExpr := UnaryOrConstTerm { AddOperator
+ ConstTerm }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleConstExpr (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ UnaryOrConstTerm := '+' ConstTerm |
+ '-' ConstTerm |
+ ConstTerm
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrConstTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void AddOperator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstTerm := ConstFactor { MulOperator ConstFactor }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void ConstTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ MulOperator := '*' | '/' | 'DIV' | 'MOD' |
+ 'REM' | 'AND' | '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void MulOperator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ NotConstFactor := 'NOT' ConstFactor
+ % VAR n: node ; %
+
+ % n := push (makeUnaryTok (nottok, pop ())) %
+
+
+ first symbols:nottok
+
+ cannot reachend
+*/
+
+static void NotConstFactor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstFactor := ConstNumber | ConstString |
+ ConstSetOrQualidentOrFunction |
+ '(' ConstExpressionNop ')' |
+ NotConstFactor |
+ ConstAttribute
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void ConstFactor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void ConstString (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstComponentElement := ConstExpressionNop [ '..'
+ ConstExpressionNop ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstComponentElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstComponentValue := ConstComponentElement [ 'BY'
+ ConstExpressionNop ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstComponentValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstArraySetRecordValue := ConstComponentValue
+ { ',' ConstComponentValue }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstArraySetRecordValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstConstructor := '{' [ ConstArraySetRecordValue ]
+ '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void ConstConstructor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstSetOrQualidentOrFunction := Qualident [ ConstConstructor |
+ ConstActualParameters ] |
+ ConstConstructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void ConstSetOrQualidentOrFunction (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstActualParameters := '(' [ ConstExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ConstActualParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstExpList := ConstExpressionNop { ',' ConstExpressionNop }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' ConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void ConstAttribute (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ConstAttributeExpression := Ident | '<' Qualident
+ ',' Ident '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void ConstAttributeExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ByteAlignment := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void ByteAlignment (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ OptAlignmentExpression := [ AlignmentExpression ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void OptAlignmentExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AlignmentExpression := '(' ConstExpressionNop ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void AlignmentExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Alignment := [ ByteAlignment ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void Alignment (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ IdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void IdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ SubrangeType := '[' ConstExpressionNop '..' ConstExpressionNop
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void SubrangeType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ArrayType := 'ARRAY' SimpleType { ',' SimpleType }
+ 'OF' Type
+
+ first symbols:arraytok
+
+ cannot reachend
+*/
+
+static void ArrayType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ RecordType := 'RECORD' [ DefaultRecordAttributes ]
+ FieldListSequence 'END'
+
+ first symbols:recordtok
+
+ cannot reachend
+*/
+
+static void RecordType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ DefaultRecordAttributes := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void DefaultRecordAttributes (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ RecordFieldPragma := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void RecordFieldPragma (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FieldPragmaExpression := Ident PragmaConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FieldPragmaExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ PragmaConstExpression := [ '(' ConstExpressionNop
+ ')' ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void PragmaConstExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AttributeExpression := Ident '(' ConstExpressionNop
+ ')'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AttributeExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FieldListSequence := FieldListStatement { ';' FieldListStatement }
+
+ first symbols:casetok, identtok, semicolontok
+
+ reachend
+*/
+
+static void FieldListSequence (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FieldListStatement := [ FieldList ]
+
+ first symbols:identtok, casetok
+
+ reachend
+*/
+
+static void FieldListStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FieldList := IdentList ':' Type RecordFieldPragma |
+ 'CASE' CaseTag 'OF' Varient { '|' Varient }
+ [ 'ELSE' FieldListSequence ] 'END'
+
+ first symbols:casetok, identtok
+
+ cannot reachend
+*/
+
+static void FieldList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ TagIdent := Ident |
+ % curident := NulName %
+
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TagIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ CaseTag := TagIdent [ ':' Qualident ]
+
+ first symbols:colontok, identtok
+
+ reachend
+*/
+
+static void CaseTag (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Varient := [ VarientCaseLabelList ':' FieldListSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Varient (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ VarientCaseLabelList := VarientCaseLabels { ','
+ VarientCaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabelList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ VarientCaseLabels := ConstExpressionNop [ '..' ConstExpressionNop ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabels (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType
+
+ first symbols:oftok, packedsettok, settok
+
+ cannot reachend
+*/
+
+static void SetType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ PointerType := 'POINTER' 'TO' Type
+
+ first symbols:pointertok
+
+ cannot reachend
+*/
+
+static void PointerType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ProcedureType := 'PROCEDURE' [ FormalTypeList ]
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FormalTypeList := '(' ( ')' FormalReturn |
+ ProcedureParameters ')'
+ FormalReturn )
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalTypeList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FormalReturn := [ ':' OptReturnType ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void FormalReturn (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ OptReturnType := '[' Qualident ']' |
+ Qualident
+
+ first symbols:identtok, lsbratok
+
+ cannot reachend
+*/
+
+static void OptReturnType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ProcedureParameters := ProcedureParameter { ','
+ ProcedureParameter }
+
+ first symbols:identtok, arraytok, periodperiodperiodtok, vartok
+
+ cannot reachend
+*/
+
+static void ProcedureParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ProcedureParameter := '...' | 'VAR' FormalType |
+ FormalType
+
+ first symbols:arraytok, identtok, vartok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ProcedureParameter (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ VarIdent := Ident [ '[' ConstExpressionNop ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ VarIdentList := VarIdent { ',' VarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ VariableDeclaration := VarIdentList ':' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VariableDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Designator := PushQualident { SubDesignator }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Designator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ SubDesignator :=
+ % VAR n, field, type: node ; %
+
+ % n := peep () %
+
+ % IF n = NIL
+ THEN
+ ErrorArray ('no expression found') ;
+ flushErrors ;
+ RETURN
+ END %
+
+ % type := skipType (getType (n)) %
+ ( '.' Ident
+ % IF isRecord (type)
+ THEN
+ field := lookupInScope (type, curident) ;
+ IF field = NIL
+ THEN
+ metaError2 ('field {%1k} cannot be found in record {%2ad}', curident, type)
+ ELSE
+ n := replace (makeComponentRef (n, field))
+ END
+ ELSE
+ metaError2 ('attempting to access a field {%1k} from {%2ad} which does not have a record type', curident, type)
+ END %
+ | '[' ArrayExpList
+ % IF isArray (type)
+ THEN
+ n := replace (makeArrayRef (n, pop ()))
+ ELSE
+ metaError1 ('attempting to access an array but the expression is not an array but a {%1d}', type)
+ END %
+ ']' | SubPointer )
+
+ first symbols:uparrowtok, lsbratok, periodtok
+
+ cannot reachend
+*/
+
+static void SubDesignator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ SubPointer :=
+ % VAR n, field, type: node ; %
+
+ % n := peep () %
+
+ % type := skipType (getType (n)) %
+ '^' ( '.' Ident
+ % IF isPointer (type)
+ THEN
+ type := skipType (getType (type)) ;
+ IF isRecord (type)
+ THEN
+ field := lookupInScope (type, curident) ;
+ IF field = NIL
+ THEN
+ metaError2 ('field {%1k} cannot be found in record {%2ad}', curident, type)
+ ELSE
+ n := replace (makePointerRef (n, field))
+ END
+ ELSE
+ metaError2 ('attempting to access a field {%1k} from {%2ad} which does not have a record type', curident, type)
+ END
+ ELSE
+ metaError2 ('trying to dereference {%1k} which was not declared as a pointer but a {%2tad}', n, n)
+ END %
+ |
+ % IF isPointer (type)
+ THEN
+ n := replace (makeDeRef (n))
+ ELSE
+ metaError1 ('attempting to dereference a pointer but the expression is not a pointer but a {%1d}', type)
+ END %
+ )
+
+ first symbols:uparrowtok
+
+ cannot reachend
+*/
+
+static void SubPointer (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ArrayExpList :=
+ % VAR l: node ; %
+
+ % l := push (makeExpList ()) %
+ Expression
+ % putExpList (l, pop ()) %
+
+ % assert (isExpList (peep ())) %
+ { ',' Expression
+ % putExpList (l, pop ()) %
+
+ % assert (isExpList (peep ())) %
+ }
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArrayExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ExpList :=
+ % VAR p, n: node ; %
+
+ % p := peep () %
+
+ % assert (isExpList (p)) %
+ Expression
+ % putExpList (p, pop ()) %
+
+ % assert (isExpList (peep ())) %
+ { ',' Expression
+ % putExpList (p, pop ()) %
+
+ % assert (isExpList (peep ())) %
+ }
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Expression :=
+ % VAR c, l, r: node ; op: toktype ; %
+ SimpleExpression
+ % op := currenttoken %
+ [ Relation
+ % l := pop () %
+ SimpleExpression
+ % r := pop () %
+
+ % r := push (makeBinaryTok (op, l, r)) %
+ ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void Expression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ SimpleExpression :=
+ % VAR op: toktype ; n: node ; %
+ UnaryOrTerm {
+ % op := currenttoken %
+
+ % n := pop () %
+ AddOperator Term
+
+ % n := push (makeBinaryTok (op, n, pop ())) %
+ }
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ UnaryOrTerm :=
+ % VAR n: node ; %
+ '+' Term
+ % n := push (makeUnaryTok (plustok, pop ())) %
+ | '-' Term
+ % n := push (makeUnaryTok (minustok, pop ())) %
+ | Term
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Term :=
+ % VAR op: toktype ; n: node ; %
+ Factor {
+ % op := currenttoken %
+ MulOperator
+ % n := pop () %
+ Factor
+ % n := push (makeBinaryTok (op, n, pop ())) %
+ }
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void Term (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ PushString := string
+ % VAR n: node ; %
+
+ % n := push (makeString (curstring)) %
+
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void PushString (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Factor := Number | PushString | SetOrDesignatorOrFunction |
+ '(' Expression ')' |
+ 'NOT' ( Factor
+ % VAR n: node ; %
+
+ % n := push (makeUnaryTok (nottok, pop ())) %
+ | ConstAttribute
+ % n := push (makeUnaryTok (nottok, pop ())) %
+ )
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void Factor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ComponentElement := Expression
+ % VAR l, h, n: node ; %
+
+ % l := pop () %
+
+ % h := NIL %
+ [ '..' Expression
+ % h := pop () %
+
+ % ErrorArray ('implementation restriction range is not allowed') %
+ ]
+ % n := push (includeSetValue (pop (), l, h)) %
+
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ComponentElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ComponentValue := ComponentElement [ 'BY'
+ % ErrorArray ('implementation restriction BY not allowed') %
+ Expression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ComponentValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArraySetRecordValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Constructor := '{'
+ % VAR n: node ; %
+
+ % n := push (makeSetValue ()) %
+ [ ArraySetRecordValue ] '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void Constructor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ SetOrDesignatorOrFunction := PushQualident
+ % VAR q, p, n: node ; %
+ [ Constructor
+ % p := pop () %
+
+ % q := pop () %
+
+ % n := push (putSetValue (p, q)) %
+ | SimpleDes [
+ % q := pop () %
+ ActualParameters
+
+ % p := pop () %
+
+ % p := push (makeFuncCall (q, p)) %
+ ] ] |
+ Constructor
+
+ first symbols:identtok, lcbratok
+
+ cannot reachend
+*/
+
+static void SetOrDesignatorOrFunction (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ SimpleDes := { SubDesignator }
+
+ first symbols:uparrowtok, periodtok, lsbratok
+
+ reachend
+*/
+
+static void SimpleDes (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ActualParameters := '('
+ % VAR n: node ; %
+
+ % n := push (makeExpList ()) %
+ [ ExpList ] ')'
+ % assert (isExpList (peep ())) %
+
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ActualParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ExitStatement :=
+ % VAR n: node ; %
+ 'EXIT'
+ % IF loopNo = 0
+ THEN
+ ErrorArray ('EXIT can only be used inside a LOOP statement')
+ ELSE
+ n := pushStmt (makeExit (peepLoop (), loopNo))
+ END %
+
+
+ first symbols:exittok
+
+ cannot reachend
+*/
+
+static void ExitStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ReturnStatement :=
+ % VAR n: node ; %
+
+ % n := pushStmt (makeReturn ()) %
+ 'RETURN' [ Expression
+ % putReturn (n, pop ()) %
+ ]
+ % addCommentBody (peepStmt ()) %
+
+ % addCommentAfter (peepStmt ()) %
+
+ % assert (isReturn (peepStmt ())) %
+
+
+ first symbols:returntok
+
+ cannot reachend
+*/
+
+static void ReturnStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Statement := ( AssignmentOrProcedureCall |
+ IfStatement | CaseStatement |
+ WhileStatement |
+ RepeatStatement |
+ LoopStatement | ForStatement |
+ WithStatement | AsmStatement |
+ ExitStatement | ReturnStatement |
+ RetryStatement |
+
+ % VAR s: node ; %
+
+ % s := pushStmt (NIL) %
+ )
+
+ first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok
+
+ reachend
+*/
+
+static void Statement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ RetryStatement :=
+ % VAR s: node ; %
+
+ % s := pushStmt (makeComment ("retry")) %
+ 'RETRY'
+
+ first symbols:retrytok
+
+ cannot reachend
+*/
+
+static void RetryStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AssignmentOrProcedureCall :=
+ % VAR d, a, p: node ; %
+ Designator
+ % d := pop () %
+ ( ':=' Expression
+ % a := pushStmt (makeAssignment (d, pop ())) %
+ |
+ ActualParameters
+
+ % a := pushStmt (makeFuncCall (d, pop ())) %
+ |
+
+ % a := pushStmt (makeFuncCall (d, NIL)) %
+ )
+ % addCommentBody (peepStmt ()) %
+
+ % addCommentAfter (peepStmt ()) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AssignmentOrProcedureCall (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ StatementSequence :=
+ % VAR s, t: node ; %
+
+ % s := pushStmt (makeStatementSequence ()) %
+
+ % assert (isStatementSequence (peepStmt ())) %
+ Statement
+ % addStatement (s, popStmt ()) %
+
+ % assert (isStatementSequence (peepStmt ())) %
+ { ';' Statement
+ % addStatement (s, popStmt ()) %
+
+ % assert (isStatementSequence (peepStmt ())) %
+ }
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok
+
+ reachend
+*/
+
+static void StatementSequence (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ IfStatement :=
+ % VAR i, a, b: node ; %
+ 'IF'
+ % b := makeCommentS (getBodyComment ()) %
+ Expression
+ % a := makeCommentS (getAfterComment ()) %
+ 'THEN' StatementSequence
+ % i := pushStmt (makeIf (pop (), popStmt ())) %
+
+ % addIfComments (i, b, a) %
+ { 'ELSIF'
+ % b := makeCommentS (getBodyComment ()) %
+ Expression
+ % a := makeCommentS (getAfterComment ()) %
+ 'THEN'
+ % addElseComments (peepStmt (), b, a) %
+ StatementSequence
+ % i := makeElsif (i, pop (), popStmt ()) %
+ } [ 'ELSE' StatementSequence
+ % putElse (i, popStmt ()) %
+ ] 'END'
+ % b := makeCommentS (getBodyComment ()) %
+
+ % a := makeCommentS (getAfterComment ()) %
+
+ % assert (isIf (peepStmt ())) %
+
+ % addIfEndComments (peepStmt (), b, a) %
+
+
+ first symbols:iftok
+
+ cannot reachend
+*/
+
+static void IfStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ CaseStatement :=
+ % VAR s, e: node ; %
+
+ % s := pushStmt (makeCase ()) %
+ 'CASE' Expression
+ % s := putCaseExpression (s, pop ()) %
+ 'OF' Case { '|' Case } CaseEndStatement
+
+ first symbols:casetok
+
+ cannot reachend
+*/
+
+static void CaseStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ CaseEndStatement :=
+ % VAR c: node ; %
+ 'END' | 'ELSE'
+ % c := peepStmt () %
+ StatementSequence
+ % c := putCaseElse (c, popStmt ()) %
+ 'END'
+
+ first symbols:elsetok, endtok
+
+ cannot reachend
+*/
+
+static void CaseEndStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Case := [ CaseLabelList ':'
+ % VAR l, c: node ; %
+
+ % l := pop () %
+
+ % c := peepStmt () %
+ StatementSequence
+ % c := putCaseStatement (c, l, popStmt ()) %
+ ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Case (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ CaseLabelList :=
+ % VAR l: node ; %
+
+ % l := push (makeCaseList ()) %
+ CaseLabels { ',' CaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void CaseLabelList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ CaseLabels :=
+ % VAR lo, hi, l: node ; %
+
+ % lo := NIL ; hi := NIL %
+
+ % l := peep () %
+ ConstExpression
+ % lo := pop () %
+ [ '..' ConstExpression
+ % hi := pop () %
+ ]
+ % l := putCaseRange (l, lo, hi) %
+
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void CaseLabels (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ WhileStatement :=
+ % VAR s, w, e, a, b: node ; %
+
+ % w := pushStmt (makeWhile ()) %
+ 'WHILE' Expression 'DO'
+ % b := makeCommentS (getBodyComment ()) %
+
+ % a := makeCommentS (getAfterComment ()) %
+
+ % addWhileDoComment (w, b, a) %
+
+ % e := pop () %
+ StatementSequence
+ % s := popStmt () %
+ 'END'
+ % assert (isStatementSequence (peepStmt ())) %
+
+ % putWhile (w, e, s) %
+
+ % b := makeCommentS (getBodyComment ()) %
+
+ % a := makeCommentS (getAfterComment ()) %
+
+ % addWhileEndComment (w, b, a) %
+
+
+ first symbols:whiletok
+
+ cannot reachend
+*/
+
+static void WhileStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ RepeatStatement :=
+ % VAR r, s, a, b: node ; %
+
+ % r := pushStmt (makeRepeat ()) %
+ 'REPEAT'
+ % b := makeCommentS (getBodyComment ()) %
+
+ % a := makeCommentS (getAfterComment ()) %
+
+ % addRepeatComment (r, b, a) %
+ StatementSequence
+ % s := popStmt () %
+ 'UNTIL' Expression
+ % putRepeat (r, s, pop ()) %
+
+ % b := makeCommentS (getBodyComment ()) %
+
+ % a := makeCommentS (getAfterComment ()) %
+
+ % addUntilComment (r, b, a) %
+
+
+ first symbols:repeattok
+
+ cannot reachend
+*/
+
+static void RepeatStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ForStatement :=
+ % VAR f, i, s, e, b: node ; %
+
+ % b := NIL %
+
+ % f := pushStmt (makeFor ()) %
+ 'FOR' Ident
+ % i := lookupWithSym (curident) %
+ ':=' Expression
+ % s := pop () %
+ 'TO' Expression
+ % e := pop () %
+ [ 'BY' ConstExpression
+ % b := pop () %
+ ] 'DO' StatementSequence
+ % putFor (f, i, s, e, b, popStmt ()) %
+ 'END'
+
+ first symbols:fortok
+
+ cannot reachend
+*/
+
+static void ForStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ LoopStatement :=
+ % VAR l, s: node ; %
+ 'LOOP'
+ % l := pushStmt (pushLoop (makeLoop ())) %
+
+ % INC (loopNo) %
+ StatementSequence
+ % s := popStmt () %
+
+ % putLoop (l, s) %
+
+ % DEC (loopNo) %
+ 'END'
+ % l := popLoop () %
+
+ % assert (isLoop (peepStmt ())) %
+
+
+ first symbols:looptok
+
+ cannot reachend
+*/
+
+static void LoopStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ WithStatement := 'WITH' Designator 'DO'
+ % startWith (pop ()) %
+ StatementSequence 'END'
+ % endWith %
+
+
+ first symbols:withtok
+
+ cannot reachend
+*/
+
+static void WithStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock
+ Ident
+ % leaveScope %
+
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+ % enterScope (curproc) %
+
+ % setProcedureComment (lastcomment, curident) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ProcedureIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ DefProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefProcedureIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' Ident ')' ')' |
+ '__INLINE__' ]
+
+ first symbols:inlinetok, attributetok
+
+ reachend
+*/
+
+static void DefineBuiltinProcedure (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure
+ ( ProcedureIdent [ FormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureHeading (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Builtin := [ '__BUILTIN__' | '__INLINE__' ]
+
+ first symbols:inlinetok, builtintok
+
+ reachend
+*/
+
+static void Builtin (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent
+ [ DefFormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void DefProcedureHeading (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ]
+ 'END'
+
+ first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok
+
+ cannot reachend
+*/
+
+static void ProcedureBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Block := { Declaration } InitialBlock FinalBlock
+ 'END'
+
+ first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok
+
+ cannot reachend
+*/
+
+static void Block (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ InitialBlock := [ 'BEGIN' InitialBlockBody ]
+
+ first symbols:begintok
+
+ reachend
+*/
+
+static void InitialBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FinalBlock := [ 'FINALLY' FinalBlockBody ]
+
+ first symbols:finallytok
+
+ reachend
+*/
+
+static void FinalBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ InitialBlockBody := NormalPart
+ % putBegin (curmodule, popStmt ()) %
+ [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void InitialBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FinalBlockBody := NormalPart
+ % putFinally (curmodule, popStmt ()) %
+ [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void FinalBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ProcedureBlockBody := ProcedureNormalPart [ 'EXCEPT'
+ ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void ProcedureBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ProcedureNormalPart := StatementSequence
+ % putBegin (curproc, popStmt ()) %
+
+
+ first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ProcedureNormalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ NormalPart := StatementSequence
+
+ first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void NormalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ExceptionalPart := StatementSequence
+
+ first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ExceptionalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Declaration := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ ProcedureDeclaration ';' |
+ ModuleDeclaration ';'
+
+ first symbols:moduletok, proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Declaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ DefFormalParameters := '('
+ % paramEnter (curproc) %
+ [ DefMultiFPSection ] ')'
+
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefFormalParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AttributeNoReturn := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeNoReturn (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AttributeUnused := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeUnused (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ DefMultiFPSection := DefExtendedFP |
+ FPSection [ ';' DefMultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefMultiFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FormalParameters := '('
+ % paramEnter (curproc) %
+ [ MultiFPSection ] ')'
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ MultiFPSection := ExtendedFP | FPSection [ ';'
+ MultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void MultiFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FPSection := NonVarFPSection |
+ VarFPSection
+
+ first symbols:vartok, identtok
+
+ cannot reachend
+*/
+
+static void FPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ DefExtendedFP := DefOptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefExtendedFP (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ExtendedFP := OptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ExtendedFP (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ VarFPSection := 'VAR' IdentList ':' FormalType [
+ AttributeUnused ]
+
+ first symbols:vartok
+
+ cannot reachend
+*/
+
+static void VarFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void NonVarFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ OptArg := '[' Ident ':' FormalType [ '=' ConstExpressionNop ]
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void OptArg (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ DefOptArg := '[' Ident ':' FormalType '=' ConstExpressionNop
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void DefOptArg (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FormalType := { 'ARRAY' 'OF' } Qualident
+
+ first symbols:identtok, arraytok
+
+ cannot reachend
+*/
+
+static void FormalType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ModuleDeclaration := 'MODULE' Ident [ Priority ]
+ ';' { Import } [ Export ]
+ Block Ident
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ModuleDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Priority := '[' ConstExpressionNop ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void Priority (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Export := 'EXPORT' ( 'QUALIFIED' IdentList |
+ 'UNQUALIFIED' IdentList |
+ IdentList ) ';'
+
+ first symbols:exporttok
+
+ cannot reachend
+*/
+
+static void Export (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FromIdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FromIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ FromImport := 'FROM' Ident 'IMPORT' FromIdentList
+ ';'
+
+ first symbols:fromtok
+
+ cannot reachend
+*/
+
+static void FromImport (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ ImportModuleList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ImportModuleList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ WithoutFromImport := 'IMPORT' ImportModuleList ';'
+
+ first symbols:importtok
+
+ cannot reachend
+*/
+
+static void WithoutFromImport (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Import := FromImport | WithoutFromImport
+
+ first symbols:importtok, fromtok
+
+ cannot reachend
+*/
+
+static void Import (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR'
+ string ]
+ Ident ';'
+ % curmodule := lookupDef (curident) %
+
+ % enterScope (curmodule) %
+ { Import } [ Export ] { Definition }
+ 'END' Ident '.'
+ % checkEndName (curmodule, curident, 'definition module') %
+
+ % leaveScope %
+
+
+ first symbols:definitiontok
+
+ cannot reachend
+*/
+
+static void DefinitionModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ PushQualident :=
+ % VAR type, field: node ; %
+ Ident
+ % qualid := push (lookupWithSym (curident)) %
+
+ % IF qualid = NIL
+ THEN
+ metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident)
+ END %
+ [ '.'
+ % IF NOT isQualident (qualid)
+ THEN
+ ErrorArray ('the first component of this qualident must be a definition module or a parameter/variable/constant which has record type')
+ END %
+ Ident
+ % IF isDef (qualid)
+ THEN
+ qualid := replace (lookupInScope (qualid, curident))
+ ELSE
+ type := skipType (getType (qualid)) ;
+ field := lookupInScope (type, curident) ;
+ IF field = NIL
+ THEN
+ metaError2 ('field {%1k} cannot be found in {%2ad}', curident, qualid)
+ ELSE
+ qualid := replace (makeComponentRef (qualid, field))
+ END
+ END ;
+ IF qualid = NIL
+ THEN
+ metaError1 ('qualified component of the identifier {%1k} cannot be found', curident)
+ END %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void PushQualident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ OptSubrange := [ SubrangeType ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void OptSubrange (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ TypeEquiv := Qualident OptSubrange
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void TypeEquiv (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ EnumIdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void EnumIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Enumeration := '(' EnumIdentList ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void Enumeration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ SimpleType := TypeEquiv | Enumeration |
+ SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void SimpleType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Type := SimpleType | ArrayType | RecordType |
+ SetType | PointerType | ProcedureType
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void Type (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ TypeDeclaration := { Ident ( ';' | '=' Type Alignment
+ ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TypeDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ Definition := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ DefProcedureHeading ';'
+
+ first symbols:proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Definition (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AsmStatement :=
+ % VAR s: node ; %
+
+ % s := pushStmt (makeComment ("asm")) %
+ 'ASM' [ 'VOLATILE' ] '(' AsmOperands
+ ')'
+
+ first symbols:asmtok
+
+ cannot reachend
+*/
+
+static void AsmStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AsmOperands := string [ AsmOperandSpec ]
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void AsmOperands (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AsmOperandSpec := [ ':' AsmList [ ':' AsmList [
+ ':' TrashList ] ] ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void AsmOperandSpec (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AsmList := [ AsmElement ] { ',' AsmElement }
+
+ first symbols:lsbratok, stringtok, commatok
+
+ reachend
+*/
+
+static void AsmList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ NamedOperand := '[' Ident ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void NamedOperand (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AsmOperandName := [ NamedOperand ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void AsmOperandName (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ AsmElement := AsmOperandName string '(' Expression
+ ')'
+
+ first symbols:stringtok, lsbratok
+
+ cannot reachend
+*/
+
+static void AsmElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+/*
+ TrashList := [ string ] { ',' string }
+
+ first symbols:commatok, stringtok
+
+ reachend
+*/
+
+static void TrashList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2);
+
+
+/*
+ followNode -
+*/
+
+static void followNode (decl_node n)
+{
+ if (decl_isVar (n))
+ {
+ mcPrintf_printf0 ((const char *) "variable: ", 10);
+ }
+ else if (decl_isParameter (n))
+ {
+ /* avoid dangling else. */
+ mcPrintf_printf0 ((const char *) "parameter: ", 11);
+ }
+ n = decl_skipType (decl_getType (n));
+ if (decl_isArray (n))
+ {
+ mcPrintf_printf0 ((const char *) "array\\n", 7);
+ }
+ else if (decl_isPointer (n))
+ {
+ /* avoid dangling else. */
+ mcPrintf_printf0 ((const char *) "pointer\\n", 9);
+ }
+ else if (decl_isRecord (n))
+ {
+ /* avoid dangling else. */
+ mcPrintf_printf0 ((const char *) "record\\n", 8);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ mcPrintf_printf0 ((const char *) "other\\n", 7);
+ }
+}
+
+
+/*
+ push -
+*/
+
+static decl_node push (decl_node n)
+{
+ return static_cast<decl_node> (mcStack_push (stk, reinterpret_cast<void *> (n)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ pop -
+*/
+
+static decl_node pop (void)
+{
+ return static_cast<decl_node> (mcStack_pop (stk));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ replace -
+*/
+
+static decl_node replace (decl_node n)
+{
+ return static_cast<decl_node> (mcStack_replace (stk, reinterpret_cast<void *> (n)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ peep - returns the top node on the stack without removing it.
+*/
+
+static decl_node peep (void)
+{
+ return push (pop ());
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ depth - returns the depth of the stack.
+*/
+
+static unsigned int depth (void)
+{
+ return mcStack_depth (stk);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ checkDuplicate -
+*/
+
+static void checkDuplicate (unsigned int b)
+{
+}
+
+
+/*
+ isQualident - returns TRUE if, n, is a qualident.
+*/
+
+static unsigned int isQualident (decl_node n)
+{
+ decl_node type;
+
+ if (decl_isDef (n))
+ {
+ return TRUE;
+ }
+ else
+ {
+ type = decl_skipType (decl_getType (n));
+ return (type != NULL) && (decl_isRecord (type));
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ startWith -
+*/
+
+static void startWith (decl_node n)
+{
+ n = static_cast<decl_node> (mcStack_push (withStk, reinterpret_cast<void *> (n)));
+}
+
+
+/*
+ endWith -
+*/
+
+static void endWith (void)
+{
+ decl_node n;
+
+ n = static_cast<decl_node> (mcStack_pop (withStk));
+}
+
+
+/*
+ lookupWithSym -
+*/
+
+static decl_node lookupWithSym (nameKey_Name i)
+{
+ unsigned int d;
+ decl_node n;
+ decl_node m;
+ decl_node t;
+
+ d = mcStack_depth (withStk);
+ while (d != 0)
+ {
+ n = static_cast<decl_node> (mcStack_access (withStk, d));
+ t = decl_skipType (decl_getType (n));
+ m = decl_lookupInScope (t, i);
+ if (m != NULL)
+ {
+ n = decl_dupExpr (n);
+ return decl_makeComponentRef (n, m);
+ }
+ d -= 1;
+ }
+ return decl_lookupSym (i);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ pushStmt - push a node, n, to the statement stack and return node, n.
+*/
+
+static decl_node pushStmt (decl_node n)
+{
+ return static_cast<decl_node> (mcStack_push (stmtStk, reinterpret_cast<void *> (n)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ popStmt - pop the top node from the statement stack.
+*/
+
+static decl_node popStmt (void)
+{
+ return static_cast<decl_node> (mcStack_pop (stmtStk));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ peepStmt - return the top node from the statement stack,
+ but leave the stack unchanged.
+*/
+
+static decl_node peepStmt (void)
+{
+ return pushStmt (popStmt ());
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ pushLoop - push a node, n, to the loop stack and return node, n.
+*/
+
+static decl_node pushLoop (decl_node n)
+{
+ return static_cast<decl_node> (mcStack_push (loopStk, reinterpret_cast<void *> (n)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ popLoop - pop the top node from the loop stack.
+*/
+
+static decl_node popLoop (void)
+{
+ return static_cast<decl_node> (mcStack_pop (loopStk));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ peepLoop - return the top node from the loop stack,
+ but leave the stack unchanged.
+*/
+
+static decl_node peepLoop (void)
+{
+ return pushLoop (popLoop ());
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ peepLoop - return the top node from the loop stack,
+ but leave the stack unchanged.
+*/
+
+static void ErrorString (DynamicStrings_String s)
+{
+ mcError_errorStringAt (s, mcLexBuf_getTokenNo ());
+ WasNoError = FALSE;
+}
+
+
+/*
+ peepLoop - return the top node from the loop stack,
+ but leave the stack unchanged.
+*/
+
+static void ErrorArray (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ ErrorString (DynamicStrings_InitString ((const char *) a, _a_high));
+}
+
+
+/*
+ pushNunbounded -
+*/
+
+static void pushNunbounded (unsigned int c)
+{
+ decl_node type;
+ decl_node array;
+ decl_node subrange;
+
+ while (c != 0)
+ {
+ type = pop ();
+ subrange = decl_makeSubrange (static_cast<decl_node> (NULL), static_cast<decl_node> (NULL));
+ decl_putSubrangeType (subrange, decl_getCardinal ());
+ array = decl_makeArray (subrange, type);
+ decl_putUnbounded (array);
+ type = push (array);
+ c -= 1;
+ }
+}
+
+
+/*
+ makeIndexedArray - builds and returns an array of type, t, with, c, indices.
+*/
+
+static decl_node makeIndexedArray (unsigned int c, decl_node t)
+{
+ decl_node i;
+
+ while (c > 0)
+ {
+ t = decl_makeArray (pop (), t);
+ c -= 1;
+ }
+ return t;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ importInto - from, m, import, name, into module, current.
+ It checks to see if curident is an enumeration type
+ and if so automatically includes all enumeration fields
+ as well.
+*/
+
+static void importInto (decl_node m, nameKey_Name name, decl_node current)
+{
+ decl_node s;
+ decl_node o;
+
+ mcDebug_assert (decl_isDef (m));
+ mcDebug_assert (((decl_isDef (current)) || (decl_isModule (current))) || (decl_isImp (current)));
+ s = decl_lookupExported (m, name);
+ if (s == NULL)
+ {
+ mcMetaError_metaError2 ((const char *) "{%1k} was not exported from definition module {%2a}", 51, (const unsigned char *) &name, (sizeof (name)-1), (const unsigned char *) &m, (sizeof (m)-1));
+ }
+ else
+ {
+ o = decl_import (current, s);
+ if (s != o)
+ {
+ mcMetaError_metaError2 ((const char *) "{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}", 87, (const unsigned char *) &s, (sizeof (s)-1), (const unsigned char *) &o, (sizeof (o)-1));
+ }
+ }
+}
+
+
+/*
+ checkEndName - if module does not have, name, then issue an error containing, desc.
+*/
+
+static void checkEndName (decl_node module, nameKey_Name name, const char *desc_, unsigned int _desc_high)
+{
+ DynamicStrings_String s;
+ char desc[_desc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (desc, desc_, _desc_high+1);
+
+ if ((decl_getSymName (module)) != name)
+ {
+ s = DynamicStrings_InitString ((const char *) "inconsistent module name found with this ", 41);
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) desc, _desc_high)));
+ ErrorString (s);
+ }
+}
+
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ unsigned int n;
+ DynamicStrings_String str;
+ DynamicStrings_String message;
+
+ n = 0;
+ message = DynamicStrings_InitString ((const char *) "", 0);
+ if ((((1 << (mcReserved_stringtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "string", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_realtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "real number", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_identtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_integertok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "integer number", 14)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_inlinetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__INLINE__", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_builtintok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__BUILTIN__", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_attributetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__ATTRIBUTE__", 13)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_filetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__FILE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_linetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__LINE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_datetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "__DATE__", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "...", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_volatiletok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VOLATILE", 8)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_asmtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ASM", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_withtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WITH", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_whiletok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "WHILE", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_vartok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "VAR", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_untiltok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNTIL", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_typetok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TYPE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_totok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "TO", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_thentok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "THEN", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_settok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "SET", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_returntok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETURN", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_retrytok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RETRY", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_repeattok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REPEAT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_remtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "REM", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_recordtok-mcReserved_recordtok)) & (stopset2)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "RECORD", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_unqualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "UNQUALIFIED", 11)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "QUALIFIED", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_proceduretok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PROCEDURE", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_pointertok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "POINTER", 7)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_packedsettok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "PACKEDSET", 9)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ortok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OR", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_oftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "OF", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_nottok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "NOT", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_moduletok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MODULE", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_modtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MOD", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_looptok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "LOOP", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_intok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IN", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_importtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPORT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_implementationtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IMPLEMENTATION", 14)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_iftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "IF", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_fromtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FROM", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_fortok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FOR", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_finallytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FINALLY", 7)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_exporttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXPORT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_exittok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXIT", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_excepttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "EXCEPT", 6)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_endtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "END", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_elsiftok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSIF", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_elsetok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ELSE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_dotok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DO", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_divtok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DIV", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_definitiontok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "DEFINITION", 10)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_consttok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CONST", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_casetok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "CASE", 4)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_bytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BY", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_begintok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BEGIN", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_arraytok-mcReserved_arraytok)) & (stopset1)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "ARRAY", 5)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_andtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "AND", 3)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_colontok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodperiodtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "..", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*>", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<*", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lessequaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<>", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_hashtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "#", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_equaltok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_uparrowtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "^", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_semicolontok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ";", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_commatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ",", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_periodtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "&", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_dividetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "/", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_timestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "*", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_minustok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "-", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_plustok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "+", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_doublequotestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ',');
+ n += 1;
+ }
+ if ((((1 << (mcReserved_singlequotetok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ',');
+ n += 1;
+ }
+ if ((((1 << (mcReserved_greatertok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lesstok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rparatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lparatok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rcbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lcbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_rsbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_lsbratok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_bartok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_becomestok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2)));
+ n += 1;
+ }
+ if ((((1 << (mcReserved_eoftok-mcReserved_eoftok)) & (stopset0)) != 0))
+ {} /* empty. */
+ /* eoftok has no token name (needed to generate error messages) */
+ if (n == 0)
+ {
+ str = DynamicStrings_InitString ((const char *) " syntax error", 13);
+ message = DynamicStrings_KillString (message);
+ }
+ else if (n == 1)
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message);
+ message = DynamicStrings_KillString (message);
+ }
+ return str;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void)
+{
+ DynamicStrings_String str;
+
+ str = DynamicStrings_InitString ((const char *) "", 0);
+ switch (mcLexBuf_currenttoken)
+ {
+ case mcReserved_stringtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found string", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_realtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found real number", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_identtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_integertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found integer number", 34), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_inlinetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __INLINE__", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_builtintok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __BUILTIN__", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_attributetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __ATTRIBUTE__", 33), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_filetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __FILE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_linetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __LINE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_datetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found __DATE__", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodperiodperiodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ...", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_volatiletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VOLATILE", 28), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_asmtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ASM", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_withtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WITH", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_whiletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found WHILE", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_vartok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found VAR", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_untiltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNTIL", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_typetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TYPE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_totok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found TO", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_thentok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found THEN", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_settok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found SET", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_returntok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETURN", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_retrytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RETRY", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_repeattok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REPEAT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_remtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found REM", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_recordtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found RECORD", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_unqualifiedtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found UNQUALIFIED", 31), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_qualifiedtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found QUALIFIED", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_proceduretok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PROCEDURE", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_pointertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found POINTER", 27), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_packedsettok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found PACKEDSET", 29), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ortok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OR", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_oftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found OF", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_nottok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found NOT", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_moduletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MODULE", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_modtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found MOD", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_looptok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found LOOP", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_intok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IN", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_importtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPORT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_implementationtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IMPLEMENTATION", 34), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_iftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found IF", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_fromtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FROM", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_fortok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FOR", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_finallytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FINALLY", 27), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_exporttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXPORT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_exittok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXIT", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_excepttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found EXCEPT", 26), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_endtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found END", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_elsiftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSIF", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_elsetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ELSE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_dotok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DO", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_divtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DIV", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_definitiontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found DEFINITION", 30), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_consttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CONST", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_casetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found CASE", 24), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_bytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BY", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_begintok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BEGIN", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_arraytok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ARRAY", 25), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_andtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found AND", 23), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_colontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodperiodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ..", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rdirectivetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *>", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ldirectivetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <*", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_greaterequaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lessequaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lessgreatertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <>", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_hashtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found #", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_equaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_uparrowtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ^", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_semicolontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ;", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_commatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ,", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_periodtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found .", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_ambersandtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found &", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_dividetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found /", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_timestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found *", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_minustok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found -", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_plustok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found +", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_doublequotestok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_singlequotetok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_greatertok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lesstok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rcbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lcbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_rsbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_lsbratok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_bartok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_becomestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case mcReserved_eoftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str));
+ break;
+
+
+ default:
+ break;
+ }
+ ErrorString (str);
+}
+
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ DescribeError ();
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "\\nskipping token *** ", 21);
+ }
+ /*
+ yes the ORD(currenttoken) looks ugly, but it is *much* safer than
+ using currenttoken<sometok as a change to the ordering of the
+ token declarations below would cause this to break. Using ORD() we are
+ immune from such changes
+ */
+ while (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0)))))
+ {
+ mcLexBuf_getToken ();
+ }
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) " ***\\n", 6);
+ }
+}
+
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ /* and again (see above re: ORD)
+ */
+ if (! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0)))))
+ {
+ SyntaxError (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*/
+
+static void WarnMissingToken (mcReserved_toktype t)
+{
+ mcp5_SetOfStop0 s0;
+ mcp5_SetOfStop1 s1;
+ mcp5_SetOfStop2 s2;
+ DynamicStrings_String str;
+
+ s0 = (mcp5_SetOfStop0) 0;
+ s1 = (mcp5_SetOfStop1) 0;
+ s2 = (mcp5_SetOfStop2) 0;
+ if ( ((unsigned int) (t)) < 32)
+ {
+ s0 = (mcp5_SetOfStop0) ((1 << (t-mcReserved_eoftok)));
+ }
+ else if ( ((unsigned int) (t)) < 64)
+ {
+ /* avoid dangling else. */
+ s1 = (mcp5_SetOfStop1) ((1 << (t-mcReserved_arraytok)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ s2 = (mcp5_SetOfStop2) ((1 << (t-mcReserved_recordtok)));
+ }
+ str = DescribeStop (s0, s1, s2);
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error,", 13), DynamicStrings_Mark (str));
+ mcError_errorStringAt (str, mcLexBuf_getTokenNo ());
+}
+
+
+/*
+ MissingToken - generates a warning message about a missing token, t.
+*/
+
+static void MissingToken (mcReserved_toktype t)
+{
+ WarnMissingToken (t);
+ if ((((t != mcReserved_identtok) && (t != mcReserved_integertok)) && (t != mcReserved_realtok)) && (t != mcReserved_stringtok))
+ {
+ if (Debugging)
+ {
+ mcPrintf_printf0 ((const char *) "inserting token\\n", 17);
+ }
+ mcLexBuf_insertToken (t);
+ }
+}
+
+
+/*
+ CheckAndInsert -
+*/
+
+static unsigned int CheckAndInsert (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0))))
+ {
+ WarnMissingToken (t);
+ mcLexBuf_insertTokenAndRewind (t);
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InStopSet
+*/
+
+static unsigned int InStopSet (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (((( ((unsigned int) (t)) < 32) && ((((1 << (t-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (t)) >= 32) && ( ((unsigned int) (t)) < 64)) && ((((1 << (t-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (t)) >= 64) && ((((1 << (t-mcReserved_recordtok)) & (stopset2)) != 0))))
+ {
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
+ If it is not then it will insert a token providing the token
+ is one of ; ] ) } . OF END ,
+
+ if the stopset contains <identtok> then we do not insert a token
+*/
+
+static void PeepToken (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ /* and again (see above re: ORD)
+ */
+ if ((! (((( ((unsigned int) (mcLexBuf_currenttoken)) < 32) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & (stopset0)) != 0))) || ((( ((unsigned int) (mcLexBuf_currenttoken)) >= 32) && ( ((unsigned int) (mcLexBuf_currenttoken)) < 64)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & (stopset1)) != 0)))) || (( ((unsigned int) (mcLexBuf_currenttoken)) >= 64) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & (stopset2)) != 0))))) && (! (InStopSet (mcReserved_identtok, stopset0, stopset1, stopset2))))
+ {
+ /* SyntaxCheck would fail since currentoken is not part of the stopset
+ we check to see whether any of currenttoken might be a commonly omitted token */
+ if ((((((((CheckAndInsert (mcReserved_semicolontok, stopset0, stopset1, stopset2)) || (CheckAndInsert (mcReserved_rsbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rparatok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_rcbratok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_periodtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_oftok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_endtok, stopset0, stopset1, stopset2))) || (CheckAndInsert (mcReserved_commatok, stopset0, stopset1, stopset2)))
+ {} /* empty. */
+ }
+}
+
+
+/*
+ Expect -
+*/
+
+static void Expect (mcReserved_toktype t, mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == t)
+ {
+ /* avoid dangling else. */
+ mcLexBuf_getToken ();
+ if (Pass1)
+ {
+ PeepToken (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ MissingToken (t);
+ }
+ SyntaxCheck (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ curident = nameKey_makekey (mcLexBuf_currentstring);
+ Expect (mcReserved_identtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ string -
+*/
+
+static void string (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ curstring = nameKey_makekey (mcLexBuf_currentstring);
+ Expect (mcReserved_stringtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Integer -
+*/
+
+static void Integer (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ n = push (decl_makeLiteralInt (nameKey_makekey (mcLexBuf_currentstring)));
+ Expect (mcReserved_integertok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Real -
+*/
+
+static void Real (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ n = push (decl_makeLiteralReal (nameKey_makekey (mcLexBuf_currentstring)));
+ Expect (mcReserved_realtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FileUnit := DefinitionModule |
+ ImplementationOrProgramModule
+
+ first symbols:implementationtok, moduletok, definitiontok
+
+ cannot reachend
+*/
+
+static void FileUnit (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_definitiontok)
+ {
+ DefinitionModule (stopset0, stopset1, stopset2);
+ }
+ else if (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_implementationtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ ImplementationOrProgramModule (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IMPLEMENTATION MODULE DEFINITION", 50);
+ }
+}
+
+
+/*
+ ProgramModule := 'MODULE' Ident
+ % curmodule := lookupModule (curident) %
+
+ % addCommentBody (curmodule) %
+
+ % enterScope (curmodule) %
+
+ % resetConstExpPos (curmodule) %
+ [ Priority ] ';' { Import } Block
+ Ident
+ % checkEndName (curmodule, curident, 'program module') %
+
+ % leaveScope %
+ '.'
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ProgramModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ curmodule = decl_lookupModule (curident);
+ decl_addCommentBody (curmodule);
+ decl_enterScope (curmodule);
+ decl_resetConstExpPos (curmodule);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ Block (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "program module", 14);
+ decl_leaveScope ();
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImplementationModule := 'IMPLEMENTATION' 'MODULE'
+ Ident
+ % curmodule := lookupImp (curident) %
+
+ % addCommentBody (curmodule) %
+
+ % enterScope (lookupDef (curident)) %
+
+ % enterScope (curmodule) %
+
+ % resetConstExpPos (curmodule) %
+ [ Priority ] ';' { Import }
+ Block Ident
+ % checkEndName (curmodule, curident, 'implementation module') %
+
+ % leaveScope ; leaveScope %
+ '.'
+
+ first symbols:implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_implementationtok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ curmodule = decl_lookupImp (curident);
+ decl_addCommentBody (curmodule);
+ decl_enterScope (decl_lookupDef (curident));
+ decl_enterScope (curmodule);
+ decl_resetConstExpPos (curmodule);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ Block (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "implementation module", 21);
+ decl_leaveScope ();
+ decl_leaveScope ();
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImplementationOrProgramModule := ImplementationModule |
+ ProgramModule
+
+ first symbols:moduletok, implementationtok
+
+ cannot reachend
+*/
+
+static void ImplementationOrProgramModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_implementationtok)
+ {
+ ImplementationModule (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ ProgramModule (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: MODULE IMPLEMENTATION", 39);
+ }
+}
+
+
+/*
+ ConstInteger := Integer
+ % VAR i: node ; %
+
+ % i := pop () %
+
+
+ first symbols:integertok
+
+ cannot reachend
+*/
+
+static void ConstInteger (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node i;
+
+ Integer (stopset0, stopset1, stopset2);
+ i = pop ();
+}
+
+
+/*
+ ConstReal := Real
+ % VAR r: node ; %
+
+ % r := pop () %
+
+
+ first symbols:realtok
+
+ cannot reachend
+*/
+
+static void ConstReal (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node r;
+
+ Real (stopset0, stopset1, stopset2);
+ r = pop ();
+}
+
+
+/*
+ ConstNumber := ConstInteger | ConstReal
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void ConstNumber (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_integertok)
+ {
+ ConstInteger (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_realtok)
+ {
+ /* avoid dangling else. */
+ ConstReal (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: real number integer number", 44);
+ }
+}
+
+
+/*
+ Number := Integer | Real
+
+ first symbols:realtok, integertok
+
+ cannot reachend
+*/
+
+static void Number (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_integertok)
+ {
+ Integer (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_realtok)
+ {
+ /* avoid dangling else. */
+ Real (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: real number integer number", 44);
+ }
+}
+
+
+/*
+ Qualident := Ident { '.' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Qualident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ConstantDeclaration := Ident '=' ConstExpressionNop
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ConstantDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_equaltok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstExpressionNop :=
+ % VAR c: node ; %
+
+ % c := getNextConstExp () %
+ SimpleConstExpr [ Relation
+ SimpleConstExpr ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpressionNop (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node c;
+
+ c = decl_getNextConstExp ();
+ SimpleConstExpr (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SimpleConstExpr (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ConstExpression :=
+ % VAR c: node ; %
+
+ % c := push (getNextConstExp ()) %
+ SimpleConstExpr [ Relation SimpleConstExpr ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node c;
+
+ c = push (decl_getNextConstExp ());
+ SimpleConstExpr (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ SimpleConstExpr (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Relation := '=' | '#' | '<>' | '<' | '<=' |
+ '>' | '>=' | 'IN'
+
+ first symbols:intok, greaterequaltok, greatertok, lessequaltok, lesstok, lessgreatertok, hashtok, equaltok
+
+ cannot reachend
+*/
+
+static void Relation (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_hashtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_hashtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessgreatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessgreatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lessequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lessequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greatertok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_greaterequaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_greaterequaltok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_intok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_intok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IN >= > <= < <> # =", 37);
+ }
+}
+
+
+/*
+ SimpleConstExpr := UnaryOrConstTerm { AddOperator
+ ConstTerm }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleConstExpr (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ UnaryOrConstTerm (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ AddOperator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ UnaryOrConstTerm := '+' ConstTerm |
+ '-' ConstTerm |
+ ConstTerm
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrConstTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ ConstTerm (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( integer number real number __ATTRIBUTE__ identifier { string - +", 88);
+ }
+}
+
+
+/*
+ AddOperator := '+' | '-' | 'OR'
+
+ first symbols:ortok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void AddOperator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ortok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ortok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: OR - +", 24);
+ }
+}
+
+
+/*
+ ConstTerm := ConstFactor { MulOperator ConstFactor }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void ConstTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ ConstFactor (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ MulOperator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstFactor (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ }
+ /* while */
+}
+
+
+/*
+ MulOperator := '*' | '/' | 'DIV' | 'MOD' |
+ 'REM' | 'AND' | '&'
+
+ first symbols:ambersandtok, andtok, remtok, modtok, divtok, dividetok, timestok
+
+ cannot reachend
+*/
+
+static void MulOperator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_timestok)
+ {
+ Expect (mcReserved_timestok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_dividetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_dividetok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_divtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_divtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_modtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_modtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_remtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_remtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_andtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_andtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_ambersandtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_ambersandtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: & AND REM MOD DIV / *", 39);
+ }
+}
+
+
+/*
+ NotConstFactor := 'NOT' ConstFactor
+ % VAR n: node ; %
+
+ % n := push (makeUnaryTok (nottok, pop ())) %
+
+
+ first symbols:nottok
+
+ cannot reachend
+*/
+
+static void NotConstFactor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Expect (mcReserved_nottok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstFactor (stopset0, stopset1, stopset2);
+ n = push (decl_makeUnaryTok (mcReserved_nottok, pop ()));
+}
+
+
+/*
+ ConstFactor := ConstNumber | ConstString |
+ ConstSetOrQualidentOrFunction |
+ '(' ConstExpressionNop ')' |
+ NotConstFactor |
+ ConstAttribute
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void ConstFactor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ ConstNumber (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ ConstString (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ ConstSetOrQualidentOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ NotConstFactor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ ConstAttribute (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ NOT ( identifier { string integer number real number", 84);
+ }
+}
+
+
+/*
+ ConstString := string
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void ConstString (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ string (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstComponentElement := ConstExpressionNop [ '..'
+ ConstExpressionNop ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstComponentElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ConstComponentValue := ConstComponentElement [ 'BY'
+ ConstExpressionNop ]
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ConstComponentValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ ConstComponentElement (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ConstArraySetRecordValue := ConstComponentValue
+ { ',' ConstComponentValue }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstArraySetRecordValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ ConstComponentValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstComponentValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ConstConstructor := '{' [ ConstArraySetRecordValue ]
+ '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void ConstConstructor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lcbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ ConstArraySetRecordValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstSetOrQualidentOrFunction := Qualident [ ConstConstructor |
+ ConstActualParameters ] |
+ ConstConstructor
+
+ first symbols:lcbratok, identtok
+
+ cannot reachend
+*/
+
+static void ConstSetOrQualidentOrFunction (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ ConstConstructor (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ ConstActualParameters (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( {", 21);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ /* avoid dangling else. */
+ ConstConstructor (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: { identifier", 30);
+ }
+}
+
+
+/*
+ ConstActualParameters := '(' [ ConstExpList ] ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ConstActualParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))))) != 0))))
+ {
+ ConstExpList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstExpList := ConstExpressionNop { ',' ConstExpressionNop }
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ConstExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ConstAttribute := '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' ConstAttributeExpression
+ ')' ')'
+
+ first symbols:attributetok
+
+ cannot reachend
+*/
+
+static void ConstAttribute (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lesstok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ConstAttributeExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ConstAttributeExpression := Ident | '<' Qualident
+ ',' Ident '>'
+
+ first symbols:lesstok, identtok
+
+ cannot reachend
+*/
+
+static void ConstAttributeExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lesstok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_greatertok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_greatertok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: < identifier", 30);
+ }
+}
+
+
+/*
+ ByteAlignment := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void ByteAlignment (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ AttributeExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ OptAlignmentExpression := [ AlignmentExpression ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void OptAlignmentExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ AlignmentExpression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AlignmentExpression := '(' ConstExpressionNop ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void AlignmentExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Alignment := [ ByteAlignment ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void Alignment (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ ByteAlignment (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ IdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void IdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SubrangeType := '[' ConstExpressionNop '..' ConstExpressionNop
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void SubrangeType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ArrayType := 'ARRAY' SimpleType { ',' SimpleType }
+ 'OF' Type
+
+ first symbols:arraytok
+
+ cannot reachend
+*/
+
+static void ArrayType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_arraytok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ Expect (mcReserved_oftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RecordType := 'RECORD' [ DefaultRecordAttributes ]
+ FieldListSequence 'END'
+
+ first symbols:recordtok
+
+ cannot reachend
+*/
+
+static void RecordType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_recordtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ DefaultRecordAttributes (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ FieldListSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefaultRecordAttributes := ''
+
+ first symbols:ldirectivetok
+
+ cannot reachend
+*/
+
+static void DefaultRecordAttributes (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ AttributeExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ RecordFieldPragma := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void RecordFieldPragma (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldPragmaExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldPragmaExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FieldPragmaExpression := Ident PragmaConstExpression
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FieldPragmaExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ PragmaConstExpression (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ PragmaConstExpression := [ '(' ConstExpressionNop
+ ')' ]
+
+ first symbols:lparatok
+
+ reachend
+*/
+
+static void PragmaConstExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AttributeExpression := Ident '(' ConstExpressionNop
+ ')'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AttributeExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FieldListSequence := FieldListStatement { ';' FieldListStatement }
+
+ first symbols:casetok, identtok, semicolontok
+
+ reachend
+*/
+
+static void FieldListSequence (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ FieldListStatement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListStatement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ FieldListStatement := [ FieldList ]
+
+ first symbols:identtok, casetok
+
+ reachend
+*/
+
+static void FieldListStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_casetok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ FieldList (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FieldList := IdentList ':' Type RecordFieldPragma |
+ 'CASE' CaseTag 'OF' Varient { '|' Varient }
+ [ 'ELSE' FieldListSequence ] 'END'
+
+ first symbols:casetok, identtok
+
+ cannot reachend
+*/
+
+static void FieldList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ RecordFieldPragma (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_casetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_casetok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ CaseTag (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Varient (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_bartok)
+ {
+ Expect (mcReserved_bartok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Varient (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ Expect (mcReserved_elsetok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: CASE identifier", 33);
+ }
+}
+
+
+/*
+ TagIdent := Ident |
+ % curident := NulName %
+
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TagIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ curident = nameKey_NulName;
+ }
+}
+
+
+/*
+ CaseTag := TagIdent [ ':' Qualident ]
+
+ first symbols:colontok, identtok
+
+ reachend
+*/
+
+static void CaseTag (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ TagIdent (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ Varient := [ VarientCaseLabelList ':' FieldListSequence ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Varient (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))))
+ {
+ VarientCaseLabelList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_casetok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FieldListSequence (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ VarientCaseLabelList := VarientCaseLabels { ','
+ VarientCaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabelList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ VarientCaseLabels (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ VarientCaseLabels (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ VarientCaseLabels := ConstExpressionNop [ '..' ConstExpressionNop ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void VarientCaseLabels (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ SetType := ( 'SET' | 'PACKEDSET' ) 'OF' SimpleType
+
+ first symbols:oftok, packedsettok, settok
+
+ cannot reachend
+*/
+
+static void SetType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_settok)
+ {
+ Expect (mcReserved_settok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_packedsettok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_packedsettok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PACKEDSET SET", 31);
+ }
+ Expect (mcReserved_oftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ SimpleType (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ PointerType := 'POINTER' 'TO' Type
+
+ first symbols:pointertok
+
+ cannot reachend
+*/
+
+static void PointerType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_pointertok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok))));
+ Expect (mcReserved_totok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureType := 'PROCEDURE' [ FormalTypeList ]
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ FormalTypeList (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FormalTypeList := '(' ( ')' FormalReturn |
+ ProcedureParameters ')'
+ FormalReturn )
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalTypeList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_rparatok)
+ {
+ Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ ProcedureParameters (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ FormalReturn (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: VAR ... ARRAY identifier )", 44);
+ }
+}
+
+
+/*
+ FormalReturn := [ ':' OptReturnType ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void FormalReturn (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ OptReturnType (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ OptReturnType := '[' Qualident ']' |
+ Qualident
+
+ first symbols:identtok, lsbratok
+
+ cannot reachend
+*/
+
+static void OptReturnType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Qualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ Qualident (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier [", 30);
+ }
+}
+
+
+/*
+ ProcedureParameters := ProcedureParameter { ','
+ ProcedureParameter }
+
+ first symbols:identtok, arraytok, periodperiodperiodtok, vartok
+
+ cannot reachend
+*/
+
+static void ProcedureParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ ProcedureParameter (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureParameter (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ProcedureParameter := '...' | 'VAR' FormalType |
+ FormalType
+
+ first symbols:arraytok, identtok, vartok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ProcedureParameter (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_arraytok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ FormalType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ARRAY identifier VAR ...", 42);
+ }
+}
+
+
+/*
+ VarIdent := Ident [ '[' ConstExpressionNop ']' ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Expect (mcReserved_lsbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ VarIdentList := VarIdent { ',' VarIdent }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VarIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ VarIdent (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ VarIdent (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ VariableDeclaration := VarIdentList ':' Type Alignment
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void VariableDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ VarIdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Designator := PushQualident { SubDesignator }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Designator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ PushQualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0)))
+ {
+ SubDesignator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ SubDesignator :=
+ % VAR n, field, type: node ; %
+
+ % n := peep () %
+
+ % IF n = NIL
+ THEN
+ ErrorArray ('no expression found') ;
+ flushErrors ;
+ RETURN
+ END %
+
+ % type := skipType (getType (n)) %
+ ( '.' Ident
+ % IF isRecord (type)
+ THEN
+ field := lookupInScope (type, curident) ;
+ IF field = NIL
+ THEN
+ metaError2 ('field {%1k} cannot be found in record {%2ad}', curident, type)
+ ELSE
+ n := replace (makeComponentRef (n, field))
+ END
+ ELSE
+ metaError2 ('attempting to access a field {%1k} from {%2ad} which does not have a record type', curident, type)
+ END %
+ | '[' ArrayExpList
+ % IF isArray (type)
+ THEN
+ n := replace (makeArrayRef (n, pop ()))
+ ELSE
+ metaError1 ('attempting to access an array but the expression is not an array but a {%1d}', type)
+ END %
+ ']' | SubPointer )
+
+ first symbols:uparrowtok, lsbratok, periodtok
+
+ cannot reachend
+*/
+
+static void SubDesignator (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+ decl_node field;
+ decl_node type;
+
+ n = peep ();
+ if (n == NULL)
+ {
+ ErrorArray ((const char *) "no expression found", 19);
+ mcError_flushErrors ();
+ return ;
+ }
+ type = decl_skipType (decl_getType (n));
+ if (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+ if (decl_isRecord (type))
+ {
+ field = decl_lookupInScope (type, curident);
+ if (field == NULL)
+ {
+ mcMetaError_metaError2 ((const char *) "field {%1k} cannot be found in record {%2ad}", 44, (const unsigned char *) &curident, (sizeof (curident)-1), (const unsigned char *) &type, (sizeof (type)-1));
+ }
+ else
+ {
+ n = replace (decl_makeComponentRef (n, field));
+ }
+ }
+ else
+ {
+ mcMetaError_metaError2 ((const char *) "attempting to access a field {%1k} from {%2ad} which does not have a record type", 80, (const unsigned char *) &curident, (sizeof (curident)-1), (const unsigned char *) &type, (sizeof (type)-1));
+ }
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lsbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ArrayExpList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (decl_isArray (type))
+ {
+ n = replace (decl_makeArrayRef (n, pop ()));
+ }
+ else
+ {
+ mcMetaError_metaError1 ((const char *) "attempting to access an array but the expression is not an array but a {%1d}", 76, (const unsigned char *) &type, (sizeof (type)-1));
+ }
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_uparrowtok)
+ {
+ /* avoid dangling else. */
+ SubPointer (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ^ [ .", 23);
+ }
+}
+
+
+/*
+ SubPointer :=
+ % VAR n, field, type: node ; %
+
+ % n := peep () %
+
+ % type := skipType (getType (n)) %
+ '^' ( '.' Ident
+ % IF isPointer (type)
+ THEN
+ type := skipType (getType (type)) ;
+ IF isRecord (type)
+ THEN
+ field := lookupInScope (type, curident) ;
+ IF field = NIL
+ THEN
+ metaError2 ('field {%1k} cannot be found in record {%2ad}', curident, type)
+ ELSE
+ n := replace (makePointerRef (n, field))
+ END
+ ELSE
+ metaError2 ('attempting to access a field {%1k} from {%2ad} which does not have a record type', curident, type)
+ END
+ ELSE
+ metaError2 ('trying to dereference {%1k} which was not declared as a pointer but a {%2tad}', n, n)
+ END %
+ |
+ % IF isPointer (type)
+ THEN
+ n := replace (makeDeRef (n))
+ ELSE
+ metaError1 ('attempting to dereference a pointer but the expression is not a pointer but a {%1d}', type)
+ END %
+ )
+
+ first symbols:uparrowtok
+
+ cannot reachend
+*/
+
+static void SubPointer (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+ decl_node field;
+ decl_node type;
+
+ n = peep ();
+ type = decl_skipType (decl_getType (n));
+ Expect (mcReserved_uparrowtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+ if (decl_isPointer (type))
+ {
+ type = decl_skipType (decl_getType (type));
+ if (decl_isRecord (type))
+ {
+ field = decl_lookupInScope (type, curident);
+ if (field == NULL)
+ {
+ mcMetaError_metaError2 ((const char *) "field {%1k} cannot be found in record {%2ad}", 44, (const unsigned char *) &curident, (sizeof (curident)-1), (const unsigned char *) &type, (sizeof (type)-1));
+ }
+ else
+ {
+ n = replace (decl_makePointerRef (n, field));
+ }
+ }
+ else
+ {
+ mcMetaError_metaError2 ((const char *) "attempting to access a field {%1k} from {%2ad} which does not have a record type", 80, (const unsigned char *) &curident, (sizeof (curident)-1), (const unsigned char *) &type, (sizeof (type)-1));
+ }
+ }
+ else
+ {
+ mcMetaError_metaError2 ((const char *) "trying to dereference {%1k} which was not declared as a pointer but a {%2tad}", 77, (const unsigned char *) &n, (sizeof (n)-1), (const unsigned char *) &n, (sizeof (n)-1));
+ }
+ }
+ else
+ {
+ if (decl_isPointer (type))
+ {
+ n = replace (decl_makeDeRef (n));
+ }
+ else
+ {
+ mcMetaError_metaError1 ((const char *) "attempting to dereference a pointer but the expression is not a pointer but a {%1d}", 83, (const unsigned char *) &type, (sizeof (type)-1));
+ }
+ }
+}
+
+
+/*
+ ArrayExpList :=
+ % VAR l: node ; %
+
+ % l := push (makeExpList ()) %
+ Expression
+ % putExpList (l, pop ()) %
+
+ % assert (isExpList (peep ())) %
+ { ',' Expression
+ % putExpList (l, pop ()) %
+
+ % assert (isExpList (peep ())) %
+ }
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArrayExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node l;
+
+ l = push (decl_makeExpList ());
+ Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_putExpList (l, pop ());
+ mcDebug_assert (decl_isExpList (peep ()));
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_putExpList (l, pop ());
+ mcDebug_assert (decl_isExpList (peep ()));
+ }
+ /* while */
+}
+
+
+/*
+ ExpList :=
+ % VAR p, n: node ; %
+
+ % p := peep () %
+
+ % assert (isExpList (p)) %
+ Expression
+ % putExpList (p, pop ()) %
+
+ % assert (isExpList (peep ())) %
+ { ',' Expression
+ % putExpList (p, pop ()) %
+
+ % assert (isExpList (peep ())) %
+ }
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ExpList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node p;
+ decl_node n;
+
+ p = peep ();
+ mcDebug_assert (decl_isExpList (p));
+ Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_putExpList (p, pop ());
+ mcDebug_assert (decl_isExpList (peep ()));
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_putExpList (p, pop ());
+ mcDebug_assert (decl_isExpList (peep ()));
+ }
+ /* while */
+}
+
+
+/*
+ Expression :=
+ % VAR c, l, r: node ; op: toktype ; %
+ SimpleExpression
+ % op := currenttoken %
+ [ Relation
+ % l := pop () %
+ SimpleExpression
+ % r := pop () %
+
+ % r := push (makeBinaryTok (op, l, r)) %
+ ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void Expression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node c;
+ decl_node l;
+ decl_node r;
+ mcReserved_toktype op;
+
+ SimpleExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_greaterequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_intok-mcReserved_arraytok))), stopset2);
+ op = mcLexBuf_currenttoken;
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_hashtok-mcReserved_eoftok)) | (1 << (mcReserved_lessgreatertok-mcReserved_eoftok)) | (1 << (mcReserved_lesstok-mcReserved_eoftok)) | (1 << (mcReserved_lessequaltok-mcReserved_eoftok)) | (1 << (mcReserved_greatertok-mcReserved_eoftok)) | (1 << (mcReserved_greaterequaltok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_intok))
+ {
+ Relation (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ l = pop ();
+ SimpleExpression (stopset0, stopset1, stopset2);
+ r = pop ();
+ r = push (decl_makeBinaryTok (op, l, r));
+ }
+}
+
+
+/*
+ SimpleExpression :=
+ % VAR op: toktype ; n: node ; %
+ UnaryOrTerm {
+ % op := currenttoken %
+
+ % n := pop () %
+ AddOperator Term
+
+ % n := push (makeBinaryTok (op, n, pop ())) %
+ }
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void SimpleExpression (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ mcReserved_toktype op;
+ decl_node n;
+
+ UnaryOrTerm (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ while (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_ortok))
+ {
+ op = mcLexBuf_currenttoken;
+ n = pop ();
+ AddOperator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_ortok-mcReserved_arraytok))), stopset2);
+ n = push (decl_makeBinaryTok (op, n, pop ()));
+ }
+ /* while */
+}
+
+
+/*
+ UnaryOrTerm :=
+ % VAR n: node ; %
+ '+' Term
+ % n := push (makeUnaryTok (plustok, pop ())) %
+ | '-' Term
+ % n := push (makeUnaryTok (minustok, pop ())) %
+ | Term
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void UnaryOrTerm (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ if (mcLexBuf_currenttoken == mcReserved_plustok)
+ {
+ Expect (mcReserved_plustok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0, stopset1, stopset2);
+ n = push (decl_makeUnaryTok (mcReserved_plustok, pop ()));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_minustok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_minustok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Term (stopset0, stopset1, stopset2);
+ n = push (decl_makeUnaryTok (mcReserved_minustok, pop ()));
+ }
+ else if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ /* avoid dangling else. */
+ Term (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( string integer number real number { identifier - +", 74);
+ }
+}
+
+
+/*
+ Term :=
+ % VAR op: toktype ; n: node ; %
+ Factor {
+ % op := currenttoken %
+ MulOperator
+ % n := pop () %
+ Factor
+ % n := push (makeBinaryTok (op, n, pop ())) %
+ }
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok
+
+ cannot reachend
+*/
+
+static void Term (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ mcReserved_toktype op;
+ decl_node n;
+
+ Factor (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ambersandtok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_timestok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_modtok-mcReserved_arraytok)) | (1 << (mcReserved_divtok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ while ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))))) != 0))) || (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))))) != 0)))) || (mcLexBuf_currenttoken == mcReserved_remtok))
+ {
+ op = mcLexBuf_currenttoken;
+ MulOperator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ n = pop ();
+ Factor (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_timestok-mcReserved_eoftok)) | (1 << (mcReserved_dividetok-mcReserved_eoftok)) | (1 << (mcReserved_andtok-mcReserved_eoftok)) | (1 << (mcReserved_ambersandtok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_divtok-mcReserved_arraytok)) | (1 << (mcReserved_modtok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_remtok-mcReserved_recordtok))));
+ n = push (decl_makeBinaryTok (op, n, pop ()));
+ }
+ /* while */
+}
+
+
+/*
+ PushString := string
+ % VAR n: node ; %
+
+ % n := push (makeString (curstring)) %
+
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void PushString (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ string (stopset0, stopset1, stopset2);
+ n = push (decl_makeString (curstring));
+}
+
+
+/*
+ Factor := Number | PushString | SetOrDesignatorOrFunction |
+ '(' Expression ')' |
+ 'NOT' ( Factor
+ % VAR n: node ; %
+
+ % n := push (makeUnaryTok (nottok, pop ())) %
+ | ConstAttribute
+ % n := push (makeUnaryTok (nottok, pop ())) %
+ )
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok
+
+ cannot reachend
+*/
+
+static void Factor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok))))) != 0)))
+ {
+ Number (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ /* avoid dangling else. */
+ PushString (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken == mcReserved_lcbratok) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ /* avoid dangling else. */
+ SetOrDesignatorOrFunction (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_nottok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_nottok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ Factor (stopset0, stopset1, stopset2);
+ n = push (decl_makeUnaryTok (mcReserved_nottok, pop ()));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ /* avoid dangling else. */
+ ConstAttribute (stopset0, stopset1, stopset2);
+ n = push (decl_makeUnaryTok (mcReserved_nottok, pop ()));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __ATTRIBUTE__ real number integer number string ( NOT { identifier", 84);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: NOT ( { identifier string integer number real number", 70);
+ }
+}
+
+
+/*
+ ComponentElement := Expression
+ % VAR l, h, n: node ; %
+
+ % l := pop () %
+
+ % h := NIL %
+ [ '..' Expression
+ % h := pop () %
+
+ % ErrorArray ('implementation restriction range is not allowed') %
+ ]
+ % n := push (includeSetValue (pop (), l, h)) %
+
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ComponentElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node l;
+ decl_node h;
+ decl_node n;
+
+ Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ l = pop ();
+ h = static_cast<decl_node> (NULL);
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+ h = pop ();
+ ErrorArray ((const char *) "implementation restriction range is not allowed", 47);
+ }
+ n = push (decl_includeSetValue (pop (), l, h));
+}
+
+
+/*
+ ComponentValue := ComponentElement [ 'BY'
+ % ErrorArray ('implementation restriction BY not allowed') %
+ Expression ]
+
+ first symbols:identtok, lcbratok, nottok, lparatok, stringtok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void ComponentValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ ComponentElement (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ErrorArray ((const char *) "implementation restriction BY not allowed", 41);
+ Expression (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ArraySetRecordValue := ComponentValue { ',' ComponentValue }
+
+ first symbols:identtok, lcbratok, realtok, integertok, stringtok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void ArraySetRecordValue (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ ComponentValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ComponentValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ Constructor := '{'
+ % VAR n: node ; %
+
+ % n := push (makeSetValue ()) %
+ [ ArraySetRecordValue ] '}'
+
+ first symbols:lcbratok
+
+ cannot reachend
+*/
+
+static void Constructor (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Expect (mcReserved_lcbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ n = push (decl_makeSetValue ());
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ ArraySetRecordValue (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rcbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rcbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SetOrDesignatorOrFunction := PushQualident
+ % VAR q, p, n: node ; %
+ [ Constructor
+ % p := pop () %
+
+ % q := pop () %
+
+ % n := push (putSetValue (p, q)) %
+ | SimpleDes [
+ % q := pop () %
+ ActualParameters
+
+ % p := pop () %
+
+ % p := push (makeFuncCall (q, p)) %
+ ] ] |
+ Constructor
+
+ first symbols:identtok, lcbratok
+
+ cannot reachend
+*/
+
+static void SetOrDesignatorOrFunction (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node q;
+ decl_node p;
+ decl_node n;
+
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ PushQualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lcbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ Constructor (stopset0, stopset1, stopset2);
+ p = pop ();
+ q = pop ();
+ n = push (decl_putSetValue (p, q));
+ }
+ else if ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ SimpleDes (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ q = pop ();
+ ActualParameters (stopset0, stopset1, stopset2);
+ p = pop ();
+ p = push (decl_makeFuncCall (q, p));
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ( [ . ^ {", 27);
+ }
+ }
+ /* end of optional [ | ] expression */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lcbratok)
+ {
+ /* avoid dangling else. */
+ Constructor (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: { identifier", 30);
+ }
+}
+
+
+/*
+ SimpleDes := { SubDesignator }
+
+ first symbols:uparrowtok, periodtok, lsbratok
+
+ reachend
+*/
+
+static void SimpleDes (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ while ((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))))) != 0)))
+ {
+ SubDesignator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok)) | (1 << (mcReserved_uparrowtok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ ActualParameters := '('
+ % VAR n: node ; %
+
+ % n := push (makeExpList ()) %
+ [ ExpList ] ')'
+ % assert (isExpList (peep ())) %
+
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void ActualParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ n = push (decl_makeExpList ());
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ ExpList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ mcDebug_assert (decl_isExpList (peep ()));
+}
+
+
+/*
+ ExitStatement :=
+ % VAR n: node ; %
+ 'EXIT'
+ % IF loopNo = 0
+ THEN
+ ErrorArray ('EXIT can only be used inside a LOOP statement')
+ ELSE
+ n := pushStmt (makeExit (peepLoop (), loopNo))
+ END %
+
+
+ first symbols:exittok
+
+ cannot reachend
+*/
+
+static void ExitStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ Expect (mcReserved_exittok, stopset0, stopset1, stopset2);
+ if (loopNo == 0)
+ {
+ ErrorArray ((const char *) "EXIT can only be used inside a LOOP statement", 45);
+ }
+ else
+ {
+ n = pushStmt (decl_makeExit (peepLoop (), loopNo));
+ }
+}
+
+
+/*
+ ReturnStatement :=
+ % VAR n: node ; %
+
+ % n := pushStmt (makeReturn ()) %
+ 'RETURN' [ Expression
+ % putReturn (n, pop ()) %
+ ]
+ % addCommentBody (peepStmt ()) %
+
+ % addCommentAfter (peepStmt ()) %
+
+ % assert (isReturn (peepStmt ())) %
+
+
+ first symbols:returntok
+
+ cannot reachend
+*/
+
+static void ReturnStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node n;
+
+ n = pushStmt (decl_makeReturn ());
+ Expect (mcReserved_returntok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ Expression (stopset0, stopset1, stopset2);
+ decl_putReturn (n, pop ());
+ }
+ decl_addCommentBody (peepStmt ());
+ decl_addCommentAfter (peepStmt ());
+ mcDebug_assert (decl_isReturn (peepStmt ()));
+}
+
+
+/*
+ Statement := ( AssignmentOrProcedureCall |
+ IfStatement | CaseStatement |
+ WhileStatement |
+ RepeatStatement |
+ LoopStatement | ForStatement |
+ WithStatement | AsmStatement |
+ ExitStatement | ReturnStatement |
+ RetryStatement |
+
+ % VAR s: node ; %
+
+ % s := pushStmt (NIL) %
+ )
+
+ first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok
+
+ reachend
+*/
+
+static void Statement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node s;
+
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ AssignmentOrProcedureCall (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_iftok)
+ {
+ /* avoid dangling else. */
+ IfStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_casetok)
+ {
+ /* avoid dangling else. */
+ CaseStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_whiletok)
+ {
+ /* avoid dangling else. */
+ WhileStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_repeattok)
+ {
+ /* avoid dangling else. */
+ RepeatStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_looptok)
+ {
+ /* avoid dangling else. */
+ LoopStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_fortok)
+ {
+ /* avoid dangling else. */
+ ForStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_withtok)
+ {
+ /* avoid dangling else. */
+ WithStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_asmtok)
+ {
+ /* avoid dangling else. */
+ AsmStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_exittok)
+ {
+ /* avoid dangling else. */
+ ExitStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_returntok)
+ {
+ /* avoid dangling else. */
+ ReturnStatement (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_retrytok)
+ {
+ /* avoid dangling else. */
+ RetryStatement (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ s = pushStmt (static_cast<decl_node> (NULL));
+ }
+}
+
+
+/*
+ RetryStatement :=
+ % VAR s: node ; %
+
+ % s := pushStmt (makeComment ("retry")) %
+ 'RETRY'
+
+ first symbols:retrytok
+
+ cannot reachend
+*/
+
+static void RetryStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node s;
+
+ s = pushStmt (decl_makeComment ((const char *) "retry", 5));
+ Expect (mcReserved_retrytok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AssignmentOrProcedureCall :=
+ % VAR d, a, p: node ; %
+ Designator
+ % d := pop () %
+ ( ':=' Expression
+ % a := pushStmt (makeAssignment (d, pop ())) %
+ |
+ ActualParameters
+
+ % a := pushStmt (makeFuncCall (d, pop ())) %
+ |
+
+ % a := pushStmt (makeFuncCall (d, NIL)) %
+ )
+ % addCommentBody (peepStmt ()) %
+
+ % addCommentAfter (peepStmt ()) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void AssignmentOrProcedureCall (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node d;
+ decl_node a;
+ decl_node p;
+
+ Designator (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ d = pop ();
+ if (mcLexBuf_currenttoken == mcReserved_becomestok)
+ {
+ Expect (mcReserved_becomestok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+ a = pushStmt (decl_makeAssignment (d, pop ()));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ ActualParameters (stopset0, stopset1, stopset2);
+ a = pushStmt (decl_makeFuncCall (d, pop ()));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ a = pushStmt (decl_makeFuncCall (d, static_cast<decl_node> (NULL)));
+ }
+ decl_addCommentBody (peepStmt ());
+ decl_addCommentAfter (peepStmt ());
+}
+
+
+/*
+ StatementSequence :=
+ % VAR s, t: node ; %
+
+ % s := pushStmt (makeStatementSequence ()) %
+
+ % assert (isStatementSequence (peepStmt ())) %
+ Statement
+ % addStatement (s, popStmt ()) %
+
+ % assert (isStatementSequence (peepStmt ())) %
+ { ';' Statement
+ % addStatement (s, popStmt ()) %
+
+ % assert (isStatementSequence (peepStmt ())) %
+ }
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok
+
+ reachend
+*/
+
+static void StatementSequence (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node s;
+ decl_node t;
+
+ s = pushStmt (decl_makeStatementSequence ());
+ mcDebug_assert (decl_isStatementSequence (peepStmt ()));
+ Statement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_addStatement (s, popStmt ());
+ mcDebug_assert (decl_isStatementSequence (peepStmt ()));
+ while (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Statement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_addStatement (s, popStmt ());
+ mcDebug_assert (decl_isStatementSequence (peepStmt ()));
+ }
+ /* while */
+}
+
+
+/*
+ IfStatement :=
+ % VAR i, a, b: node ; %
+ 'IF'
+ % b := makeCommentS (getBodyComment ()) %
+ Expression
+ % a := makeCommentS (getAfterComment ()) %
+ 'THEN' StatementSequence
+ % i := pushStmt (makeIf (pop (), popStmt ())) %
+
+ % addIfComments (i, b, a) %
+ { 'ELSIF'
+ % b := makeCommentS (getBodyComment ()) %
+ Expression
+ % a := makeCommentS (getAfterComment ()) %
+ 'THEN'
+ % addElseComments (peepStmt (), b, a) %
+ StatementSequence
+ % i := makeElsif (i, pop (), popStmt ()) %
+ } [ 'ELSE' StatementSequence
+ % putElse (i, popStmt ()) %
+ ] 'END'
+ % b := makeCommentS (getBodyComment ()) %
+
+ % a := makeCommentS (getAfterComment ()) %
+
+ % assert (isIf (peepStmt ())) %
+
+ % addIfEndComments (peepStmt (), b, a) %
+
+
+ first symbols:iftok
+
+ cannot reachend
+*/
+
+static void IfStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node i;
+ decl_node a;
+ decl_node b;
+
+ Expect (mcReserved_iftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ b = decl_makeCommentS (mcLexBuf_getBodyComment ());
+ Expression (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok))));
+ a = decl_makeCommentS (mcLexBuf_getAfterComment ());
+ Expect (mcReserved_thentok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ i = pushStmt (decl_makeIf (pop (), popStmt ()));
+ decl_addIfComments (i, b, a);
+ while (mcLexBuf_currenttoken == mcReserved_elsiftok)
+ {
+ Expect (mcReserved_elsiftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ b = decl_makeCommentS (mcLexBuf_getBodyComment ());
+ Expression (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_thentok-mcReserved_recordtok))));
+ a = decl_makeCommentS (mcLexBuf_getAfterComment ());
+ Expect (mcReserved_thentok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ decl_addElseComments (peepStmt (), b, a);
+ StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_elsiftok-mcReserved_arraytok))), stopset2);
+ i = decl_makeElsif (i, pop (), popStmt ());
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ Expect (mcReserved_elsetok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ decl_putElse (i, popStmt ());
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ b = decl_makeCommentS (mcLexBuf_getBodyComment ());
+ a = decl_makeCommentS (mcLexBuf_getAfterComment ());
+ mcDebug_assert (decl_isIf (peepStmt ()));
+ decl_addIfEndComments (peepStmt (), b, a);
+}
+
+
+/*
+ CaseStatement :=
+ % VAR s, e: node ; %
+
+ % s := pushStmt (makeCase ()) %
+ 'CASE' Expression
+ % s := putCaseExpression (s, pop ()) %
+ 'OF' Case { '|' Case } CaseEndStatement
+
+ first symbols:casetok
+
+ cannot reachend
+*/
+
+static void CaseStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node s;
+ decl_node e;
+
+ s = pushStmt (decl_makeCase ());
+ Expect (mcReserved_casetok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ s = decl_putCaseExpression (s, pop ());
+ Expect (mcReserved_oftok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Case (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_bartok)
+ {
+ Expect (mcReserved_bartok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok)) | (1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ Case (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_bartok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_elsetok-mcReserved_arraytok))), stopset2);
+ }
+ /* while */
+ CaseEndStatement (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ CaseEndStatement :=
+ % VAR c: node ; %
+ 'END' | 'ELSE'
+ % c := peepStmt () %
+ StatementSequence
+ % c := putCaseElse (c, popStmt ()) %
+ 'END'
+
+ first symbols:elsetok, endtok
+
+ cannot reachend
+*/
+
+static void CaseEndStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node c;
+
+ if (mcLexBuf_currenttoken == mcReserved_endtok)
+ {
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_elsetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_elsetok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ c = peepStmt ();
+ StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ c = decl_putCaseElse (c, popStmt ());
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ELSE END", 26);
+ }
+}
+
+
+/*
+ Case := [ CaseLabelList ':'
+ % VAR l, c: node ; %
+
+ % l := pop () %
+
+ % c := peepStmt () %
+ StatementSequence
+ % c := putCaseStatement (c, l, popStmt ()) %
+ ]
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ reachend
+*/
+
+static void Case (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node l;
+ decl_node c;
+
+ if ((((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_nottok)) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0))))
+ {
+ CaseLabelList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ l = pop ();
+ c = peepStmt ();
+ StatementSequence (stopset0, stopset1, stopset2);
+ c = decl_putCaseStatement (c, l, popStmt ());
+ }
+}
+
+
+/*
+ CaseLabelList :=
+ % VAR l: node ; %
+
+ % l := push (makeCaseList ()) %
+ CaseLabels { ',' CaseLabels }
+
+ first symbols:attributetok, identtok, lcbratok, stringtok, nottok, lparatok, integertok, realtok, minustok, plustok
+
+ cannot reachend
+*/
+
+static void CaseLabelList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node l;
+
+ l = push (decl_makeCaseList ());
+ CaseLabels (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))));
+ CaseLabels (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ CaseLabels :=
+ % VAR lo, hi, l: node ; %
+
+ % lo := NIL ; hi := NIL %
+
+ % l := peep () %
+ ConstExpression
+ % lo := pop () %
+ [ '..' ConstExpression
+ % hi := pop () %
+ ]
+ % l := putCaseRange (l, lo, hi) %
+
+
+ first symbols:stringtok, lcbratok, identtok, attributetok, realtok, integertok, lparatok, nottok, plustok, minustok
+
+ cannot reachend
+*/
+
+static void CaseLabels (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node lo;
+ decl_node hi;
+ decl_node l;
+
+ lo = static_cast<decl_node> (NULL);
+ hi = static_cast<decl_node> (NULL);
+ l = peep ();
+ ConstExpression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodperiodtok-mcReserved_eoftok))), stopset1, stopset2);
+ lo = pop ();
+ if (mcLexBuf_currenttoken == mcReserved_periodperiodtok)
+ {
+ Expect (mcReserved_periodperiodtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1, stopset2);
+ hi = pop ();
+ }
+ l = decl_putCaseRange (l, lo, hi);
+}
+
+
+/*
+ WhileStatement :=
+ % VAR s, w, e, a, b: node ; %
+
+ % w := pushStmt (makeWhile ()) %
+ 'WHILE' Expression 'DO'
+ % b := makeCommentS (getBodyComment ()) %
+
+ % a := makeCommentS (getAfterComment ()) %
+
+ % addWhileDoComment (w, b, a) %
+
+ % e := pop () %
+ StatementSequence
+ % s := popStmt () %
+ 'END'
+ % assert (isStatementSequence (peepStmt ())) %
+
+ % putWhile (w, e, s) %
+
+ % b := makeCommentS (getBodyComment ()) %
+
+ % a := makeCommentS (getAfterComment ()) %
+
+ % addWhileEndComment (w, b, a) %
+
+
+ first symbols:whiletok
+
+ cannot reachend
+*/
+
+static void WhileStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node s;
+ decl_node w;
+ decl_node e;
+ decl_node a;
+ decl_node b;
+
+ w = pushStmt (decl_makeWhile ());
+ Expect (mcReserved_whiletok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_dotok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ b = decl_makeCommentS (mcLexBuf_getBodyComment ());
+ a = decl_makeCommentS (mcLexBuf_getAfterComment ());
+ decl_addWhileDoComment (w, b, a);
+ e = pop ();
+ StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ s = popStmt ();
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ /* assert (isStatementSequence (peepStmt ())) */
+ decl_putWhile (w, e, s);
+ b = decl_makeCommentS (mcLexBuf_getBodyComment ());
+ a = decl_makeCommentS (mcLexBuf_getAfterComment ());
+ decl_addWhileEndComment (w, b, a);
+}
+
+
+/*
+ RepeatStatement :=
+ % VAR r, s, a, b: node ; %
+
+ % r := pushStmt (makeRepeat ()) %
+ 'REPEAT'
+ % b := makeCommentS (getBodyComment ()) %
+
+ % a := makeCommentS (getAfterComment ()) %
+
+ % addRepeatComment (r, b, a) %
+ StatementSequence
+ % s := popStmt () %
+ 'UNTIL' Expression
+ % putRepeat (r, s, pop ()) %
+
+ % b := makeCommentS (getBodyComment ()) %
+
+ % a := makeCommentS (getAfterComment ()) %
+
+ % addUntilComment (r, b, a) %
+
+
+ first symbols:repeattok
+
+ cannot reachend
+*/
+
+static void RepeatStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node r;
+ decl_node s;
+ decl_node a;
+ decl_node b;
+
+ r = pushStmt (decl_makeRepeat ());
+ Expect (mcReserved_repeattok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_untiltok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ b = decl_makeCommentS (mcLexBuf_getBodyComment ());
+ a = decl_makeCommentS (mcLexBuf_getAfterComment ());
+ decl_addRepeatComment (r, b, a);
+ StatementSequence (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_untiltok-mcReserved_recordtok))));
+ s = popStmt ();
+ Expect (mcReserved_untiltok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2);
+ decl_putRepeat (r, s, pop ());
+ b = decl_makeCommentS (mcLexBuf_getBodyComment ());
+ a = decl_makeCommentS (mcLexBuf_getAfterComment ());
+ decl_addUntilComment (r, b, a);
+}
+
+
+/*
+ ForStatement :=
+ % VAR f, i, s, e, b: node ; %
+
+ % b := NIL %
+
+ % f := pushStmt (makeFor ()) %
+ 'FOR' Ident
+ % i := lookupWithSym (curident) %
+ ':=' Expression
+ % s := pop () %
+ 'TO' Expression
+ % e := pop () %
+ [ 'BY' ConstExpression
+ % b := pop () %
+ ] 'DO' StatementSequence
+ % putFor (f, i, s, e, b, popStmt ()) %
+ 'END'
+
+ first symbols:fortok
+
+ cannot reachend
+*/
+
+static void ForStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node f;
+ decl_node i;
+ decl_node s;
+ decl_node e;
+ decl_node b;
+
+ b = static_cast<decl_node> (NULL);
+ f = pushStmt (decl_makeFor ());
+ Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_becomestok-mcReserved_eoftok))), stopset1, stopset2);
+ i = lookupWithSym (curident);
+ Expect (mcReserved_becomestok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_totok-mcReserved_recordtok))));
+ s = pop ();
+ Expect (mcReserved_totok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_bytok-mcReserved_arraytok)) | (1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ e = pop ();
+ if (mcLexBuf_currenttoken == mcReserved_bytok)
+ {
+ Expect (mcReserved_bytok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpression (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ b = pop ();
+ }
+ Expect (mcReserved_dotok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ decl_putFor (f, i, s, e, b, popStmt ());
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ LoopStatement :=
+ % VAR l, s: node ; %
+ 'LOOP'
+ % l := pushStmt (pushLoop (makeLoop ())) %
+
+ % INC (loopNo) %
+ StatementSequence
+ % s := popStmt () %
+
+ % putLoop (l, s) %
+
+ % DEC (loopNo) %
+ 'END'
+ % l := popLoop () %
+
+ % assert (isLoop (peepStmt ())) %
+
+
+ first symbols:looptok
+
+ cannot reachend
+*/
+
+static void LoopStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node l;
+ decl_node s;
+
+ Expect (mcReserved_looptok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ l = pushStmt (pushLoop (decl_makeLoop ()));
+ loopNo += 1;
+ StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ s = popStmt ();
+ decl_putLoop (l, s);
+ loopNo -= 1;
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ l = popLoop ();
+ mcDebug_assert (decl_isLoop (peepStmt ()));
+}
+
+
+/*
+ WithStatement := 'WITH' Designator 'DO'
+ % startWith (pop ()) %
+ StatementSequence 'END'
+ % endWith %
+
+
+ first symbols:withtok
+
+ cannot reachend
+*/
+
+static void WithStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_withtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Designator (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_dotok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_dotok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ startWith (pop ());
+ StatementSequence (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+ endWith ();
+}
+
+
+/*
+ ProcedureDeclaration := ProcedureHeading ';' ProcedureBlock
+ Ident
+ % leaveScope %
+
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ ProcedureHeading (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ ProcedureBlock (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+ decl_leaveScope ();
+}
+
+
+/*
+ ProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+ % enterScope (curproc) %
+
+ % setProcedureComment (lastcomment, curident) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ProcedureIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Ident (stopset0, stopset1, stopset2);
+ curproc = decl_lookupSym (curident);
+ decl_enterScope (curproc);
+ mcComment_setProcedureComment (mcLexBuf_lastcomment, curident);
+}
+
+
+/*
+ DefProcedureIdent := Ident
+ % curproc := lookupSym (curident) %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefProcedureIdent (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Ident (stopset0, stopset1, stopset2);
+ curproc = decl_lookupSym (curident);
+}
+
+
+/*
+ DefineBuiltinProcedure := [ '__ATTRIBUTE__' '__BUILTIN__'
+ '(' '(' Ident ')' ')' |
+ '__INLINE__' ]
+
+ first symbols:inlinetok, attributetok
+
+ reachend
+*/
+
+static void DefineBuiltinProcedure (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_attributetok)
+ {
+ Expect (mcReserved_attributetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_builtintok-mcReserved_recordtok))));
+ Expect (mcReserved_builtintok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_inlinetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __INLINE__ __ATTRIBUTE__", 42);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ ProcedureHeading := 'PROCEDURE' DefineBuiltinProcedure
+ ( ProcedureIdent [ FormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void ProcedureHeading (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefineBuiltinProcedure (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureIdent (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ FormalParameters (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ AttributeNoReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Builtin := [ '__BUILTIN__' | '__INLINE__' ]
+
+ first symbols:inlinetok, builtintok
+
+ reachend
+*/
+
+static void Builtin (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ /* seen optional [ | ] expression */
+ if (mcLexBuf_currenttoken == mcReserved_builtintok)
+ {
+ Expect (mcReserved_builtintok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_inlinetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_inlinetok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: __INLINE__ __BUILTIN__", 40);
+ }
+ }
+ /* end of optional [ | ] expression */
+}
+
+
+/*
+ DefProcedureHeading := 'PROCEDURE' Builtin ( DefProcedureIdent
+ [ DefFormalParameters ]
+ AttributeNoReturn )
+
+ first symbols:proceduretok
+
+ cannot reachend
+*/
+
+static void DefProcedureHeading (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_proceduretok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_inlinetok-mcReserved_recordtok)) | (1 << (mcReserved_builtintok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Builtin (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ DefProcedureIdent (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ DefFormalParameters (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ AttributeNoReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ProcedureBlock := { Declaration } [ 'BEGIN' ProcedureBlockBody ]
+ 'END'
+
+ first symbols:proceduretok, moduletok, consttok, typetok, vartok, endtok, begintok
+
+ cannot reachend
+*/
+
+static void ProcedureBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Declaration (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_begintok)
+ {
+ Expect (mcReserved_begintok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ProcedureBlockBody (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ }
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Block := { Declaration } InitialBlock FinalBlock
+ 'END'
+
+ first symbols:proceduretok, moduletok, finallytok, begintok, consttok, typetok, vartok, endtok
+
+ cannot reachend
+*/
+
+static void Block (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Declaration (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ InitialBlock (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok))), stopset2);
+ FinalBlock (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ InitialBlock := [ 'BEGIN' InitialBlockBody ]
+
+ first symbols:begintok
+
+ reachend
+*/
+
+static void InitialBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_begintok)
+ {
+ Expect (mcReserved_begintok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ InitialBlockBody (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FinalBlock := [ 'FINALLY' FinalBlockBody ]
+
+ first symbols:finallytok
+
+ reachend
+*/
+
+static void FinalBlock (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_finallytok)
+ {
+ Expect (mcReserved_finallytok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok)) | (1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FinalBlockBody (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ InitialBlockBody := NormalPart
+ % putBegin (curmodule, popStmt ()) %
+ [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void InitialBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ decl_putBegin (curmodule, popStmt ());
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ FinalBlockBody := NormalPart
+ % putFinally (curmodule, popStmt ()) %
+ [ 'EXCEPT' ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void FinalBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ NormalPart (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ decl_putFinally (curmodule, popStmt ());
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ProcedureBlockBody := ProcedureNormalPart [ 'EXCEPT'
+ ExceptionalPart ]
+
+ first symbols:identtok, iftok, casetok, whiletok, repeattok, looptok, fortok, withtok, asmtok, retrytok, semicolontok, exittok, returntok, excepttok
+
+ reachend
+*/
+
+static void ProcedureBlockBody (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ ProcedureNormalPart (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_excepttok-mcReserved_arraytok))), stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_excepttok)
+ {
+ Expect (mcReserved_excepttok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_exittok-mcReserved_arraytok)) | (1 << (mcReserved_fortok-mcReserved_arraytok)) | (1 << (mcReserved_looptok-mcReserved_arraytok)) | (1 << (mcReserved_casetok-mcReserved_arraytok)) | (1 << (mcReserved_iftok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_returntok-mcReserved_recordtok)) | (1 << (mcReserved_retrytok-mcReserved_recordtok)) | (1 << (mcReserved_asmtok-mcReserved_recordtok)) | (1 << (mcReserved_withtok-mcReserved_recordtok)) | (1 << (mcReserved_repeattok-mcReserved_recordtok)) | (1 << (mcReserved_whiletok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ExceptionalPart (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ ProcedureNormalPart := StatementSequence
+ % putBegin (curproc, popStmt ()) %
+
+
+ first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ProcedureNormalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ StatementSequence (stopset0, stopset1, stopset2);
+ decl_putBegin (curproc, popStmt ());
+}
+
+
+/*
+ NormalPart := StatementSequence
+
+ first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void NormalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ StatementSequence (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ExceptionalPart := StatementSequence
+
+ first symbols:identtok, retrytok, asmtok, withtok, fortok, looptok, repeattok, whiletok, casetok, iftok, returntok, exittok, semicolontok
+
+ reachend
+*/
+
+static void ExceptionalPart (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ StatementSequence (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Declaration := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ ProcedureDeclaration ';' |
+ ModuleDeclaration ';'
+
+ first symbols:moduletok, proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Declaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_consttok)
+ {
+ Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ ConstantDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_typetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ TypeDeclaration (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ VariableDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_moduletok)
+ {
+ /* avoid dangling else. */
+ ModuleDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: MODULE PROCEDURE VAR TYPE CONST", 49);
+ }
+}
+
+
+/*
+ DefFormalParameters := '('
+ % paramEnter (curproc) %
+ [ DefMultiFPSection ] ')'
+
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void DefFormalParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ decl_paramEnter (curproc);
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ DefMultiFPSection (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_paramLeave (curproc);
+ FormalReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AttributeNoReturn := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeNoReturn (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AttributeUnused := [ '' ]
+
+ first symbols:ldirectivetok
+
+ reachend
+*/
+
+static void AttributeUnused (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ Expect (mcReserved_ldirectivetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rdirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rdirectivetok, stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ DefMultiFPSection := DefExtendedFP |
+ FPSection [ ';' DefMultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefMultiFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok))
+ {
+ DefExtendedFP (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ FPSection (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ DefMultiFPSection (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38);
+ }
+}
+
+
+/*
+ FormalParameters := '('
+ % paramEnter (curproc) %
+ [ MultiFPSection ] ')'
+ % paramLeave (curproc) %
+ FormalReturn
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void FormalParameters (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ decl_paramEnter (curproc);
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))))) != 0))))
+ {
+ MultiFPSection (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ decl_paramLeave (curproc);
+ FormalReturn (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ MultiFPSection := ExtendedFP | FPSection [ ';'
+ MultiFPSection ]
+
+ first symbols:identtok, vartok, lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void MultiFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok))
+ {
+ ExtendedFP (stopset0, stopset1, stopset2);
+ }
+ else if ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0)))
+ {
+ /* avoid dangling else. */
+ FPSection (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_periodperiodperiodtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ MultiFPSection (stopset0, stopset1, stopset2);
+ }
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier VAR ... [", 38);
+ }
+}
+
+
+/*
+ FPSection := NonVarFPSection |
+ VarFPSection
+
+ first symbols:vartok, identtok
+
+ cannot reachend
+*/
+
+static void FPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ NonVarFPSection (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ VarFPSection (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: VAR identifier", 32);
+ }
+}
+
+
+/*
+ DefExtendedFP := DefOptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void DefExtendedFP (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ DefOptArg (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ... [", 23);
+ }
+}
+
+
+/*
+ ExtendedFP := OptArg | '...'
+
+ first symbols:lsbratok, periodperiodperiodtok
+
+ cannot reachend
+*/
+
+static void ExtendedFP (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ OptArg (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_periodperiodperiodtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_periodperiodperiodtok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: ... [", 23);
+ }
+}
+
+
+/*
+ VarFPSection := 'VAR' IdentList ':' FormalType [
+ AttributeUnused ]
+
+ first symbols:vartok
+
+ cannot reachend
+*/
+
+static void VarFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ AttributeUnused (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ NonVarFPSection := IdentList ':' FormalType [ AttributeUnused ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void NonVarFPSection (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_ldirectivetok)
+ {
+ AttributeUnused (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ OptArg := '[' Ident ':' FormalType [ '=' ConstExpressionNop ]
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void OptArg (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok)) | (1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ Expect (mcReserved_equaltok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ DefOptArg := '[' Ident ':' FormalType '=' ConstExpressionNop
+ ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void DefOptArg (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_colontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FormalType (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_equaltok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FormalType := { 'ARRAY' 'OF' } Qualident
+
+ first symbols:identtok, arraytok
+
+ cannot reachend
+*/
+
+static void FormalType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ while (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ Expect (mcReserved_arraytok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_oftok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_oftok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ Qualident (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ModuleDeclaration := 'MODULE' Ident [ Priority ]
+ ';' { Import } [ Export ]
+ Block Ident
+
+ first symbols:moduletok
+
+ cannot reachend
+*/
+
+static void ModuleDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_moduletok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ Priority (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_exporttok)
+ {
+ Export (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_begintok-mcReserved_arraytok)) | (1 << (mcReserved_finallytok-mcReserved_arraytok)) | (1 << (mcReserved_moduletok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ }
+ Block (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Priority := '[' ConstExpressionNop ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void Priority (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_attributetok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok)) | (1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ ConstExpressionNop (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Export := 'EXPORT' ( 'QUALIFIED' IdentList |
+ 'UNQUALIFIED' IdentList |
+ IdentList ) ';'
+
+ first symbols:exporttok
+
+ cannot reachend
+*/
+
+static void Export (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_exporttok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_qualifiedtok-mcReserved_arraytok)) | (1 << (mcReserved_unqualifiedtok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_qualifiedtok)
+ {
+ Expect (mcReserved_qualifiedtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_unqualifiedtok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_unqualifiedtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ /* avoid dangling else. */
+ IdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: identifier UNQUALIFIED QUALIFIED", 50);
+ }
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ FromIdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void FromIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ FromImport := 'FROM' Ident 'IMPORT' FromIdentList
+ ';'
+
+ first symbols:fromtok
+
+ cannot reachend
+*/
+
+static void FromImport (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_fromtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ FromIdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ ImportModuleList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void ImportModuleList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ WithoutFromImport := 'IMPORT' ImportModuleList ';'
+
+ first symbols:importtok
+
+ cannot reachend
+*/
+
+static void WithoutFromImport (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_importtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ ImportModuleList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ Import := FromImport | WithoutFromImport
+
+ first symbols:importtok, fromtok
+
+ cannot reachend
+*/
+
+static void Import (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_fromtok)
+ {
+ FromImport (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_importtok)
+ {
+ /* avoid dangling else. */
+ WithoutFromImport (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: IMPORT FROM", 29);
+ }
+}
+
+
+/*
+ DefinitionModule := 'DEFINITION' 'MODULE' [ 'FOR'
+ string ]
+ Ident ';'
+ % curmodule := lookupDef (curident) %
+
+ % enterScope (curmodule) %
+ { Import } [ Export ] { Definition }
+ 'END' Ident '.'
+ % checkEndName (curmodule, curident, 'definition module') %
+
+ % leaveScope %
+
+
+ first symbols:definitiontok
+
+ cannot reachend
+*/
+
+static void DefinitionModule (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_definitiontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_moduletok-mcReserved_arraytok))), stopset2);
+ Expect (mcReserved_moduletok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_fortok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_fortok)
+ {
+ Expect (mcReserved_fortok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_vartok-mcReserved_recordtok)) | (1 << (mcReserved_typetok-mcReserved_recordtok))));
+ curmodule = decl_lookupDef (curident);
+ decl_enterScope (curmodule);
+ while (((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok))))) != 0)))
+ {
+ Import (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_exporttok-mcReserved_arraytok)) | (1 << (mcReserved_fromtok-mcReserved_arraytok)) | (1 << (mcReserved_importtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ if (mcLexBuf_currenttoken == mcReserved_exporttok)
+ {
+ Export (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ while ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))))) != 0))) || ((mcLexBuf_currenttoken >= mcReserved_recordtok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_recordtok)) & ((mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))))) != 0))))
+ {
+ Definition (stopset0, stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_endtok-mcReserved_arraytok)) | (1 << (mcReserved_consttok-mcReserved_arraytok)) | (1 << (mcReserved_proceduretok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_typetok-mcReserved_recordtok)) | (1 << (mcReserved_vartok-mcReserved_recordtok))));
+ }
+ /* while */
+ Expect (mcReserved_endtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2);
+ checkEndName (curmodule, curident, (const char *) "definition module", 17);
+ decl_leaveScope ();
+}
+
+
+/*
+ PushQualident :=
+ % VAR type, field: node ; %
+ Ident
+ % qualid := push (lookupWithSym (curident)) %
+
+ % IF qualid = NIL
+ THEN
+ metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident)
+ END %
+ [ '.'
+ % IF NOT isQualident (qualid)
+ THEN
+ ErrorArray ('the first component of this qualident must be a definition module or a parameter/variable/constant which has record type')
+ END %
+ Ident
+ % IF isDef (qualid)
+ THEN
+ qualid := replace (lookupInScope (qualid, curident))
+ ELSE
+ type := skipType (getType (qualid)) ;
+ field := lookupInScope (type, curident) ;
+ IF field = NIL
+ THEN
+ metaError2 ('field {%1k} cannot be found in {%2ad}', curident, qualid)
+ ELSE
+ qualid := replace (makeComponentRef (qualid, field))
+ END
+ END ;
+ IF qualid = NIL
+ THEN
+ metaError1 ('qualified component of the identifier {%1k} cannot be found', curident)
+ END %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void PushQualident (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node type;
+ decl_node field;
+
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_periodtok-mcReserved_eoftok))), stopset1, stopset2);
+ qualid = push (lookupWithSym (curident));
+ if (qualid == NULL)
+ {
+ mcMetaError_metaError1 ((const char *) "the symbol {%1k} is not visible in this scope (or any other nested scope)", 73, (const unsigned char *) &curident, (sizeof (curident)-1));
+ }
+ if (mcLexBuf_currenttoken == mcReserved_periodtok)
+ {
+ Expect (mcReserved_periodtok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ if (! (isQualident (qualid)))
+ {
+ ErrorArray ((const char *) "the first component of this qualident must be a definition module or a parameter/variable/constant which has record type", 120);
+ }
+ Ident (stopset0, stopset1, stopset2);
+ if (decl_isDef (qualid))
+ {
+ qualid = replace (decl_lookupInScope (qualid, curident));
+ }
+ else
+ {
+ type = decl_skipType (decl_getType (qualid));
+ field = decl_lookupInScope (type, curident);
+ if (field == NULL)
+ {
+ mcMetaError_metaError2 ((const char *) "field {%1k} cannot be found in {%2ad}", 37, (const unsigned char *) &curident, (sizeof (curident)-1), (const unsigned char *) &qualid, (sizeof (qualid)-1));
+ }
+ else
+ {
+ qualid = replace (decl_makeComponentRef (qualid, field));
+ }
+ }
+ if (qualid == NULL)
+ {
+ mcMetaError_metaError1 ((const char *) "qualified component of the identifier {%1k} cannot be found", 59, (const unsigned char *) &curident, (sizeof (curident)-1));
+ }
+ }
+}
+
+
+/*
+ OptSubrange := [ SubrangeType ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void OptSubrange (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ TypeEquiv := Qualident OptSubrange
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void TypeEquiv (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Qualident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ OptSubrange (stopset0, stopset1, stopset2);
+}
+
+
+/*
+ EnumIdentList := Ident { ',' Ident }
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void EnumIdentList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ Enumeration := '(' EnumIdentList ')'
+
+ first symbols:lparatok
+
+ cannot reachend
+*/
+
+static void Enumeration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ EnumIdentList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ SimpleType := TypeEquiv | Enumeration |
+ SubrangeType
+
+ first symbols:lsbratok, lparatok, identtok
+
+ cannot reachend
+*/
+
+static void SimpleType (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ TypeEquiv (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lparatok)
+ {
+ /* avoid dangling else. */
+ Enumeration (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ /* avoid dangling else. */
+ SubrangeType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: [ ( identifier", 32);
+ }
+}
+
+
+/*
+ Type := SimpleType | ArrayType | RecordType |
+ SetType | PointerType | ProcedureType
+
+ first symbols:proceduretok, pointertok, settok, packedsettok, oftok, recordtok, arraytok, identtok, lparatok, lsbratok
+
+ cannot reachend
+*/
+
+static void Type (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (((mcLexBuf_currenttoken < mcReserved_arraytok) && ((((1 << (mcLexBuf_currenttoken-mcReserved_eoftok)) & ((mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_identtok))
+ {
+ SimpleType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_arraytok)
+ {
+ /* avoid dangling else. */
+ ArrayType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_recordtok)
+ {
+ /* avoid dangling else. */
+ RecordType (stopset0, stopset1, stopset2);
+ }
+ else if ((((mcLexBuf_currenttoken >= mcReserved_arraytok) && (mcLexBuf_currenttoken < mcReserved_recordtok)) && ((((1 << (mcLexBuf_currenttoken-mcReserved_arraytok)) & ((mcp5_SetOfStop1) ((1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok))))) != 0))) || (mcLexBuf_currenttoken == mcReserved_settok))
+ {
+ /* avoid dangling else. */
+ SetType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_pointertok)
+ {
+ /* avoid dangling else. */
+ PointerType (stopset0, stopset1, stopset2);
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ ProcedureType (stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE POINTER SET PACKEDSET OF RECORD ARRAY identifier ( [", 80);
+ }
+}
+
+
+/*
+ TypeDeclaration := { Ident ( ';' | '=' Type Alignment
+ ';' ) }
+
+ first symbols:identtok
+
+ reachend
+*/
+
+static void TypeDeclaration (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok)) | (1 << (mcReserved_equaltok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_semicolontok)
+ {
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_equaltok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_equaltok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_proceduretok-mcReserved_arraytok)) | (1 << (mcReserved_pointertok-mcReserved_arraytok)) | (1 << (mcReserved_packedsettok-mcReserved_arraytok)) | (1 << (mcReserved_oftok-mcReserved_arraytok)) | (1 << (mcReserved_arraytok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_settok-mcReserved_recordtok)) | (1 << (mcReserved_recordtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Type (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_ldirectivetok-mcReserved_eoftok)) | (1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Alignment (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: = ;", 21);
+ }
+ }
+ /* while */
+}
+
+
+/*
+ Definition := 'CONST' { ConstantDeclaration ';' } |
+ 'TYPE' { TypeDeclaration } |
+ 'VAR' { VariableDeclaration ';' } |
+ DefProcedureHeading ';'
+
+ first symbols:proceduretok, vartok, typetok, consttok
+
+ cannot reachend
+*/
+
+static void Definition (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_consttok)
+ {
+ Expect (mcReserved_consttok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ ConstantDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_typetok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_typetok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ TypeDeclaration (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_vartok)
+ {
+ /* avoid dangling else. */
+ Expect (mcReserved_vartok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ while (mcLexBuf_currenttoken == mcReserved_identtok)
+ {
+ VariableDeclaration (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ }
+ /* while */
+ }
+ else if (mcLexBuf_currenttoken == mcReserved_proceduretok)
+ {
+ /* avoid dangling else. */
+ DefProcedureHeading (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_semicolontok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_semicolontok, stopset0, stopset1, stopset2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ErrorArray ((const char *) "expecting one of: PROCEDURE VAR TYPE CONST", 42);
+ }
+}
+
+
+/*
+ AsmStatement :=
+ % VAR s: node ; %
+
+ % s := pushStmt (makeComment ("asm")) %
+ 'ASM' [ 'VOLATILE' ] '(' AsmOperands
+ ')'
+
+ first symbols:asmtok
+
+ cannot reachend
+*/
+
+static void AsmStatement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ decl_node s;
+
+ s = pushStmt (decl_makeComment ((const char *) "asm", 3));
+ Expect (mcReserved_asmtok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_volatiletok-mcReserved_recordtok))));
+ if (mcLexBuf_currenttoken == mcReserved_volatiletok)
+ {
+ Expect (mcReserved_volatiletok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ Expect (mcReserved_lparatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmOperands (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AsmOperands := string [ AsmOperandSpec ]
+
+ first symbols:stringtok
+
+ cannot reachend
+*/
+
+static void AsmOperands (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ string (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ AsmOperandSpec (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AsmOperandSpec := [ ':' AsmList [ ':' AsmList [
+ ':' TrashList ] ] ]
+
+ first symbols:colontok
+
+ reachend
+*/
+
+static void AsmOperandSpec (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok)) | (1 << (mcReserved_commatok-mcReserved_eoftok)) | (1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmList (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_colontok-mcReserved_eoftok))), stopset1, stopset2);
+ if (mcLexBuf_currenttoken == mcReserved_colontok)
+ {
+ Expect (mcReserved_colontok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ TrashList (stopset0, stopset1, stopset2);
+ }
+ }
+ }
+}
+
+
+/*
+ AsmList := [ AsmElement ] { ',' AsmElement }
+
+ first symbols:lsbratok, stringtok, commatok
+
+ reachend
+*/
+
+static void AsmList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if ((mcLexBuf_currenttoken == mcReserved_lsbratok) || (mcLexBuf_currenttoken == mcReserved_stringtok))
+ {
+ AsmElement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lsbratok-mcReserved_eoftok))), stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ AsmElement (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ NamedOperand := '[' Ident ']'
+
+ first symbols:lsbratok
+
+ cannot reachend
+*/
+
+static void NamedOperand (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ Expect (mcReserved_lsbratok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Ident (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rsbratok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rsbratok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ AsmOperandName := [ NamedOperand ]
+
+ first symbols:lsbratok
+
+ reachend
+*/
+
+static void AsmOperandName (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_lsbratok)
+ {
+ NamedOperand (stopset0, stopset1, stopset2);
+ }
+}
+
+
+/*
+ AsmElement := AsmOperandName string '(' Expression
+ ')'
+
+ first symbols:stringtok, lsbratok
+
+ cannot reachend
+*/
+
+static void AsmElement (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ AsmOperandName (stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_lparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_lparatok, stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_minustok-mcReserved_eoftok)) | (1 << (mcReserved_plustok-mcReserved_eoftok)) | (1 << (mcReserved_lparatok-mcReserved_eoftok)) | (1 << (mcReserved_lcbratok-mcReserved_eoftok))), stopset1|(mcp5_SetOfStop1) ((1 << (mcReserved_nottok-mcReserved_arraytok))), stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok)) | (1 << (mcReserved_integertok-mcReserved_recordtok)) | (1 << (mcReserved_realtok-mcReserved_recordtok)) | (1 << (mcReserved_identtok-mcReserved_recordtok))));
+ Expression (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_rparatok-mcReserved_eoftok))), stopset1, stopset2);
+ Expect (mcReserved_rparatok, stopset0, stopset1, stopset2);
+}
+
+
+/*
+ TrashList := [ string ] { ',' string }
+
+ first symbols:commatok, stringtok
+
+ reachend
+*/
+
+static void TrashList (mcp5_SetOfStop0 stopset0, mcp5_SetOfStop1 stopset1, mcp5_SetOfStop2 stopset2)
+{
+ if (mcLexBuf_currenttoken == mcReserved_stringtok)
+ {
+ string (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ while (mcLexBuf_currenttoken == mcReserved_commatok)
+ {
+ Expect (mcReserved_commatok, stopset0, stopset1, stopset2|(mcp5_SetOfStop2) ((1 << (mcReserved_stringtok-mcReserved_recordtok))));
+ string (stopset0|(mcp5_SetOfStop0) ((1 << (mcReserved_commatok-mcReserved_eoftok))), stopset1, stopset2);
+ }
+ /* while */
+}
+
+
+/*
+ CompilationUnit - returns TRUE if the input was correct enough to parse
+ in future passes.
+*/
+
+extern "C" unsigned int mcp5_CompilationUnit (void)
+{
+ stk = mcStack_init ();
+ withStk = mcStack_init ();
+ stmtStk = mcStack_init ();
+ loopStk = mcStack_init ();
+ loopNo = 0;
+ WasNoError = TRUE;
+ FileUnit ((mcp5_SetOfStop0) ((1 << (mcReserved_eoftok-mcReserved_eoftok))), (mcp5_SetOfStop1) 0, (mcp5_SetOfStop2) 0);
+ mcStack_kill (&stk);
+ mcStack_kill (&withStk);
+ mcStack_kill (&stmtStk);
+ mcStack_kill (&loopStk);
+ return WasNoError;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_mcp5_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_mcp5_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from nameKey. */
+/* nameKey.mod provides a dynamic binary tree name to key.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _nameKey_H
+#define _nameKey_C
+
+# include "GSYSTEM.h"
+# include "GStorage.h"
+# include "GIndexing.h"
+# include "GStrIO.h"
+# include "GStdIO.h"
+# include "GNumberIO.h"
+# include "GStrLib.h"
+# include "Glibc.h"
+# include "GASCII.h"
+# include "GM2RTS.h"
+
+# define nameKey_NulName 0
+typedef unsigned int nameKey_Name;
+
+typedef struct nameKey__T1_r nameKey__T1;
+
+typedef char *nameKey_ptrToChar;
+
+typedef nameKey__T1 *nameKey_nameNode;
+
+typedef enum {nameKey_less, nameKey_equal, nameKey_greater} nameKey_comparison;
+
+struct nameKey__T1_r {
+ nameKey_ptrToChar data;
+ nameKey_Name key;
+ nameKey_nameNode left;
+ nameKey_nameNode right;
+ };
+
+static nameKey_nameNode binaryTree;
+static Indexing_Index keyIndex;
+static unsigned int lastIndice;
+
+/*
+ makeKey - returns the Key of the symbol, a. If a is not in the
+ name table then it is added, otherwise the Key of a is returned
+ directly. Note that the name table has no scope - it merely
+ presents a more convienient way of expressing strings. By a Key.
+*/
+
+extern "C" nameKey_Name nameKey_makeKey (const char *a_, unsigned int _a_high);
+
+/*
+ makekey - returns the Key of the symbol, a. If a is not in the
+ name table then it is added, otherwise the Key of a is returned
+ directly. Note that the name table has no scope - it merely
+ presents a more convienient way of expressing strings. By a Key.
+ These keys last for the duration of compilation.
+*/
+
+extern "C" nameKey_Name nameKey_makekey (void * a);
+
+/*
+ getKey - returns the name, a, of the key, Key.
+*/
+
+extern "C" void nameKey_getKey (nameKey_Name key, char *a, unsigned int _a_high);
+
+/*
+ lengthKey - returns the StrLen of Key.
+*/
+
+extern "C" unsigned int nameKey_lengthKey (nameKey_Name key);
+
+/*
+ isKey - returns TRUE if string, a, is currently a key.
+ We dont use the Compare function, we inline it and avoid
+ converting, a, into a String, for speed.
+*/
+
+extern "C" unsigned int nameKey_isKey (const char *a_, unsigned int _a_high);
+
+/*
+ keyToCharStar - returns the C char * string equivalent for, key.
+*/
+
+extern "C" void nameKey_writeKey (nameKey_Name key);
+
+/*
+ isSameExcludingCase - returns TRUE if key1 and key2 are
+ the same. It is case insensitive.
+ This function deliberately inlines CAP for speed.
+*/
+
+extern "C" unsigned int nameKey_isSameExcludingCase (nameKey_Name key1, nameKey_Name key2);
+
+/*
+ keyToCharStar - returns the C char * string equivalent for, key.
+*/
+
+extern "C" void * nameKey_keyToCharStar (nameKey_Name key);
+
+/*
+ doMakeKey - finds the name, n, in the tree or else create a name.
+ If a name is found then the string, n, is deallocated.
+*/
+
+static nameKey_Name doMakeKey (nameKey_ptrToChar n, unsigned int higha);
+
+/*
+ compare - return the result of Names[i] with Names[j]
+*/
+
+static nameKey_comparison compare (nameKey_ptrToChar pi, nameKey_Name j);
+
+/*
+ findNodeAndParentInTree - search BinaryTree for a name.
+ If this name is found in the BinaryTree then
+ child is set to this name and father is set to the node above.
+ A comparison is returned to assist adding entries into this tree.
+*/
+
+static nameKey_comparison findNodeAndParentInTree (nameKey_ptrToChar n, nameKey_nameNode *child, nameKey_nameNode *father);
+
+
+/*
+ doMakeKey - finds the name, n, in the tree or else create a name.
+ If a name is found then the string, n, is deallocated.
+*/
+
+static nameKey_Name doMakeKey (nameKey_ptrToChar n, unsigned int higha)
+{
+ nameKey_comparison result;
+ nameKey_nameNode father;
+ nameKey_nameNode child;
+ nameKey_Name k;
+
+ result = findNodeAndParentInTree (n, &child, &father);
+ if (child == NULL)
+ {
+ if (result == nameKey_less)
+ {
+ Storage_ALLOCATE ((void **) &child, sizeof (nameKey__T1));
+ father->left = child;
+ }
+ else if (result == nameKey_greater)
+ {
+ /* avoid dangling else. */
+ Storage_ALLOCATE ((void **) &child, sizeof (nameKey__T1));
+ father->right = child;
+ }
+ child->right = NULL;
+ child->left = NULL;
+ lastIndice += 1;
+ child->key = lastIndice;
+ child->data = n;
+ Indexing_PutIndice (keyIndex, child->key, reinterpret_cast<void *> (n));
+ k = lastIndice;
+ }
+ else
+ {
+ Storage_DEALLOCATE (reinterpret_cast<void **> (&n), higha+1);
+ k = child->key;
+ }
+ return k;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ compare - return the result of Names[i] with Names[j]
+*/
+
+static nameKey_comparison compare (nameKey_ptrToChar pi, nameKey_Name j)
+{
+ nameKey_ptrToChar pj;
+ char c1;
+ char c2;
+
+ pj = static_cast<nameKey_ptrToChar> (nameKey_keyToCharStar (j));
+ c1 = (*pi);
+ c2 = (*pj);
+ while ((c1 != ASCII_nul) || (c2 != ASCII_nul))
+ {
+ if (c1 < c2)
+ {
+ return nameKey_less;
+ }
+ else if (c1 > c2)
+ {
+ /* avoid dangling else. */
+ return nameKey_greater;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ pi += 1;
+ pj += 1;
+ c1 = (*pi);
+ c2 = (*pj);
+ }
+ }
+ return nameKey_equal;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ findNodeAndParentInTree - search BinaryTree for a name.
+ If this name is found in the BinaryTree then
+ child is set to this name and father is set to the node above.
+ A comparison is returned to assist adding entries into this tree.
+*/
+
+static nameKey_comparison findNodeAndParentInTree (nameKey_ptrToChar n, nameKey_nameNode *child, nameKey_nameNode *father)
+{
+ nameKey_comparison result;
+
+ /* firstly set up the initial values of child and father, using sentinal node */
+ (*father) = binaryTree;
+ (*child) = binaryTree->left;
+ if ((*child) == NULL)
+ {
+ return nameKey_less;
+ }
+ else
+ {
+ do {
+ result = compare (n, (*child)->key);
+ if (result == nameKey_less)
+ {
+ (*father) = (*child);
+ (*child) = (*child)->left;
+ }
+ else if (result == nameKey_greater)
+ {
+ /* avoid dangling else. */
+ (*father) = (*child);
+ (*child) = (*child)->right;
+ }
+ } while (! (((*child) == NULL) || (result == nameKey_equal)));
+ return result;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ makeKey - returns the Key of the symbol, a. If a is not in the
+ name table then it is added, otherwise the Key of a is returned
+ directly. Note that the name table has no scope - it merely
+ presents a more convienient way of expressing strings. By a Key.
+*/
+
+extern "C" nameKey_Name nameKey_makeKey (const char *a_, unsigned int _a_high)
+{
+ nameKey_ptrToChar n;
+ nameKey_ptrToChar p;
+ unsigned int i;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ Storage_ALLOCATE (reinterpret_cast<void **> (&p), higha+1);
+ if (p == NULL)
+ {
+ M2RTS_HALT (-1); /* out of memory error */
+ __builtin_unreachable ();
+ }
+ else
+ {
+ n = p;
+ i = 0;
+ while (i < higha)
+ {
+ (*p) = a[i];
+ i += 1;
+ p += 1;
+ }
+ (*p) = ASCII_nul;
+ return doMakeKey (n, higha);
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/nameKey.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ makekey - returns the Key of the symbol, a. If a is not in the
+ name table then it is added, otherwise the Key of a is returned
+ directly. Note that the name table has no scope - it merely
+ presents a more convienient way of expressing strings. By a Key.
+ These keys last for the duration of compilation.
+*/
+
+extern "C" nameKey_Name nameKey_makekey (void * a)
+{
+ nameKey_ptrToChar n;
+ nameKey_ptrToChar p;
+ nameKey_ptrToChar pa;
+ unsigned int i;
+ unsigned int higha;
+
+ if (a == NULL)
+ {
+ return nameKey_NulName;
+ }
+ else
+ {
+ higha = static_cast<unsigned int> (libc_strlen (a));
+ Storage_ALLOCATE (reinterpret_cast<void **> (&p), higha+1);
+ if (p == NULL)
+ {
+ M2RTS_HALT (-1); /* out of memory error */
+ __builtin_unreachable ();
+ }
+ else
+ {
+ n = p;
+ pa = static_cast<nameKey_ptrToChar> (a);
+ i = 0;
+ while (i < higha)
+ {
+ (*p) = (*pa);
+ i += 1;
+ p += 1;
+ pa += 1;
+ }
+ (*p) = ASCII_nul;
+ return doMakeKey (n, higha);
+ }
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/nameKey.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ getKey - returns the name, a, of the key, Key.
+*/
+
+extern "C" void nameKey_getKey (nameKey_Name key, char *a, unsigned int _a_high)
+{
+ nameKey_ptrToChar p;
+ unsigned int i;
+ unsigned int higha;
+
+ p = static_cast<nameKey_ptrToChar> (nameKey_keyToCharStar (key));
+ i = 0;
+ higha = _a_high;
+ while (((p != NULL) && (i <= higha)) && ((*p) != ASCII_nul))
+ {
+ a[i] = (*p);
+ p += 1;
+ i += 1;
+ }
+ if (i <= higha)
+ {
+ a[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ lengthKey - returns the StrLen of Key.
+*/
+
+extern "C" unsigned int nameKey_lengthKey (nameKey_Name key)
+{
+ unsigned int i;
+ nameKey_ptrToChar p;
+
+ p = static_cast<nameKey_ptrToChar> (nameKey_keyToCharStar (key));
+ i = 0;
+ while ((*p) != ASCII_nul)
+ {
+ i += 1;
+ p += 1;
+ }
+ return i;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isKey - returns TRUE if string, a, is currently a key.
+ We dont use the Compare function, we inline it and avoid
+ converting, a, into a String, for speed.
+*/
+
+extern "C" unsigned int nameKey_isKey (const char *a_, unsigned int _a_high)
+{
+ nameKey_nameNode child;
+ nameKey_ptrToChar p;
+ unsigned int i;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ /* firstly set up the initial values of child, using sentinal node */
+ child = binaryTree->left;
+ if (child != NULL)
+ {
+ do {
+ i = 0;
+ higha = _a_high;
+ p = static_cast<nameKey_ptrToChar> (nameKey_keyToCharStar (child->key));
+ while ((i <= higha) && (a[i] != ASCII_nul))
+ {
+ if (a[i] < (*p))
+ {
+ child = child->left;
+ i = higha;
+ }
+ else if (a[i] > (*p))
+ {
+ /* avoid dangling else. */
+ child = child->right;
+ i = higha;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ if ((a[i] == ASCII_nul) || (i == higha))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((*p) == ASCII_nul)
+ {
+ return TRUE;
+ }
+ else
+ {
+ child = child->left;
+ }
+ }
+ p += 1;
+ }
+ i += 1;
+ }
+ } while (! (child == NULL));
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ keyToCharStar - returns the C char * string equivalent for, key.
+*/
+
+extern "C" void nameKey_writeKey (nameKey_Name key)
+{
+ nameKey_ptrToChar s;
+
+ s = static_cast<nameKey_ptrToChar> (nameKey_keyToCharStar (key));
+ while ((s != NULL) && ((*s) != ASCII_nul))
+ {
+ StdIO_Write ((*s));
+ s += 1;
+ }
+}
+
+
+/*
+ isSameExcludingCase - returns TRUE if key1 and key2 are
+ the same. It is case insensitive.
+ This function deliberately inlines CAP for speed.
+*/
+
+extern "C" unsigned int nameKey_isSameExcludingCase (nameKey_Name key1, nameKey_Name key2)
+{
+ nameKey_ptrToChar pi;
+ nameKey_ptrToChar pj;
+ char c1;
+ char c2;
+
+ if (key1 == key2)
+ {
+ return TRUE;
+ }
+ else
+ {
+ pi = static_cast<nameKey_ptrToChar> (nameKey_keyToCharStar (key1));
+ pj = static_cast<nameKey_ptrToChar> (nameKey_keyToCharStar (key2));
+ c1 = (*pi);
+ c2 = (*pj);
+ while ((c1 != ASCII_nul) && (c2 != ASCII_nul))
+ {
+ if (((c1 == c2) || (((c1 >= 'A') && (c1 <= 'Z')) && (c2 == ((char) (( ((unsigned int) (c1))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))))))) || (((c2 >= 'A') && (c2 <= 'Z')) && (c1 == ((char) (( ((unsigned int) (c2))- ((unsigned int) ('A')))+ ((unsigned int) ('a')))))))
+ {
+ pi += 1;
+ pj += 1;
+ c1 = (*pi);
+ c2 = (*pj);
+ }
+ else
+ {
+ /* difference found */
+ return FALSE;
+ }
+ }
+ return c1 == c2;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ keyToCharStar - returns the C char * string equivalent for, key.
+*/
+
+extern "C" void * nameKey_keyToCharStar (nameKey_Name key)
+{
+ if ((key == nameKey_NulName) || (! (Indexing_InBounds (keyIndex, key))))
+ {
+ return NULL;
+ }
+ else
+ {
+ return Indexing_GetIndice (keyIndex, key);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_nameKey_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ lastIndice = 0;
+ keyIndex = Indexing_InitIndex (1);
+ Storage_ALLOCATE ((void **) &binaryTree, sizeof (nameKey__T1));
+ binaryTree->left = NULL;
+}
+
+extern "C" void _M2_nameKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from symbolKey. */
+/* symbolKey.mod provides binary tree operations for storing symbols.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _symbolKey_H
+#define _symbolKey_C
+
+# include "GStorage.h"
+# include "GStrIO.h"
+# include "GNumberIO.h"
+# include "GDebug.h"
+# include "GnameKey.h"
+
+# define symbolKey_NulKey NULL
+typedef struct symbolKey_isSymbol_p symbolKey_isSymbol;
+
+typedef struct symbolKey_performOperation_p symbolKey_performOperation;
+
+typedef struct symbolKey__T1_r symbolKey__T1;
+
+typedef symbolKey__T1 *symbolKey_symbolTree;
+
+typedef unsigned int (*symbolKey_isSymbol_t) (void *);
+struct symbolKey_isSymbol_p { symbolKey_isSymbol_t proc; };
+
+typedef void (*symbolKey_performOperation_t) (void *);
+struct symbolKey_performOperation_p { symbolKey_performOperation_t proc; };
+
+struct symbolKey__T1_r {
+ nameKey_Name name;
+ void *key;
+ symbolKey_symbolTree left;
+ symbolKey_symbolTree right;
+ };
+
+extern "C" symbolKey_symbolTree symbolKey_initTree (void);
+extern "C" void symbolKey_killTree (symbolKey_symbolTree *t);
+extern "C" void * symbolKey_getSymKey (symbolKey_symbolTree t, nameKey_Name name);
+extern "C" void symbolKey_putSymKey (symbolKey_symbolTree t, nameKey_Name name, void * key);
+
+/*
+ delSymKey - deletes an entry in the binary tree.
+
+ NB in order for this to work we must ensure that the InitTree sets
+ both left and right to NIL.
+*/
+
+extern "C" void symbolKey_delSymKey (symbolKey_symbolTree t, nameKey_Name name);
+
+/*
+ isEmptyTree - returns true if symbolTree, t, is empty.
+*/
+
+extern "C" unsigned int symbolKey_isEmptyTree (symbolKey_symbolTree t);
+
+/*
+ doesTreeContainAny - returns true if symbolTree, t, contains any
+ symbols which in turn return true when procedure,
+ p, is called with a symbol as its parameter.
+ The symbolTree root is empty apart from the field,
+ left, hence we need two procedures.
+*/
+
+extern "C" unsigned int symbolKey_doesTreeContainAny (symbolKey_symbolTree t, symbolKey_isSymbol p);
+
+/*
+ foreachNodeDo - for each node in symbolTree, t, a procedure, p,
+ is called with the node symbol as its parameter.
+ The tree root node only contains a legal left pointer,
+ therefore we need two procedures to examine this tree.
+*/
+
+extern "C" void symbolKey_foreachNodeDo (symbolKey_symbolTree t, symbolKey_performOperation p);
+
+/*
+ findNodeAndParentInTree - find a node, child, in a binary tree, t, with name equal to n.
+ if an entry is found, father is set to the node above child.
+*/
+
+static void findNodeAndParentInTree (symbolKey_symbolTree t, nameKey_Name n, symbolKey_symbolTree *child, symbolKey_symbolTree *father);
+
+/*
+ searchForAny - performs the search required for doesTreeContainAny.
+ The root node always contains a nul data value,
+ therefore we must skip over it.
+*/
+
+static unsigned int searchForAny (symbolKey_symbolTree t, symbolKey_isSymbol p);
+
+/*
+ searchAndDo - searches all the nodes in symbolTree, t, and
+ calls procedure, p, with a node as its parameter.
+ It traverse the tree in order.
+*/
+
+static void searchAndDo (symbolKey_symbolTree t, symbolKey_performOperation p);
+
+
+/*
+ findNodeAndParentInTree - find a node, child, in a binary tree, t, with name equal to n.
+ if an entry is found, father is set to the node above child.
+*/
+
+static void findNodeAndParentInTree (symbolKey_symbolTree t, nameKey_Name n, symbolKey_symbolTree *child, symbolKey_symbolTree *father)
+{
+ /* remember to skip the sentinal value and assign father and child */
+ (*father) = t;
+ if (t == NULL)
+ {
+ Debug_Halt ((const char *) "parameter t should never be NIL", 31, 203, (const char *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44);
+ }
+ (*child) = t->left;
+ if ((*child) != NULL)
+ {
+ do {
+ if (n < (*child)->name)
+ {
+ (*father) = (*child);
+ (*child) = (*child)->left;
+ }
+ else if (n > (*child)->name)
+ {
+ /* avoid dangling else. */
+ (*father) = (*child);
+ (*child) = (*child)->right;
+ }
+ } while (! (((*child) == NULL) || (n == (*child)->name)));
+ }
+}
+
+
+/*
+ searchForAny - performs the search required for doesTreeContainAny.
+ The root node always contains a nul data value,
+ therefore we must skip over it.
+*/
+
+static unsigned int searchForAny (symbolKey_symbolTree t, symbolKey_isSymbol p)
+{
+ if (t == NULL)
+ {
+ return FALSE;
+ }
+ else
+ {
+ return (((*p.proc) (t->key)) || (searchForAny (t->left, p))) || (searchForAny (t->right, p));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ searchAndDo - searches all the nodes in symbolTree, t, and
+ calls procedure, p, with a node as its parameter.
+ It traverse the tree in order.
+*/
+
+static void searchAndDo (symbolKey_symbolTree t, symbolKey_performOperation p)
+{
+ if (t != NULL)
+ {
+ searchAndDo (t->right, p);
+ (*p.proc) (t->key);
+ searchAndDo (t->left, p);
+ }
+}
+
+extern "C" symbolKey_symbolTree symbolKey_initTree (void)
+{
+ symbolKey_symbolTree t;
+
+ Storage_ALLOCATE ((void **) &t, sizeof (symbolKey__T1)); /* The value entity */
+ t->left = NULL;
+ t->right = NULL;
+ return t;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void symbolKey_killTree (symbolKey_symbolTree *t)
+{
+ if ((*t) != NULL)
+ {
+ symbolKey_killTree (&(*t)->left);
+ symbolKey_killTree (&(*t)->right);
+ Storage_DEALLOCATE ((void **) &(*t), sizeof (symbolKey__T1));
+ (*t) = NULL;
+ }
+}
+
+extern "C" void * symbolKey_getSymKey (symbolKey_symbolTree t, nameKey_Name name)
+{
+ symbolKey_symbolTree father;
+ symbolKey_symbolTree child;
+
+ if (t == NULL)
+ {
+ return symbolKey_NulKey;
+ }
+ else
+ {
+ findNodeAndParentInTree (t, name, &child, &father);
+ if (child == NULL)
+ {
+ return symbolKey_NulKey;
+ }
+ else
+ {
+ return child->key;
+ }
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void symbolKey_putSymKey (symbolKey_symbolTree t, nameKey_Name name, void * key)
+{
+ symbolKey_symbolTree father;
+ symbolKey_symbolTree child;
+
+ findNodeAndParentInTree (t, name, &child, &father);
+ if (child == NULL)
+ {
+ /* no child found, now is name less than father or greater? */
+ if (father == t)
+ {
+ /* empty tree, add it to the left branch of t */
+ Storage_ALLOCATE ((void **) &child, sizeof (symbolKey__T1));
+ father->left = child;
+ }
+ else
+ {
+ if (name < father->name)
+ {
+ Storage_ALLOCATE ((void **) &child, sizeof (symbolKey__T1));
+ father->left = child;
+ }
+ else if (name > father->name)
+ {
+ /* avoid dangling else. */
+ Storage_ALLOCATE ((void **) &child, sizeof (symbolKey__T1));
+ father->right = child;
+ }
+ }
+ child->right = NULL;
+ child->left = NULL;
+ child->key = key;
+ child->name = name;
+ }
+ else
+ {
+ Debug_Halt ((const char *) "symbol already stored", 21, 119, (const char *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44);
+ }
+}
+
+
+/*
+ delSymKey - deletes an entry in the binary tree.
+
+ NB in order for this to work we must ensure that the InitTree sets
+ both left and right to NIL.
+*/
+
+extern "C" void symbolKey_delSymKey (symbolKey_symbolTree t, nameKey_Name name)
+{
+ symbolKey_symbolTree i;
+ symbolKey_symbolTree child;
+ symbolKey_symbolTree father;
+
+ findNodeAndParentInTree (t, name, &child, &father); /* find father and child of the node */
+ if ((child != NULL) && (child->name == name))
+ {
+ /* Have found the node to be deleted */
+ if (father->right == child)
+ {
+ /* most branch of child^.left. */
+ if (child->left != NULL)
+ {
+ /* Scan for right most node of child^.left */
+ i = child->left;
+ while (i->right != NULL)
+ {
+ i = i->right;
+ }
+ i->right = child->right;
+ father->right = child->left;
+ }
+ else
+ {
+ /* (as in a single linked list) to child^.right */
+ father->right = child->right;
+ }
+ Storage_DEALLOCATE ((void **) &child, sizeof (symbolKey__T1));
+ }
+ else
+ {
+ /* branch of child^.right */
+ if (child->right != NULL)
+ {
+ /* Scan for left most node of child^.right */
+ i = child->right;
+ while (i->left != NULL)
+ {
+ i = i->left;
+ }
+ i->left = child->left;
+ father->left = child->right;
+ }
+ else
+ {
+ /* (as in a single linked list) to child^.left. */
+ father->left = child->left;
+ }
+ Storage_DEALLOCATE ((void **) &child, sizeof (symbolKey__T1));
+ }
+ }
+ else
+ {
+ Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 186, (const char *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44);
+ }
+}
+
+
+/*
+ isEmptyTree - returns true if symbolTree, t, is empty.
+*/
+
+extern "C" unsigned int symbolKey_isEmptyTree (symbolKey_symbolTree t)
+{
+ return t->left == NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doesTreeContainAny - returns true if symbolTree, t, contains any
+ symbols which in turn return true when procedure,
+ p, is called with a symbol as its parameter.
+ The symbolTree root is empty apart from the field,
+ left, hence we need two procedures.
+*/
+
+extern "C" unsigned int symbolKey_doesTreeContainAny (symbolKey_symbolTree t, symbolKey_isSymbol p)
+{
+ return searchForAny (t->left, p);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ foreachNodeDo - for each node in symbolTree, t, a procedure, p,
+ is called with the node symbol as its parameter.
+ The tree root node only contains a legal left pointer,
+ therefore we need two procedures to examine this tree.
+*/
+
+extern "C" void symbolKey_foreachNodeDo (symbolKey_symbolTree t, symbolKey_performOperation p)
+{
+ searchAndDo (t->left, p);
+}
+
+extern "C" void _M2_symbolKey_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_symbolKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from top. */
+/* top.mod main top level program module for mc.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# include "GmcOptions.h"
+# include "GmcComp.h"
+# include "GM2RTS.h"
+# include "GmcStream.h"
+# include "Glibc.h"
+
+
+/*
+ wrapRemoveFiles - call removeFiles and return 0.
+*/
+
+static int wrapRemoveFiles (void);
+
+/*
+ init - translate the source file after handling all the
+ program arguments.
+*/
+
+static void init (void);
+
+/*
+ wrapRemoveFiles - call removeFiles and return 0.
+*/
+
+static int wrapRemoveFiles (void);
+
+/*
+ init - translate the source file after handling all the
+ program arguments.
+*/
+
+static void init (void);
+
+
+/*
+ wrapRemoveFiles - call removeFiles and return 0.
+*/
+
+static int wrapRemoveFiles (void)
+{
+ mcStream_removeFiles ();
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ init - translate the source file after handling all the
+ program arguments.
+*/
+
+static void init (void)
+{
+ if ((libc_atexit ((libc_exitP_C) wrapRemoveFiles)) != 0)
+ {
+ libc_perror ((const char *) "atexit failed", 13);
+ }
+ M2RTS_ExitOnHalt (1);
+ mcComp_compile (mcOptions_handleOptions ());
+}
+
+extern "C" void _M2_top_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ init ();
+}
+
+extern "C" void _M2_top_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from varargs. */
+/* varargs.mod provides a basic vararg facility for GNU Modula-2.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _varargs_H
+#define _varargs_C
+
+# include "GStorage.h"
+# include "Glibc.h"
+# include "GSYSTEM.h"
+# include "GM2RTS.h"
+
+# define MaxArg 4
+typedef struct varargs_argDesc_r varargs_argDesc;
+
+typedef struct varargs__T6_r varargs__T6;
+
+typedef unsigned char *varargs_ptrToByte;
+
+typedef struct varargs__T7_a varargs__T7;
+
+typedef varargs__T6 *varargs_vararg;
+
+struct varargs_argDesc_r {
+ void *ptr;
+ unsigned int len;
+ };
+
+struct varargs__T7_a { varargs_argDesc array[MaxArg+1]; };
+struct varargs__T6_r {
+ unsigned int nArgs;
+ unsigned int i;
+ void *contents;
+ unsigned int size;
+ varargs__T7 arg;
+ };
+
+
+/*
+ nargs - returns the number of arguments wrapped in, v.
+*/
+
+extern "C" unsigned int varargs_nargs (varargs_vararg v);
+
+/*
+ arg - fills in, a, with the next argument. The size of, a, must be an exact
+ match with the original vararg parameter.
+*/
+
+extern "C" void varargs_arg (varargs_vararg v, unsigned char *a, unsigned int _a_high);
+
+/*
+ next - assigns the next arg to be collected as, i.
+*/
+
+extern "C" void varargs_next (varargs_vararg v, unsigned int i);
+
+/*
+ copy - returns a copy of, v.
+*/
+
+extern "C" varargs_vararg varargs_copy (varargs_vararg v);
+
+/*
+ replace - fills the next argument with, a. The size of, a,
+ must be an exact match with the original vararg
+ parameter.
+*/
+
+extern "C" void varargs_replace (varargs_vararg v, unsigned char *a, unsigned int _a_high);
+
+/*
+ end - destructor for vararg, v.
+*/
+
+extern "C" void varargs_end (varargs_vararg *v);
+
+/*
+ start1 - wraps up argument, a, into a vararg.
+*/
+
+extern "C" varargs_vararg varargs_start1 (const unsigned char *a_, unsigned int _a_high);
+
+/*
+ start2 - wraps up arguments, a, b, into a vararg.
+*/
+
+extern "C" varargs_vararg varargs_start2 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high);
+
+/*
+ start3 - wraps up arguments, a, b, c, into a vararg.
+*/
+
+extern "C" varargs_vararg varargs_start3 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high, const unsigned char *c_, unsigned int _c_high);
+
+/*
+ start4 - wraps up arguments, a, b, c, d, into a vararg.
+*/
+
+extern "C" varargs_vararg varargs_start4 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high, const unsigned char *c_, unsigned int _c_high, const unsigned char *d_, unsigned int _d_high);
+
+
+/*
+ nargs - returns the number of arguments wrapped in, v.
+*/
+
+extern "C" unsigned int varargs_nargs (varargs_vararg v)
+{
+ return v->nArgs;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ arg - fills in, a, with the next argument. The size of, a, must be an exact
+ match with the original vararg parameter.
+*/
+
+extern "C" void varargs_arg (varargs_vararg v, unsigned char *a, unsigned int _a_high)
+{
+ typedef unsigned char *arg__T1;
+
+ arg__T1 p;
+ unsigned int j;
+
+ if (v->i == v->nArgs)
+ {
+ M2RTS_HALT (-1); /* too many calls to arg. */
+ __builtin_unreachable ();
+ }
+ else
+ {
+ if ((_a_high+1) == v->arg.array[v->i].len)
+ {
+ p = static_cast<arg__T1> (v->arg.array[v->i].ptr);
+ j = 0;
+ while (j <= _a_high)
+ {
+ a[j] = (*p);
+ p += 1;
+ j += 1;
+ }
+ }
+ else
+ {
+ M2RTS_HALT (-1); /* parameter mismatch. */
+ __builtin_unreachable ();
+ }
+ v->i += 1;
+ }
+}
+
+
+/*
+ next - assigns the next arg to be collected as, i.
+*/
+
+extern "C" void varargs_next (varargs_vararg v, unsigned int i)
+{
+ v->i = i;
+}
+
+
+/*
+ copy - returns a copy of, v.
+*/
+
+extern "C" varargs_vararg varargs_copy (varargs_vararg v)
+{
+ varargs_vararg c;
+ unsigned int j;
+ unsigned int offset;
+
+ Storage_ALLOCATE ((void **) &c, sizeof (varargs__T6));
+ c->i = v->i;
+ c->nArgs = v->nArgs;
+ c->size = v->size;
+ Storage_ALLOCATE (&c->contents, c->size);
+ c->contents = libc_memcpy (c->contents, v->contents, static_cast<size_t> (c->size));
+ for (j=0; j<=c->nArgs; j++)
+ {
+ offset = (unsigned int ) (((varargs_ptrToByte) (v->contents))-((varargs_ptrToByte) (v->arg.array[j].ptr)));
+ c->arg.array[j].ptr = reinterpret_cast<void *> ((varargs_ptrToByte) (((varargs_ptrToByte) (c->contents))+offset));
+ c->arg.array[j].len = v->arg.array[j].len;
+ }
+ return c;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ replace - fills the next argument with, a. The size of, a,
+ must be an exact match with the original vararg
+ parameter.
+*/
+
+extern "C" void varargs_replace (varargs_vararg v, unsigned char *a, unsigned int _a_high)
+{
+ typedef unsigned char *replace__T2;
+
+ replace__T2 p;
+ unsigned int j;
+
+ if (v->i == v->nArgs)
+ {
+ M2RTS_HALT (-1); /* too many calls to arg. */
+ __builtin_unreachable ();
+ }
+ else
+ {
+ if ((_a_high+1) == v->arg.array[v->i].len)
+ {
+ p = static_cast<replace__T2> (v->arg.array[v->i].ptr);
+ j = 0;
+ while (j <= _a_high)
+ {
+ (*p) = a[j];
+ p += 1;
+ j += 1;
+ }
+ }
+ else
+ {
+ M2RTS_HALT (-1); /* parameter mismatch. */
+ __builtin_unreachable ();
+ }
+ }
+}
+
+
+/*
+ end - destructor for vararg, v.
+*/
+
+extern "C" void varargs_end (varargs_vararg *v)
+{
+ if ((*v) != NULL)
+ {
+ Storage_DEALLOCATE (&(*v)->contents, sizeof (varargs_vararg));
+ Storage_DEALLOCATE ((void **) &(*v), sizeof (varargs__T6));
+ }
+}
+
+
+/*
+ start1 - wraps up argument, a, into a vararg.
+*/
+
+extern "C" varargs_vararg varargs_start1 (const unsigned char *a_, unsigned int _a_high)
+{
+ varargs_vararg v;
+ unsigned char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ Storage_ALLOCATE ((void **) &v, sizeof (varargs__T6));
+ v->i = 0;
+ v->nArgs = 1;
+ v->size = _a_high+1;
+ Storage_ALLOCATE (&v->contents, v->size);
+ v->contents = libc_memcpy (v->contents, &a, static_cast<size_t> (v->size));
+ v->arg.array[0].ptr = v->contents;
+ v->arg.array[0].len = v->size;
+ return v;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ start2 - wraps up arguments, a, b, into a vararg.
+*/
+
+extern "C" varargs_vararg varargs_start2 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high)
+{
+ typedef unsigned char *start2__T3;
+
+ varargs_vararg v;
+ start2__T3 p;
+ unsigned char a[_a_high+1];
+ unsigned char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ Storage_ALLOCATE ((void **) &v, sizeof (varargs__T6));
+ v->i = 0;
+ v->nArgs = 2;
+ v->size = (_a_high+_b_high)+2;
+ Storage_ALLOCATE (&v->contents, v->size);
+ p = static_cast<start2__T3> (libc_memcpy (v->contents, &a, static_cast<size_t> (_a_high+1)));
+ v->arg.array[0].ptr = reinterpret_cast<void *> (p);
+ v->arg.array[0].len = _a_high+1;
+ p += v->arg.array[0].len;
+ p = static_cast<start2__T3> (libc_memcpy (reinterpret_cast<void *> (p), &b, static_cast<size_t> (_b_high+1)));
+ v->arg.array[1].ptr = reinterpret_cast<void *> (p);
+ v->arg.array[1].len = _b_high+1;
+ return v;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ start3 - wraps up arguments, a, b, c, into a vararg.
+*/
+
+extern "C" varargs_vararg varargs_start3 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high, const unsigned char *c_, unsigned int _c_high)
+{
+ typedef unsigned char *start3__T4;
+
+ varargs_vararg v;
+ start3__T4 p;
+ unsigned char a[_a_high+1];
+ unsigned char b[_b_high+1];
+ unsigned char c[_c_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+ memcpy (c, c_, _c_high+1);
+
+ Storage_ALLOCATE ((void **) &v, sizeof (varargs__T6));
+ v->i = 0;
+ v->nArgs = 3;
+ v->size = ((_a_high+_b_high)+_c_high)+3;
+ Storage_ALLOCATE (&v->contents, v->size);
+ p = static_cast<start3__T4> (libc_memcpy (v->contents, &a, static_cast<size_t> (_a_high+1)));
+ v->arg.array[0].ptr = reinterpret_cast<void *> (p);
+ v->arg.array[0].len = _a_high+1;
+ p += v->arg.array[0].len;
+ p = static_cast<start3__T4> (libc_memcpy (reinterpret_cast<void *> (p), &b, static_cast<size_t> (_b_high+1)));
+ v->arg.array[1].ptr = reinterpret_cast<void *> (p);
+ v->arg.array[1].len = _b_high+1;
+ p += v->arg.array[1].len;
+ p = static_cast<start3__T4> (libc_memcpy (reinterpret_cast<void *> (p), &c, static_cast<size_t> (_c_high+1)));
+ v->arg.array[2].ptr = reinterpret_cast<void *> (p);
+ v->arg.array[2].len = _c_high+1;
+ return v;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ start4 - wraps up arguments, a, b, c, d, into a vararg.
+*/
+
+extern "C" varargs_vararg varargs_start4 (const unsigned char *a_, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high, const unsigned char *c_, unsigned int _c_high, const unsigned char *d_, unsigned int _d_high)
+{
+ typedef unsigned char *start4__T5;
+
+ varargs_vararg v;
+ start4__T5 p;
+ unsigned char a[_a_high+1];
+ unsigned char b[_b_high+1];
+ unsigned char c[_c_high+1];
+ unsigned char d[_d_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+ memcpy (c, c_, _c_high+1);
+ memcpy (d, d_, _d_high+1);
+
+ Storage_ALLOCATE ((void **) &v, sizeof (varargs__T6));
+ v->i = 0;
+ v->nArgs = 4;
+ v->size = (((_a_high+_b_high)+_c_high)+_d_high)+4;
+ Storage_ALLOCATE (&v->contents, v->size);
+ p = static_cast<start4__T5> (libc_memcpy (v->contents, &a, static_cast<size_t> (_a_high+1)));
+ v->arg.array[0].len = _a_high+1;
+ p += v->arg.array[0].len;
+ p = static_cast<start4__T5> (libc_memcpy (reinterpret_cast<void *> (p), &b, static_cast<size_t> (_b_high+1)));
+ v->arg.array[1].ptr = reinterpret_cast<void *> (p);
+ v->arg.array[1].len = _b_high+1;
+ p += v->arg.array[1].len;
+ p = static_cast<start4__T5> (libc_memcpy (reinterpret_cast<void *> (p), &c, static_cast<size_t> (_c_high+1)));
+ v->arg.array[2].ptr = reinterpret_cast<void *> (p);
+ v->arg.array[2].len = _c_high+1;
+ p += v->arg.array[2].len;
+ p = static_cast<start4__T5> (libc_memcpy (reinterpret_cast<void *> (p), &c, static_cast<size_t> (_c_high+1)));
+ v->arg.array[3].ptr = reinterpret_cast<void *> (p);
+ v->arg.array[3].len = _c_high+1;
+ return v;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_varargs_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_varargs_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from wlists. */
+/* wlists.mod word lists module.
+
+Copyright (C) 2015-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _wlists_H
+#define _wlists_C
+
+# include "GStorage.h"
+
+typedef struct wlists_performOperation_p wlists_performOperation;
+
+# define maxNoOfElements 5
+typedef struct wlists__T1_r wlists__T1;
+
+typedef struct wlists__T2_a wlists__T2;
+
+typedef wlists__T1 *wlists_wlist;
+
+typedef void (*wlists_performOperation_t) (unsigned int);
+struct wlists_performOperation_p { wlists_performOperation_t proc; };
+
+struct wlists__T2_a { unsigned int array[maxNoOfElements-1+1]; };
+struct wlists__T1_r {
+ unsigned int noOfElements;
+ wlists__T2 elements;
+ wlists_wlist next;
+ };
+
+
+/*
+ initList - creates a new wlist, l.
+*/
+
+extern "C" wlists_wlist wlists_initList (void);
+
+/*
+ killList - deletes the complete wlist, l.
+*/
+
+extern "C" void wlists_killList (wlists_wlist *l);
+
+/*
+ putItemIntoList - places an WORD, c, into wlist, l.
+*/
+
+extern "C" void wlists_putItemIntoList (wlists_wlist l, unsigned int c);
+
+/*
+ getItemFromList - retrieves the nth WORD from wlist, l.
+*/
+
+extern "C" unsigned int wlists_getItemFromList (wlists_wlist l, unsigned int n);
+
+/*
+ getIndexOfList - returns the index for WORD, c, in wlist, l.
+ If more than one WORD, c, exists the index
+ for the first is returned.
+*/
+
+extern "C" unsigned int wlists_getIndexOfList (wlists_wlist l, unsigned int c);
+
+/*
+ noOfItemsInList - returns the number of items in wlist, l.
+*/
+
+extern "C" unsigned int wlists_noOfItemsInList (wlists_wlist l);
+
+/*
+ includeItemIntoList - adds an WORD, c, into a wlist providing
+ the value does not already exist.
+*/
+
+extern "C" void wlists_includeItemIntoList (wlists_wlist l, unsigned int c);
+
+/*
+ removeItemFromList - removes a WORD, c, from a wlist.
+ It assumes that this value only appears once.
+*/
+
+extern "C" void wlists_removeItemFromList (wlists_wlist l, unsigned int c);
+
+/*
+ replaceItemInList - replace the nth WORD in wlist, l.
+ The first item in a wlists is at index, 1.
+ If the index, n, is out of range nothing is changed.
+*/
+
+extern "C" void wlists_replaceItemInList (wlists_wlist l, unsigned int n, unsigned int w);
+
+/*
+ isItemInList - returns true if a WORD, c, was found in wlist, l.
+*/
+
+extern "C" unsigned int wlists_isItemInList (wlists_wlist l, unsigned int c);
+
+/*
+ foreachItemInListDo - calls procedure, P, foreach item in wlist, l.
+*/
+
+extern "C" void wlists_foreachItemInListDo (wlists_wlist l, wlists_performOperation p);
+
+/*
+ duplicateList - returns a duplicate wlist derived from, l.
+*/
+
+extern "C" wlists_wlist wlists_duplicateList (wlists_wlist l);
+
+/*
+ removeItem - remove an element at index, i, from the wlist data type.
+*/
+
+static void removeItem (wlists_wlist p, wlists_wlist l, unsigned int i);
+
+
+/*
+ removeItem - remove an element at index, i, from the wlist data type.
+*/
+
+static void removeItem (wlists_wlist p, wlists_wlist l, unsigned int i)
+{
+ l->noOfElements -= 1;
+ while (i <= l->noOfElements)
+ {
+ l->elements.array[i-1] = l->elements.array[i+1-1];
+ i += 1;
+ }
+ if ((l->noOfElements == 0) && (p != NULL))
+ {
+ p->next = l->next;
+ Storage_DEALLOCATE ((void **) &l, sizeof (wlists__T1));
+ }
+}
+
+
+/*
+ initList - creates a new wlist, l.
+*/
+
+extern "C" wlists_wlist wlists_initList (void)
+{
+ wlists_wlist l;
+
+ Storage_ALLOCATE ((void **) &l, sizeof (wlists__T1));
+ l->noOfElements = 0;
+ l->next = NULL;
+ return l;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ killList - deletes the complete wlist, l.
+*/
+
+extern "C" void wlists_killList (wlists_wlist *l)
+{
+ if ((*l) != NULL)
+ {
+ if ((*l)->next != NULL)
+ {
+ wlists_killList (&(*l)->next);
+ }
+ Storage_DEALLOCATE ((void **) &(*l), sizeof (wlists__T1));
+ }
+}
+
+
+/*
+ putItemIntoList - places an WORD, c, into wlist, l.
+*/
+
+extern "C" void wlists_putItemIntoList (wlists_wlist l, unsigned int c)
+{
+ if (l->noOfElements < maxNoOfElements)
+ {
+ l->noOfElements += 1;
+ l->elements.array[l->noOfElements-1] = c;
+ }
+ else if (l->next != NULL)
+ {
+ /* avoid dangling else. */
+ wlists_putItemIntoList (l->next, c);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ l->next = wlists_initList ();
+ wlists_putItemIntoList (l->next, c);
+ }
+}
+
+
+/*
+ getItemFromList - retrieves the nth WORD from wlist, l.
+*/
+
+extern "C" unsigned int wlists_getItemFromList (wlists_wlist l, unsigned int n)
+{
+ while (l != NULL)
+ {
+ if (n <= l->noOfElements)
+ {
+ return l->elements.array[n-1];
+ }
+ else
+ {
+ n -= l->noOfElements;
+ }
+ l = l->next;
+ }
+ return static_cast<unsigned int> (0);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getIndexOfList - returns the index for WORD, c, in wlist, l.
+ If more than one WORD, c, exists the index
+ for the first is returned.
+*/
+
+extern "C" unsigned int wlists_getIndexOfList (wlists_wlist l, unsigned int c)
+{
+ unsigned int i;
+
+ if (l == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ i = 1;
+ while (i <= l->noOfElements)
+ {
+ if (l->elements.array[i-1] == c)
+ {
+ return i;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ return l->noOfElements+(wlists_getIndexOfList (l->next, c));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ noOfItemsInList - returns the number of items in wlist, l.
+*/
+
+extern "C" unsigned int wlists_noOfItemsInList (wlists_wlist l)
+{
+ unsigned int t;
+
+ if (l == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ t = 0;
+ do {
+ t += l->noOfElements;
+ l = l->next;
+ } while (! (l == NULL));
+ return t;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ includeItemIntoList - adds an WORD, c, into a wlist providing
+ the value does not already exist.
+*/
+
+extern "C" void wlists_includeItemIntoList (wlists_wlist l, unsigned int c)
+{
+ if (! (wlists_isItemInList (l, c)))
+ {
+ wlists_putItemIntoList (l, c);
+ }
+}
+
+
+/*
+ removeItemFromList - removes a WORD, c, from a wlist.
+ It assumes that this value only appears once.
+*/
+
+extern "C" void wlists_removeItemFromList (wlists_wlist l, unsigned int c)
+{
+ wlists_wlist p;
+ unsigned int i;
+ unsigned int found;
+
+ if (l != NULL)
+ {
+ found = FALSE;
+ p = NULL;
+ do {
+ i = 1;
+ while ((i <= l->noOfElements) && (l->elements.array[i-1] != c))
+ {
+ i += 1;
+ }
+ if ((i <= l->noOfElements) && (l->elements.array[i-1] == c))
+ {
+ found = TRUE;
+ }
+ else
+ {
+ p = l;
+ l = l->next;
+ }
+ } while (! ((l == NULL) || found));
+ if (found)
+ {
+ removeItem (p, l, i);
+ }
+ }
+}
+
+
+/*
+ replaceItemInList - replace the nth WORD in wlist, l.
+ The first item in a wlists is at index, 1.
+ If the index, n, is out of range nothing is changed.
+*/
+
+extern "C" void wlists_replaceItemInList (wlists_wlist l, unsigned int n, unsigned int w)
+{
+ while (l != NULL)
+ {
+ if (n <= l->noOfElements)
+ {
+ l->elements.array[n-1] = w;
+ }
+ else
+ {
+ n -= l->noOfElements;
+ }
+ l = l->next;
+ }
+}
+
+
+/*
+ isItemInList - returns true if a WORD, c, was found in wlist, l.
+*/
+
+extern "C" unsigned int wlists_isItemInList (wlists_wlist l, unsigned int c)
+{
+ unsigned int i;
+
+ do {
+ i = 1;
+ while (i <= l->noOfElements)
+ {
+ if (l->elements.array[i-1] == c)
+ {
+ return TRUE;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ l = l->next;
+ } while (! (l == NULL));
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ foreachItemInListDo - calls procedure, P, foreach item in wlist, l.
+*/
+
+extern "C" void wlists_foreachItemInListDo (wlists_wlist l, wlists_performOperation p)
+{
+ unsigned int i;
+ unsigned int n;
+
+ n = wlists_noOfItemsInList (l);
+ i = 1;
+ while (i <= n)
+ {
+ (*p.proc) (wlists_getItemFromList (l, i));
+ i += 1;
+ }
+}
+
+
+/*
+ duplicateList - returns a duplicate wlist derived from, l.
+*/
+
+extern "C" wlists_wlist wlists_duplicateList (wlists_wlist l)
+{
+ wlists_wlist m;
+ unsigned int n;
+ unsigned int i;
+
+ m = wlists_initList ();
+ n = wlists_noOfItemsInList (l);
+ i = 1;
+ while (i <= n)
+ {
+ wlists_putItemIntoList (m, wlists_getItemFromList (l, i));
+ i += 1;
+ }
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_wlists_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_wlists_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from ASCII. */
+/* ASCII.mod dummy companion module for the definition.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _ASCII_H
+#define _ASCII_C
+
+
+# define ASCII_nul (char) 000
+# define ASCII_soh (char) 001
+# define ASCII_stx (char) 002
+# define ASCII_etx (char) 003
+# define ASCII_eot (char) 004
+# define ASCII_enq (char) 005
+# define ASCII_ack (char) 006
+# define ASCII_bel (char) 007
+# define ASCII_bs (char) 010
+# define ASCII_ht (char) 011
+# define ASCII_nl (char) 012
+# define ASCII_vt (char) 013
+# define ASCII_np (char) 014
+# define ASCII_cr (char) 015
+# define ASCII_so (char) 016
+# define ASCII_si (char) 017
+# define ASCII_dle (char) 020
+# define ASCII_dc1 (char) 021
+# define ASCII_dc2 (char) 022
+# define ASCII_dc3 (char) 023
+# define ASCII_dc4 (char) 024
+# define ASCII_nak (char) 025
+# define ASCII_syn (char) 026
+# define ASCII_etb (char) 027
+# define ASCII_can (char) 030
+# define ASCII_em (char) 031
+# define ASCII_sub (char) 032
+# define ASCII_esc (char) 033
+# define ASCII_fs (char) 034
+# define ASCII_gs (char) 035
+# define ASCII_rs (char) 036
+# define ASCII_us (char) 037
+# define ASCII_sp (char) 040
+# define ASCII_lf ASCII_nl
+# define ASCII_ff ASCII_np
+# define ASCII_eof ASCII_eot
+# define ASCII_tab ASCII_ht
+# define ASCII_del (char) 0177
+# define ASCII_EOL ASCII_nl
+
+extern "C" void _M2_ASCII_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_ASCII_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Args. */
+/* Args.mod provide access to command line arguments.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Args_H
+#define _Args_C
+
+# include "GUnixArgs.h"
+# include "GASCII.h"
+
+# define MaxArgs 255
+# define MaxString 4096
+typedef struct Args__T2_a Args__T2;
+
+typedef Args__T2 *Args__T1;
+
+typedef struct Args__T3_a Args__T3;
+
+struct Args__T2_a { Args__T3 * array[MaxArgs+1]; };
+struct Args__T3_a { char array[MaxString+1]; };
+static Args__T1 Source;
+
+/*
+ GetArg - returns the nth argument from the command line.
+ The success of the operation is returned.
+*/
+
+extern "C" unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n);
+
+/*
+ Narg - returns the number of arguments available from
+ command line.
+*/
+
+extern "C" unsigned int Args_Narg (void);
+
+
+/*
+ GetArg - returns the nth argument from the command line.
+ The success of the operation is returned.
+*/
+
+extern "C" unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n)
+{
+ int i;
+ unsigned int High;
+ unsigned int j;
+
+ i = (int ) (n);
+ j = 0;
+ High = _a_high;
+ if (i < (UnixArgs_GetArgC ()))
+ {
+ Source = static_cast<Args__T1> (UnixArgs_GetArgV ());
+ while ((j < High) && ((*(*Source).array[i]).array[j] != ASCII_nul))
+ {
+ a[j] = (*(*Source).array[i]).array[j];
+ j += 1;
+ }
+ }
+ if (j <= High)
+ {
+ a[j] = ASCII_nul;
+ }
+ return i < (UnixArgs_GetArgC ());
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Narg - returns the number of arguments available from
+ command line.
+*/
+
+extern "C" unsigned int Args_Narg (void)
+{
+ return UnixArgs_GetArgC ();
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_Args_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Args_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Assertion. */
+/* Assertion.mod provides an assert procedure.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Assertion_H
+#define _Assertion_C
+
+# include "GStrIO.h"
+# include "GM2RTS.h"
+
+
+/*
+ Assert - tests the boolean Condition, if it fails then HALT is called.
+*/
+
+extern "C" void Assertion_Assert (unsigned int Condition);
+
+
+/*
+ Assert - tests the boolean Condition, if it fails then HALT is called.
+*/
+
+extern "C" void Assertion_Assert (unsigned int Condition)
+{
+ if (! Condition)
+ {
+ StrIO_WriteString ((const char *) "assert failed - halting system", 30);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+extern "C" void _M2_Assertion_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Assertion_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* GBuiltins.c dummy module to aid linking mc projects.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#if defined(__cplusplus)
+#define EXTERN extern "C"
+#else
+#define EXTERN
+#endif
+
+
+/* init module constructor. */
+
+EXTERN
+void
+_M2_Builtins_init (void)
+{
+}
+
+/* finish module deconstructor. */
+
+EXTERN
+void
+_M2_Builtins_finish (void)
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Debug. */
+/* Debug.mod provides some simple debugging routines.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#include <string.h>
+#include <limits.h>
+#define _Debug_H
+#define _Debug_C
+
+# include "GASCII.h"
+# include "GNumberIO.h"
+# include "GStdIO.h"
+# include "Glibc.h"
+# include "GM2RTS.h"
+
+# define MaxNoOfDigits 12
+
+/*
+ Halt - writes a message in the format:
+ Module:Line:Message
+
+ It then terminates by calling HALT.
+*/
+
+extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high);
+
+/*
+ DebugString - writes a string to the debugging device (Scn.Write).
+ It interprets
+ as carriage return, linefeed.
+*/
+
+extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high);
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+static void WriteLn (void);
+
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+static void WriteLn (void)
+{
+ StdIO_Write (ASCII_cr);
+ StdIO_Write (ASCII_lf);
+}
+
+
+/*
+ Halt - writes a message in the format:
+ Module:Line:Message
+
+ It then terminates by calling HALT.
+*/
+
+extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high)
+{
+ typedef struct Halt__T1_a Halt__T1;
+
+ struct Halt__T1_a { char array[MaxNoOfDigits+1]; };
+ Halt__T1 No;
+ char Message[_Message_high+1];
+ char Module[_Module_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (Message, Message_, _Message_high+1);
+ memcpy (Module, Module_, _Module_high+1);
+
+ Debug_DebugString ((const char *) Module, _Module_high); /* should be large enough for most source files.. */
+ NumberIO_CardToStr (LineNo, 0, (char *) &No.array[0], MaxNoOfDigits);
+ Debug_DebugString ((const char *) ":", 1);
+ Debug_DebugString ((const char *) &No.array[0], MaxNoOfDigits);
+ Debug_DebugString ((const char *) ":", 1);
+ Debug_DebugString ((const char *) Message, _Message_high);
+ Debug_DebugString ((const char *) "\\n", 2);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ DebugString - writes a string to the debugging device (Scn.Write).
+ It interprets
+ as carriage return, linefeed.
+*/
+
+extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high)
+{
+ unsigned int n;
+ unsigned int high;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ high = _a_high;
+ n = 0;
+ while ((n <= high) && (a[n] != ASCII_nul))
+ {
+ if (a[n] == '\\')
+ {
+ /* avoid dangling else. */
+ if ((n+1) <= high)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a[n+1] == 'n')
+ {
+ WriteLn ();
+ n += 1;
+ }
+ else if (a[n+1] == '\\')
+ {
+ /* avoid dangling else. */
+ StdIO_Write ('\\');
+ n += 1;
+ }
+ }
+ }
+ else
+ {
+ StdIO_Write (a[n]);
+ }
+ n += 1;
+ }
+}
+
+extern "C" void _M2_Debug_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Debug_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from DynamicStrings. */
+/* DynamicStrings.mod provides a dynamic string type and procedures.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+#include <string.h>
+#include <limits.h>
+#include <stdlib.h>
+# include "GStorage.h"
+#include <unistd.h>
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _DynamicStrings_H
+#define _DynamicStrings_C
+
+# include "Glibc.h"
+# include "GStrLib.h"
+# include "GStorage.h"
+# include "GAssertion.h"
+# include "GSYSTEM.h"
+# include "GASCII.h"
+# include "GM2RTS.h"
+
+# define MaxBuf 127
+# define PoisonOn FALSE
+# define DebugOn FALSE
+# define CheckOn FALSE
+# define TraceOn FALSE
+typedef struct DynamicStrings_Contents_r DynamicStrings_Contents;
+
+typedef struct DynamicStrings_DebugInfo_r DynamicStrings_DebugInfo;
+
+typedef struct DynamicStrings_stringRecord_r DynamicStrings_stringRecord;
+
+typedef struct DynamicStrings_descriptor_r DynamicStrings_descriptor;
+
+typedef DynamicStrings_descriptor *DynamicStrings_Descriptor;
+
+typedef struct DynamicStrings_frameRec_r DynamicStrings_frameRec;
+
+typedef DynamicStrings_frameRec *DynamicStrings_frame;
+
+typedef struct DynamicStrings__T3_a DynamicStrings__T3;
+
+typedef enum {DynamicStrings_inuse, DynamicStrings_marked, DynamicStrings_onlist, DynamicStrings_poisoned} DynamicStrings_desState;
+
+typedef DynamicStrings_stringRecord *DynamicStrings_String;
+
+struct DynamicStrings_DebugInfo_r {
+ DynamicStrings_String next;
+ void *file;
+ unsigned int line;
+ void *proc;
+ };
+
+struct DynamicStrings_descriptor_r {
+ unsigned int charStarUsed;
+ void *charStar;
+ unsigned int charStarSize;
+ unsigned int charStarValid;
+ DynamicStrings_desState state;
+ DynamicStrings_String garbage;
+ };
+
+struct DynamicStrings_frameRec_r {
+ DynamicStrings_String alloc;
+ DynamicStrings_String dealloc;
+ DynamicStrings_frame next;
+ };
+
+struct DynamicStrings__T3_a { char array[(MaxBuf-1)+1]; };
+struct DynamicStrings_Contents_r {
+ DynamicStrings__T3 buf;
+ unsigned int len;
+ DynamicStrings_String next;
+ };
+
+struct DynamicStrings_stringRecord_r {
+ DynamicStrings_Contents contents;
+ DynamicStrings_Descriptor head;
+ DynamicStrings_DebugInfo debug;
+ };
+
+static unsigned int Initialized;
+static DynamicStrings_frame frameHead;
+static DynamicStrings_String captured;
+
+/*
+ InitString - creates and returns a String type object.
+ Initial contents are, a.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high);
+
+/*
+ KillString - frees String, s, and its contents.
+ NIL is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s);
+
+/*
+ Fin - finishes with a string, it calls KillString with, s.
+ The purpose of the procedure is to provide a short cut
+ to calling KillString and then testing the return result.
+*/
+
+extern "C" void DynamicStrings_Fin (DynamicStrings_String s);
+
+/*
+ InitStringCharStar - initializes and returns a String to contain the C string.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a);
+
+/*
+ InitStringChar - initializes and returns a String to contain the single character, ch.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch);
+
+/*
+ Mark - marks String, s, ready for garbage collection.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s);
+
+/*
+ Length - returns the length of the String, s.
+*/
+
+extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s);
+
+/*
+ ConCat - returns String, a, after the contents of, b, have been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ ConCatChar - returns String, a, after character, ch, has been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch);
+
+/*
+ Assign - assigns the contents of, b, into, a.
+ String, a, is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ Dup - duplicate a String, s, returning the copy of s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s);
+
+/*
+ Add - returns a new String which contains the contents of a and b.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ Equal - returns TRUE if String, a, and, b, are equal.
+*/
+
+extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ EqualCharStar - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a);
+
+/*
+ EqualArray - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high);
+
+/*
+ Mult - returns a new string which is n concatenations of String, s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n);
+
+/*
+ Slice - returns a new string which contains the elements
+ low..high-1
+
+ strings start at element 0
+ Slice(s, 0, 2) will return elements 0, 1 but not 2
+ Slice(s, 1, 3) will return elements 1, 2 but not 3
+ Slice(s, 2, 0) will return elements 2..max
+ Slice(s, 3, -1) will return elements 3..max-1
+ Slice(s, 4, -2) will return elements 4..max-2
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high);
+
+/*
+ Index - returns the indice of the first occurance of, ch, in
+ String, s. -1 is returned if, ch, does not exist.
+ The search starts at position, o.
+*/
+
+extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o);
+
+/*
+ RIndex - returns the indice of the last occurance of, ch,
+ in String, s. The search starts at position, o.
+ -1 is returned if, ch, is not found.
+*/
+
+extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o);
+
+/*
+ RemoveComment - assuming that, comment, is a comment delimiter
+ which indicates anything to its right is a comment
+ then strip off the comment and also any white space
+ on the remaining right hand side.
+ It leaves any white space on the left hand side alone.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment);
+
+/*
+ RemoveWhitePrefix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s);
+
+/*
+ RemoveWhitePostfix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s);
+
+/*
+ ToUpper - returns string, s, after it has had its lower case characters
+ replaced by upper case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s);
+
+/*
+ ToLower - returns string, s, after it has had its upper case characters
+ replaced by lower case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s);
+
+/*
+ CopyOut - copies string, s, to a.
+*/
+
+extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s);
+
+/*
+ char - returns the character, ch, at position, i, in String, s.
+*/
+
+extern "C" char DynamicStrings_char (DynamicStrings_String s, int i);
+
+/*
+ string - returns the C style char * of String, s.
+*/
+
+extern "C" void * DynamicStrings_string (DynamicStrings_String s);
+
+/*
+ InitStringDB - the debug version of InitString.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ InitStringCharStarDB - the debug version of InitStringCharStar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ InitStringCharDB - the debug version of InitStringChar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ MultDB - the debug version of MultDB.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ DupDB - the debug version of Dup.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ SliceDB - debug version of Slice.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ PushAllocation - pushes the current allocation/deallocation lists.
+*/
+
+extern "C" void DynamicStrings_PushAllocation (void);
+
+/*
+ PopAllocation - test to see that all strings are deallocated since
+ the last push. Then it pops to the previous
+ allocation/deallocation lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" void DynamicStrings_PopAllocation (unsigned int halt);
+
+/*
+ PopAllocationExemption - test to see that all strings are deallocated, except
+ string, e, since the last push.
+ Then it pops to the previous allocation/deallocation
+ lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e);
+
+/*
+ writeStringDesc write out debugging information about string, s. */
+
+static void writeStringDesc (DynamicStrings_String s);
+
+/*
+ writeNspace -
+*/
+
+static void writeNspace (unsigned int n);
+
+/*
+ DumpStringInfo -
+*/
+
+static void DumpStringInfo (DynamicStrings_String s, unsigned int i);
+
+/*
+ DumpStringInfo -
+*/
+
+static void stop (void);
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void);
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s);
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void);
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s);
+static unsigned int Capture (DynamicStrings_String s);
+
+/*
+ Min -
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b);
+
+/*
+ Max -
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b);
+
+/*
+ writeString - writes a string to stdout.
+*/
+
+static void writeString (const char *a_, unsigned int _a_high);
+
+/*
+ writeCstring - writes a C string to stdout.
+*/
+
+static void writeCstring (void * a);
+
+/*
+ writeCard -
+*/
+
+static void writeCard (unsigned int c);
+
+/*
+ writeLongcard -
+*/
+
+static void writeLongcard (long unsigned int l);
+
+/*
+ writeAddress -
+*/
+
+static void writeAddress (void * a);
+
+/*
+ writeLn - writes a newline.
+*/
+
+static void writeLn (void);
+
+/*
+ AssignDebug - assigns, file, and, line, information to string, s.
+*/
+
+static DynamicStrings_String AssignDebug (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line, const char *proc_, unsigned int _proc_high);
+
+/*
+ IsOn - returns TRUE if, s, is on one of the debug lists.
+*/
+
+static unsigned int IsOn (DynamicStrings_String list, DynamicStrings_String s);
+
+/*
+ AddTo - adds string, s, to, list.
+*/
+
+static void AddTo (DynamicStrings_String *list, DynamicStrings_String s);
+
+/*
+ SubFrom - removes string, s, from, list.
+*/
+
+static void SubFrom (DynamicStrings_String *list, DynamicStrings_String s);
+
+/*
+ AddAllocated - adds string, s, to the head of the allocated list.
+*/
+
+static void AddAllocated (DynamicStrings_String s);
+
+/*
+ AddDeallocated - adds string, s, to the head of the deallocated list.
+*/
+
+static void AddDeallocated (DynamicStrings_String s);
+
+/*
+ IsOnAllocated - returns TRUE if the string, s, has ever been allocated.
+*/
+
+static unsigned int IsOnAllocated (DynamicStrings_String s);
+
+/*
+ IsOnDeallocated - returns TRUE if the string, s, has ever been deallocated.
+*/
+
+static unsigned int IsOnDeallocated (DynamicStrings_String s);
+
+/*
+ SubAllocated - removes string, s, from the list of allocated strings.
+*/
+
+static void SubAllocated (DynamicStrings_String s);
+
+/*
+ SubDeallocated - removes string, s, from the list of deallocated strings.
+*/
+
+static void SubDeallocated (DynamicStrings_String s);
+
+/*
+ SubDebugInfo - removes string, s, from the list of allocated strings.
+*/
+
+static void SubDebugInfo (DynamicStrings_String s);
+
+/*
+ AddDebugInfo - adds string, s, to the list of allocated strings.
+*/
+
+static void AddDebugInfo (DynamicStrings_String s);
+
+/*
+ ConcatContents - add the contents of string, a, where, h, is the
+ total length of, a. The offset is in, o.
+*/
+
+static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned int _a_high, unsigned int h, unsigned int o);
+
+/*
+ DeallocateCharStar - deallocates any charStar.
+*/
+
+static void DeallocateCharStar (DynamicStrings_String s);
+
+/*
+ CheckPoisoned - checks for a poisoned string, s.
+*/
+
+static DynamicStrings_String CheckPoisoned (DynamicStrings_String s);
+
+/*
+ MarkInvalid - marks the char * version of String, s, as invalid.
+*/
+
+static void MarkInvalid (DynamicStrings_String s);
+
+/*
+ ConcatContentsAddress - concatenate the string, a, where, h, is the
+ total length of, a.
+*/
+
+static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigned int h);
+
+/*
+ AddToGarbage - adds String, b, onto the garbage list of, a. Providing
+ the state of b is marked. The state is then altered to
+ onlist. String, a, is returned.
+*/
+
+static DynamicStrings_String AddToGarbage (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ IsOnGarbage - returns TRUE if, s, is on string, e, garbage list.
+*/
+
+static unsigned int IsOnGarbage (DynamicStrings_String e, DynamicStrings_String s);
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch);
+
+/*
+ DumpState -
+*/
+
+static void DumpState (DynamicStrings_String s);
+
+/*
+ DumpStringSynopsis -
+*/
+
+static void DumpStringSynopsis (DynamicStrings_String s);
+
+/*
+ DumpString - displays the contents of string, s.
+*/
+
+static void DumpString (DynamicStrings_String s);
+
+/*
+ Init - initialize the module.
+*/
+
+static void Init (void);
+
+
+/*
+ writeStringDesc write out debugging information about string, s. */
+
+static void writeStringDesc (DynamicStrings_String s)
+{
+ writeCstring (s->debug.file);
+ writeString ((const char *) ":", 1);
+ writeCard (s->debug.line);
+ writeString ((const char *) ":", 1);
+ writeCstring (s->debug.proc);
+ writeString ((const char *) " ", 1);
+ writeAddress (reinterpret_cast<void *> (s));
+ writeString ((const char *) " ", 1);
+ switch (s->head->state)
+ {
+ case DynamicStrings_inuse:
+ writeString ((const char *) "still in use (", 14);
+ writeCard (s->contents.len);
+ writeString ((const char *) ") characters", 12);
+ break;
+
+ case DynamicStrings_marked:
+ writeString ((const char *) "marked", 6);
+ break;
+
+ case DynamicStrings_onlist:
+ writeString ((const char *) "on a (lost) garbage list", 24);
+ break;
+
+ case DynamicStrings_poisoned:
+ writeString ((const char *) "poisoned", 8);
+ break;
+
+
+ default:
+ writeString ((const char *) "unknown state", 13);
+ break;
+ }
+}
+
+
+/*
+ writeNspace -
+*/
+
+static void writeNspace (unsigned int n)
+{
+ while (n > 0)
+ {
+ writeString ((const char *) " ", 1);
+ n -= 1;
+ }
+}
+
+
+/*
+ DumpStringInfo -
+*/
+
+static void DumpStringInfo (DynamicStrings_String s, unsigned int i)
+{
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ writeNspace (i);
+ writeStringDesc (s);
+ writeLn ();
+ if (s->head->garbage != NULL)
+ {
+ writeNspace (i);
+ writeString ((const char *) "garbage list:", 13);
+ writeLn ();
+ do {
+ s = s->head->garbage;
+ DumpStringInfo (s, i+1);
+ writeLn ();
+ } while (! (s == NULL));
+ }
+ }
+}
+
+
+/*
+ DumpStringInfo -
+*/
+
+static void stop (void)
+{
+}
+
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void)
+{
+ if (CheckOn)
+ {
+ DynamicStrings_PushAllocation ();
+ }
+}
+
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s)
+{
+ if (CheckOn)
+ {
+ s = DynamicStrings_PopAllocationExemption (TRUE, s);
+ }
+}
+
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void)
+{
+}
+
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s)
+{
+}
+
+static unsigned int Capture (DynamicStrings_String s)
+{
+ /*
+ * #undef GM2_DEBUG_DYNAMICSTINGS
+ * #if defined(GM2_DEBUG_DYNAMICSTINGS)
+ * # define DSdbEnter doDSdbEnter
+ * # define DSdbExit doDSdbExit
+ * # define CheckOn TRUE
+ * # define TraceOn TRUE
+ * #endif
+ */
+ captured = s;
+ return 1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Min -
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Max -
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ writeString - writes a string to stdout.
+*/
+
+static void writeString (const char *a_, unsigned int _a_high)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = static_cast<int> (libc_write (1, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
+}
+
+
+/*
+ writeCstring - writes a C string to stdout.
+*/
+
+static void writeCstring (void * a)
+{
+ int i;
+
+ if (a == NULL)
+ {
+ writeString ((const char *) "(null)", 6);
+ }
+ else
+ {
+ i = static_cast<int> (libc_write (1, a, libc_strlen (a)));
+ }
+}
+
+
+/*
+ writeCard -
+*/
+
+static void writeCard (unsigned int c)
+{
+ char ch;
+ int i;
+
+ if (c > 9)
+ {
+ writeCard (c / 10);
+ writeCard (c % 10);
+ }
+ else
+ {
+ ch = ((char) ( ((unsigned int) ('0'))+c));
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+ }
+}
+
+
+/*
+ writeLongcard -
+*/
+
+static void writeLongcard (long unsigned int l)
+{
+ char ch;
+ int i;
+
+ if (l > 16)
+ {
+ writeLongcard (l / 16);
+ writeLongcard (l % 16);
+ }
+ else if (l < 10)
+ {
+ /* avoid dangling else. */
+ ch = ((char) ( ((unsigned int) ('0'))+((unsigned int ) (l))));
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+ }
+ else if (l < 16)
+ {
+ /* avoid dangling else. */
+ ch = ((char) (( ((unsigned int) ('a'))+((unsigned int ) (l)))-10));
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+ }
+}
+
+
+/*
+ writeAddress -
+*/
+
+static void writeAddress (void * a)
+{
+ writeLongcard ((long unsigned int ) (a));
+}
+
+
+/*
+ writeLn - writes a newline.
+*/
+
+static void writeLn (void)
+{
+ char ch;
+ int i;
+
+ ch = ASCII_lf;
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+}
+
+
+/*
+ AssignDebug - assigns, file, and, line, information to string, s.
+*/
+
+static DynamicStrings_String AssignDebug (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line, const char *proc_, unsigned int _proc_high)
+{
+ void * f;
+ void * p;
+ char file[_file_high+1];
+ char proc[_proc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+ memcpy (proc, proc_, _proc_high+1);
+
+ f = &file;
+ p = &proc;
+ Storage_ALLOCATE (&s->debug.file, (StrLib_StrLen ((const char *) file, _file_high))+1);
+ if ((libc_strncpy (s->debug.file, f, (StrLib_StrLen ((const char *) file, _file_high))+1)) == NULL)
+ {} /* empty. */
+ s->debug.line = line;
+ Storage_ALLOCATE (&s->debug.proc, (StrLib_StrLen ((const char *) proc, _proc_high))+1);
+ if ((libc_strncpy (s->debug.proc, p, (StrLib_StrLen ((const char *) proc, _proc_high))+1)) == NULL)
+ {} /* empty. */
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsOn - returns TRUE if, s, is on one of the debug lists.
+*/
+
+static unsigned int IsOn (DynamicStrings_String list, DynamicStrings_String s)
+{
+ while ((list != s) && (list != NULL))
+ {
+ list = list->debug.next;
+ }
+ return list == s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AddTo - adds string, s, to, list.
+*/
+
+static void AddTo (DynamicStrings_String *list, DynamicStrings_String s)
+{
+ if ((*list) == NULL)
+ {
+ (*list) = s;
+ s->debug.next = NULL;
+ }
+ else
+ {
+ s->debug.next = (*list);
+ (*list) = s;
+ }
+}
+
+
+/*
+ SubFrom - removes string, s, from, list.
+*/
+
+static void SubFrom (DynamicStrings_String *list, DynamicStrings_String s)
+{
+ DynamicStrings_String p;
+
+ if ((*list) == s)
+ {
+ (*list) = s->debug.next;
+ }
+ else
+ {
+ p = (*list);
+ while ((p->debug.next != NULL) && (p->debug.next != s))
+ {
+ p = p->debug.next;
+ }
+ if (p->debug.next == s)
+ {
+ p->debug.next = s->debug.next;
+ }
+ else
+ {
+ /* not found, quit */
+ return ;
+ }
+ }
+ s->debug.next = NULL;
+}
+
+
+/*
+ AddAllocated - adds string, s, to the head of the allocated list.
+*/
+
+static void AddAllocated (DynamicStrings_String s)
+{
+ Init ();
+ AddTo (&frameHead->alloc, s);
+}
+
+
+/*
+ AddDeallocated - adds string, s, to the head of the deallocated list.
+*/
+
+static void AddDeallocated (DynamicStrings_String s)
+{
+ Init ();
+ AddTo (&frameHead->dealloc, s);
+}
+
+
+/*
+ IsOnAllocated - returns TRUE if the string, s, has ever been allocated.
+*/
+
+static unsigned int IsOnAllocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->alloc, s))
+ {
+ return TRUE;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsOnDeallocated - returns TRUE if the string, s, has ever been deallocated.
+*/
+
+static unsigned int IsOnDeallocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->dealloc, s))
+ {
+ return TRUE;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SubAllocated - removes string, s, from the list of allocated strings.
+*/
+
+static void SubAllocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->alloc, s))
+ {
+ SubFrom (&f->alloc, s);
+ return ;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+}
+
+
+/*
+ SubDeallocated - removes string, s, from the list of deallocated strings.
+*/
+
+static void SubDeallocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->dealloc, s))
+ {
+ SubFrom (&f->dealloc, s);
+ return ;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+}
+
+
+/*
+ SubDebugInfo - removes string, s, from the list of allocated strings.
+*/
+
+static void SubDebugInfo (DynamicStrings_String s)
+{
+ if (IsOnDeallocated (s))
+ {
+ Assertion_Assert (! DebugOn);
+ /* string has already been deallocated */
+ return ;
+ }
+ if (IsOnAllocated (s))
+ {
+ SubAllocated (s);
+ AddDeallocated (s);
+ }
+ else
+ {
+ /* string has not been allocated */
+ Assertion_Assert (! DebugOn);
+ }
+}
+
+
+/*
+ AddDebugInfo - adds string, s, to the list of allocated strings.
+*/
+
+static void AddDebugInfo (DynamicStrings_String s)
+{
+ s->debug.next = NULL;
+ s->debug.file = NULL;
+ s->debug.line = 0;
+ s->debug.proc = NULL;
+ if (CheckOn)
+ {
+ AddAllocated (s);
+ }
+}
+
+
+/*
+ ConcatContents - add the contents of string, a, where, h, is the
+ total length of, a. The offset is in, o.
+*/
+
+static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned int _a_high, unsigned int h, unsigned int o)
+{
+ unsigned int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = (*c).len;
+ while ((o < h) && (i < MaxBuf))
+ {
+ (*c).buf.array[i] = a[o];
+ o += 1;
+ i += 1;
+ }
+ if (o < h)
+ {
+ (*c).len = MaxBuf;
+ Storage_ALLOCATE ((void **) &(*c).next, sizeof (DynamicStrings_stringRecord));
+ (*c).next->head = NULL;
+ (*c).next->contents.len = 0;
+ (*c).next->contents.next = NULL;
+ ConcatContents (&(*c).next->contents, (const char *) a, _a_high, h, o);
+ AddDebugInfo ((*c).next);
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 722, (const char *) "ConcatContents", 14);
+ }
+ else
+ {
+ (*c).len = i;
+ }
+}
+
+
+/*
+ DeallocateCharStar - deallocates any charStar.
+*/
+
+static void DeallocateCharStar (DynamicStrings_String s)
+{
+ if ((s != NULL) && (s->head != NULL))
+ {
+ if (s->head->charStarUsed && (s->head->charStar != NULL))
+ {
+ Storage_DEALLOCATE (&s->head->charStar, s->head->charStarSize);
+ }
+ s->head->charStarUsed = FALSE;
+ s->head->charStar = NULL;
+ s->head->charStarSize = 0;
+ s->head->charStarValid = FALSE;
+ }
+}
+
+
+/*
+ CheckPoisoned - checks for a poisoned string, s.
+*/
+
+static DynamicStrings_String CheckPoisoned (DynamicStrings_String s)
+{
+ if (((PoisonOn && (s != NULL)) && (s->head != NULL)) && (s->head->state == DynamicStrings_poisoned))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ MarkInvalid - marks the char * version of String, s, as invalid.
+*/
+
+static void MarkInvalid (DynamicStrings_String s)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (s->head != NULL)
+ {
+ s->head->charStarValid = FALSE;
+ }
+}
+
+
+/*
+ ConcatContentsAddress - concatenate the string, a, where, h, is the
+ total length of, a.
+*/
+
+static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigned int h)
+{
+ typedef char *ConcatContentsAddress__T1;
+
+ ConcatContentsAddress__T1 p;
+ unsigned int i;
+ unsigned int j;
+
+ j = 0;
+ i = (*c).len;
+ p = static_cast<ConcatContentsAddress__T1> (a);
+ while ((j < h) && (i < MaxBuf))
+ {
+ (*c).buf.array[i] = (*p);
+ i += 1;
+ j += 1;
+ p += 1;
+ }
+ if (j < h)
+ {
+ /* avoid dangling else. */
+ (*c).len = MaxBuf;
+ Storage_ALLOCATE ((void **) &(*c).next, sizeof (DynamicStrings_stringRecord));
+ (*c).next->head = NULL;
+ (*c).next->contents.len = 0;
+ (*c).next->contents.next = NULL;
+ ConcatContentsAddress (&(*c).next->contents, reinterpret_cast<void *> (p), h-j);
+ AddDebugInfo ((*c).next);
+ if (TraceOn)
+ {
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 917, (const char *) "ConcatContentsAddress", 21);
+ }
+ }
+ else
+ {
+ (*c).len = i;
+ (*c).next = NULL;
+ }
+}
+
+
+/*
+ AddToGarbage - adds String, b, onto the garbage list of, a. Providing
+ the state of b is marked. The state is then altered to
+ onlist. String, a, is returned.
+*/
+
+static DynamicStrings_String AddToGarbage (DynamicStrings_String a, DynamicStrings_String b)
+{
+ DynamicStrings_String c;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ /*
+ IF (a#NIL) AND (a#b) AND (a^.head^.state=marked)
+ THEN
+ writeString('warning trying to add to a marked string') ; writeLn
+ END ;
+ */
+ if (((((a != b) && (a != NULL)) && (b != NULL)) && (b->head->state == DynamicStrings_marked)) && (a->head->state == DynamicStrings_inuse))
+ {
+ c = a;
+ while (c->head->garbage != NULL)
+ {
+ c = c->head->garbage;
+ }
+ c->head->garbage = b;
+ b->head->state = DynamicStrings_onlist;
+ if (CheckOn)
+ {
+ SubDebugInfo (b);
+ }
+ }
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsOnGarbage - returns TRUE if, s, is on string, e, garbage list.
+*/
+
+static unsigned int IsOnGarbage (DynamicStrings_String e, DynamicStrings_String s)
+{
+ if ((e != NULL) && (s != NULL))
+ {
+ while (e->head->garbage != NULL)
+ {
+ if (e->head->garbage == s)
+ {
+ return TRUE;
+ }
+ else
+ {
+ e = e->head->garbage;
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch)
+{
+ return (ch == ' ') || (ch == ASCII_tab);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DumpState -
+*/
+
+static void DumpState (DynamicStrings_String s)
+{
+ switch (s->head->state)
+ {
+ case DynamicStrings_inuse:
+ writeString ((const char *) "still in use (", 14);
+ writeCard (s->contents.len);
+ writeString ((const char *) ") characters", 12);
+ break;
+
+ case DynamicStrings_marked:
+ writeString ((const char *) "marked", 6);
+ break;
+
+ case DynamicStrings_onlist:
+ writeString ((const char *) "on a garbage list", 17);
+ break;
+
+ case DynamicStrings_poisoned:
+ writeString ((const char *) "poisoned", 8);
+ break;
+
+
+ default:
+ writeString ((const char *) "unknown state", 13);
+ break;
+ }
+}
+
+
+/*
+ DumpStringSynopsis -
+*/
+
+static void DumpStringSynopsis (DynamicStrings_String s)
+{
+ writeCstring (s->debug.file);
+ writeString ((const char *) ":", 1);
+ writeCard (s->debug.line);
+ writeString ((const char *) ":", 1);
+ writeCstring (s->debug.proc);
+ writeString ((const char *) " string ", 8);
+ writeAddress (reinterpret_cast<void *> (s));
+ writeString ((const char *) " ", 1);
+ DumpState (s);
+ if (IsOnAllocated (s))
+ {
+ writeString ((const char *) " globally allocated", 19);
+ }
+ else if (IsOnDeallocated (s))
+ {
+ /* avoid dangling else. */
+ writeString ((const char *) " globally deallocated", 21);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ writeString ((const char *) " globally unknown", 17);
+ }
+ writeLn ();
+}
+
+
+/*
+ DumpString - displays the contents of string, s.
+*/
+
+static void DumpString (DynamicStrings_String s)
+{
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ DumpStringSynopsis (s);
+ if ((s->head != NULL) && (s->head->garbage != NULL))
+ {
+ writeString ((const char *) "display chained strings on the garbage list", 43);
+ writeLn ();
+ t = s->head->garbage;
+ while (t != NULL)
+ {
+ DumpStringSynopsis (t);
+ t = t->head->garbage;
+ }
+ }
+ }
+}
+
+
+/*
+ Init - initialize the module.
+*/
+
+static void Init (void)
+{
+ if (! Initialized)
+ {
+ Initialized = TRUE;
+ frameHead = NULL;
+ DynamicStrings_PushAllocation ();
+ }
+}
+
+
+/*
+ InitString - creates and returns a String type object.
+ Initial contents are, a.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high)
+{
+ DynamicStrings_String s;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ Storage_ALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord));
+ s->contents.len = 0;
+ s->contents.next = NULL;
+ ConcatContents (&s->contents, (const char *) a, _a_high, StrLib_StrLen ((const char *) a, _a_high), 0);
+ Storage_ALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor));
+ s->head->charStarUsed = FALSE;
+ s->head->charStar = NULL;
+ s->head->charStarSize = 0;
+ s->head->charStarValid = FALSE;
+ s->head->garbage = NULL;
+ s->head->state = DynamicStrings_inuse;
+ AddDebugInfo (s);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 758, (const char *) "InitString", 10);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillString - frees String, s, and its contents.
+ NIL is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s)
+{
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (s != NULL)
+ {
+ if (CheckOn)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (IsOnAllocated (s))
+ {
+ SubAllocated (s);
+ }
+ else if (IsOnDeallocated (s))
+ {
+ /* avoid dangling else. */
+ SubDeallocated (s);
+ }
+ }
+ if (s->head != NULL)
+ {
+ s->head->state = DynamicStrings_poisoned;
+ s->head->garbage = DynamicStrings_KillString (s->head->garbage);
+ if (! PoisonOn)
+ {
+ DeallocateCharStar (s);
+ }
+ if (! PoisonOn)
+ {
+ Storage_DEALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor));
+ s->head = NULL;
+ }
+ }
+ t = DynamicStrings_KillString (s->contents.next);
+ if (! PoisonOn)
+ {
+ Storage_DEALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord));
+ }
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Fin - finishes with a string, it calls KillString with, s.
+ The purpose of the procedure is to provide a short cut
+ to calling KillString and then testing the return result.
+*/
+
+extern "C" void DynamicStrings_Fin (DynamicStrings_String s)
+{
+ if ((DynamicStrings_KillString (s)) != NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ InitStringCharStar - initializes and returns a String to contain the C string.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a)
+{
+ DynamicStrings_String s;
+
+ Storage_ALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord));
+ s->contents.len = 0;
+ s->contents.next = NULL;
+ if (a != NULL)
+ {
+ ConcatContentsAddress (&s->contents, a, static_cast<unsigned int> (libc_strlen (a)));
+ }
+ Storage_ALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor));
+ s->head->charStarUsed = FALSE;
+ s->head->charStar = NULL;
+ s->head->charStarSize = 0;
+ s->head->charStarValid = FALSE;
+ s->head->garbage = NULL;
+ s->head->state = DynamicStrings_inuse;
+ AddDebugInfo (s);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 957, (const char *) "InitStringCharStar", 18);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringChar - initializes and returns a String to contain the single character, ch.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch)
+{
+ typedef struct InitStringChar__T4_a InitStringChar__T4;
+
+ struct InitStringChar__T4_a { char array[1+1]; };
+ InitStringChar__T4 a;
+ DynamicStrings_String s;
+
+ a.array[0] = ch;
+ a.array[1] = ASCII_nul;
+ s = DynamicStrings_InitString ((const char *) &a.array[0], 1);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 977, (const char *) "InitStringChar", 14);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Mark - marks String, s, ready for garbage collection.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if ((s != NULL) && (s->head->state == DynamicStrings_inuse))
+ {
+ s->head->state = DynamicStrings_marked;
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Length - returns the length of the String, s.
+*/
+
+extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s)
+{
+ if (s == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ return s->contents.len+(DynamicStrings_Length (s->contents.next));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConCat - returns String, a, after the contents of, b, have been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b)
+{
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ if (a == b)
+ {
+ return DynamicStrings_ConCat (a, DynamicStrings_Mark (DynamicStrings_Dup (b)));
+ }
+ else if (a != NULL)
+ {
+ /* avoid dangling else. */
+ a = AddToGarbage (a, b);
+ MarkInvalid (a);
+ t = a;
+ while (b != NULL)
+ {
+ while ((t->contents.len == MaxBuf) && (t->contents.next != NULL))
+ {
+ t = t->contents.next;
+ }
+ ConcatContents (&t->contents, (const char *) &b->contents.buf.array[0], (MaxBuf-1), b->contents.len, 0);
+ b = b->contents.next;
+ }
+ }
+ if ((a == NULL) && (b != NULL))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConCatChar - returns String, a, after character, ch, has been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch)
+{
+ typedef struct ConCatChar__T5_a ConCatChar__T5;
+
+ struct ConCatChar__T5_a { char array[1+1]; };
+ ConCatChar__T5 b;
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ }
+ b.array[0] = ch;
+ b.array[1] = ASCII_nul;
+ t = a;
+ MarkInvalid (a);
+ while ((t->contents.len == MaxBuf) && (t->contents.next != NULL))
+ {
+ t = t->contents.next;
+ }
+ ConcatContents (&t->contents, (const char *) &b.array[0], 1, 1, 0);
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Assign - assigns the contents of, b, into, a.
+ String, a, is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b)
+{
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ if ((a != NULL) && (b != NULL))
+ {
+ a->contents.next = DynamicStrings_KillString (a->contents.next);
+ a->contents.len = 0;
+ }
+ return DynamicStrings_ConCat (a, b);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Dup - duplicate a String, s, returning the copy of s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ s = DynamicStrings_Assign (DynamicStrings_InitString ((const char *) "", 0), s);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1173, (const char *) "Dup", 3);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Add - returns a new String which contains the contents of a and b.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b)
+{
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ a = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "", 0), a), b);
+ if (TraceOn)
+ {
+ a = AssignDebug (a, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1193, (const char *) "Add", 3);
+ }
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Equal - returns TRUE if String, a, and, b, are equal.
+*/
+
+extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b)
+{
+ unsigned int i;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ if ((DynamicStrings_Length (a)) == (DynamicStrings_Length (b)))
+ {
+ while ((a != NULL) && (b != NULL))
+ {
+ i = 0;
+ Assertion_Assert (a->contents.len == b->contents.len);
+ while (i < a->contents.len)
+ {
+ if (a->contents.buf.array[i] != b->contents.buf.array[i])
+ {
+ return FALSE;
+ }
+ i += 1;
+ }
+ a = a->contents.next;
+ b = b->contents.next;
+ }
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EqualCharStar - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a)
+{
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ t = DynamicStrings_InitStringCharStar (a);
+ if (TraceOn)
+ {
+ t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1250, (const char *) "EqualCharStar", 13);
+ }
+ t = AddToGarbage (t, s);
+ if (DynamicStrings_Equal (t, s))
+ {
+ t = DynamicStrings_KillString (t);
+ return TRUE;
+ }
+ else
+ {
+ t = DynamicStrings_KillString (t);
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EqualArray - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high)
+{
+ DynamicStrings_String t;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ t = DynamicStrings_InitString ((const char *) a, _a_high);
+ if (TraceOn)
+ {
+ t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1280, (const char *) "EqualArray", 10);
+ }
+ t = AddToGarbage (t, s);
+ if (DynamicStrings_Equal (t, s))
+ {
+ t = DynamicStrings_KillString (t);
+ return TRUE;
+ }
+ else
+ {
+ t = DynamicStrings_KillString (t);
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Mult - returns a new string which is n concatenations of String, s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (n <= 0)
+ {
+ s = AddToGarbage (DynamicStrings_InitString ((const char *) "", 0), s);
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_Mult (s, n-1), s);
+ }
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1312, (const char *) "Mult", 4);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Slice - returns a new string which contains the elements
+ low..high-1
+
+ strings start at element 0
+ Slice(s, 0, 2) will return elements 0, 1 but not 2
+ Slice(s, 1, 3) will return elements 1, 2 but not 3
+ Slice(s, 2, 0) will return elements 2..max
+ Slice(s, 3, -1) will return elements 3..max-1
+ Slice(s, 4, -2) will return elements 4..max-2
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high)
+{
+ DynamicStrings_String d;
+ DynamicStrings_String t;
+ int start;
+ int end;
+ int o;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (low < 0)
+ {
+ low = ((int ) (DynamicStrings_Length (s)))+low;
+ }
+ if (high <= 0)
+ {
+ high = ((int ) (DynamicStrings_Length (s)))+high;
+ }
+ else
+ {
+ /* make sure high is <= Length (s) */
+ high = Min (DynamicStrings_Length (s), static_cast<unsigned int> (high));
+ }
+ d = DynamicStrings_InitString ((const char *) "", 0);
+ d = AddToGarbage (d, s);
+ o = 0;
+ t = d;
+ while (s != NULL)
+ {
+ if (low < (o+((int ) (s->contents.len))))
+ {
+ if (o > high)
+ {
+ s = NULL;
+ }
+ else
+ {
+ /* found sliceable unit */
+ if (low < o)
+ {
+ start = 0;
+ }
+ else
+ {
+ start = low-o;
+ }
+ end = Max (Min (MaxBuf, static_cast<unsigned int> (high-o)), 0);
+ while (t->contents.len == MaxBuf)
+ {
+ if (t->contents.next == NULL)
+ {
+ Storage_ALLOCATE ((void **) &t->contents.next, sizeof (DynamicStrings_stringRecord));
+ t->contents.next->head = NULL;
+ t->contents.next->contents.len = 0;
+ AddDebugInfo (t->contents.next);
+ if (TraceOn)
+ {
+ t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1380, (const char *) "Slice", 5);
+ }
+ }
+ t = t->contents.next;
+ }
+ ConcatContentsAddress (&t->contents, &s->contents.buf.array[start], static_cast<unsigned int> (end-start));
+ o += s->contents.len;
+ s = s->contents.next;
+ }
+ }
+ else
+ {
+ o += s->contents.len;
+ s = s->contents.next;
+ }
+ }
+ if (TraceOn)
+ {
+ d = AssignDebug (d, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1397, (const char *) "Slice", 5);
+ }
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Index - returns the indice of the first occurance of, ch, in
+ String, s. -1 is returned if, ch, does not exist.
+ The search starts at position, o.
+*/
+
+extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o)
+{
+ unsigned int i;
+ unsigned int k;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ k = 0;
+ while (s != NULL)
+ {
+ if ((k+s->contents.len) < o)
+ {
+ k += s->contents.len;
+ }
+ else
+ {
+ i = o-k;
+ while (i < s->contents.len)
+ {
+ if (s->contents.buf.array[i] == ch)
+ {
+ return k+i;
+ }
+ i += 1;
+ }
+ k += i;
+ o = k;
+ }
+ s = s->contents.next;
+ }
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RIndex - returns the indice of the last occurance of, ch,
+ in String, s. The search starts at position, o.
+ -1 is returned if, ch, is not found.
+*/
+
+extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o)
+{
+ unsigned int i;
+ unsigned int k;
+ int j;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ j = -1;
+ k = 0;
+ while (s != NULL)
+ {
+ if ((k+s->contents.len) < o)
+ {
+ k += s->contents.len;
+ }
+ else
+ {
+ if (o < k)
+ {
+ i = 0;
+ }
+ else
+ {
+ i = o-k;
+ }
+ while (i < s->contents.len)
+ {
+ if (s->contents.buf.array[i] == ch)
+ {
+ j = k;
+ }
+ k += 1;
+ i += 1;
+ }
+ }
+ s = s->contents.next;
+ }
+ return j;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveComment - assuming that, comment, is a comment delimiter
+ which indicates anything to its right is a comment
+ then strip off the comment and also any white space
+ on the remaining right hand side.
+ It leaves any white space on the left hand side alone.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment)
+{
+ int i;
+
+ i = DynamicStrings_Index (s, comment, 0);
+ if (i == 0)
+ {
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ }
+ else if (i > 0)
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_RemoveWhitePostfix (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i));
+ }
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1509, (const char *) "RemoveComment", 13);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveWhitePrefix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s)
+{
+ unsigned int i;
+
+ i = 0;
+ while (IsWhite (DynamicStrings_char (s, static_cast<int> (i))))
+ {
+ i += 1;
+ }
+ s = DynamicStrings_Slice (s, (int ) (i), 0);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1621, (const char *) "RemoveWhitePrefix", 17);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveWhitePostfix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s)
+{
+ int i;
+
+ i = ((int ) (DynamicStrings_Length (s)))-1;
+ while ((i >= 0) && (IsWhite (DynamicStrings_char (s, i))))
+ {
+ i -= 1;
+ }
+ s = DynamicStrings_Slice (s, 0, i+1);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1643, (const char *) "RemoveWhitePostfix", 18);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ToUpper - returns string, s, after it has had its lower case characters
+ replaced by upper case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s)
+{
+ char ch;
+ unsigned int i;
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ MarkInvalid (s);
+ t = s;
+ while (t != NULL)
+ {
+ i = 0;
+ while (i < t->contents.len)
+ {
+ ch = t->contents.buf.array[i];
+ if ((ch >= 'a') && (ch <= 'z'))
+ {
+ t->contents.buf.array[i] = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('a')))+ ((unsigned int) ('A'))));
+ }
+ i += 1;
+ }
+ t = t->contents.next;
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ToLower - returns string, s, after it has had its upper case characters
+ replaced by lower case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s)
+{
+ char ch;
+ unsigned int i;
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ MarkInvalid (s);
+ t = s;
+ while (t != NULL)
+ {
+ i = 0;
+ while (i < t->contents.len)
+ {
+ ch = t->contents.buf.array[i];
+ if ((ch >= 'A') && (ch <= 'Z'))
+ {
+ t->contents.buf.array[i] = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))));
+ }
+ i += 1;
+ }
+ t = t->contents.next;
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CopyOut - copies string, s, to a.
+*/
+
+extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s)
+{
+ unsigned int i;
+ unsigned int l;
+
+ l = Min (_a_high+1, DynamicStrings_Length (s));
+ i = 0;
+ while (i < l)
+ {
+ a[i] = DynamicStrings_char (s, static_cast<int> (i));
+ i += 1;
+ }
+ if (i <= _a_high)
+ {
+ a[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ char - returns the character, ch, at position, i, in String, s.
+*/
+
+extern "C" char DynamicStrings_char (DynamicStrings_String s, int i)
+{
+ unsigned int c;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (i < 0)
+ {
+ c = (unsigned int ) (((int ) (DynamicStrings_Length (s)))+i);
+ }
+ else
+ {
+ c = i;
+ }
+ while ((s != NULL) && (c >= s->contents.len))
+ {
+ c -= s->contents.len;
+ s = s->contents.next;
+ }
+ if ((s == NULL) || (c >= s->contents.len))
+ {
+ return ASCII_nul;
+ }
+ else
+ {
+ return s->contents.buf.array[c];
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ string - returns the C style char * of String, s.
+*/
+
+extern "C" void * DynamicStrings_string (DynamicStrings_String s)
+{
+ typedef char *string__T2;
+
+ DynamicStrings_String a;
+ unsigned int l;
+ unsigned int i;
+ string__T2 p;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (s == NULL)
+ {
+ return NULL;
+ }
+ else
+ {
+ if (! s->head->charStarValid)
+ {
+ l = DynamicStrings_Length (s);
+ if (! (s->head->charStarUsed && (s->head->charStarSize > l)))
+ {
+ DeallocateCharStar (s);
+ Storage_ALLOCATE (&s->head->charStar, l+1);
+ s->head->charStarSize = l+1;
+ s->head->charStarUsed = TRUE;
+ }
+ p = static_cast<string__T2> (s->head->charStar);
+ a = s;
+ while (a != NULL)
+ {
+ i = 0;
+ while (i < a->contents.len)
+ {
+ (*p) = a->contents.buf.array[i];
+ i += 1;
+ p += 1;
+ }
+ a = a->contents.next;
+ }
+ (*p) = ASCII_nul;
+ s->head->charStarValid = TRUE;
+ }
+ return s->head->charStar;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringDB - the debug version of InitString.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char a[_a_high+1];
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_InitString ((const char *) a, _a_high), (const char *) file, _file_high, line, (const char *) "InitString", 10);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringCharStarDB - the debug version of InitStringCharStar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_InitStringCharStar (a), (const char *) file, _file_high, line, (const char *) "InitStringCharStar", 18);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringCharDB - the debug version of InitStringChar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_InitStringChar (ch), (const char *) file, _file_high, line, (const char *) "InitStringChar", 14);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ MultDB - the debug version of MultDB.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_Mult (s, n), (const char *) file, _file_high, line, (const char *) "Mult", 4);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DupDB - the debug version of Dup.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_Dup (s), (const char *) file, _file_high, line, (const char *) "Dup", 3);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SliceDB - debug version of Slice.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ DSdbEnter ();
+ s = AssignDebug (DynamicStrings_Slice (s, low, high), (const char *) file, _file_high, line, (const char *) "Slice", 5);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PushAllocation - pushes the current allocation/deallocation lists.
+*/
+
+extern "C" void DynamicStrings_PushAllocation (void)
+{
+ DynamicStrings_frame f;
+
+ if (CheckOn)
+ {
+ Init ();
+ Storage_ALLOCATE ((void **) &f, sizeof (DynamicStrings_frameRec));
+ f->next = frameHead;
+ f->alloc = NULL;
+ f->dealloc = NULL;
+ frameHead = f;
+ }
+}
+
+
+/*
+ PopAllocation - test to see that all strings are deallocated since
+ the last push. Then it pops to the previous
+ allocation/deallocation lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" void DynamicStrings_PopAllocation (unsigned int halt)
+{
+ if (CheckOn)
+ {
+ if ((DynamicStrings_PopAllocationExemption (halt, NULL)) == NULL)
+ {} /* empty. */
+ }
+}
+
+
+/*
+ PopAllocationExemption - test to see that all strings are deallocated, except
+ string, e, since the last push.
+ Then it pops to the previous allocation/deallocation
+ lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e)
+{
+ DynamicStrings_String s;
+ DynamicStrings_frame f;
+ unsigned int b;
+
+ Init ();
+ if (CheckOn)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (frameHead == NULL)
+ {
+ stop ();
+ /* writeString ("mismatched number of PopAllocation's compared to PushAllocation's") */
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
+ }
+ else
+ {
+ if (frameHead->alloc != NULL)
+ {
+ b = FALSE;
+ s = frameHead->alloc;
+ while (s != NULL)
+ {
+ if (! (((e == s) || (IsOnGarbage (e, s))) || (IsOnGarbage (s, e))))
+ {
+ if (! b)
+ {
+ writeString ((const char *) "the following strings have been lost", 36);
+ writeLn ();
+ b = TRUE;
+ }
+ DumpStringInfo (s, 0);
+ }
+ s = s->debug.next;
+ }
+ if (b && halt)
+ {
+ libc_exit (1);
+ }
+ }
+ frameHead = frameHead->next;
+ }
+ }
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_DynamicStrings_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Initialized = FALSE;
+ Init ();
+}
+
+extern "C" void _M2_DynamicStrings_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from FIO. */
+/* FIO.mod provides a simple buffered file input/output library.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+#include <string.h>
+#include <limits.h>
+#include <stdlib.h>
+# include "GStorage.h"
+# include "Gmcrts.h"
+#include <unistd.h>
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _FIO_H
+#define _FIO_C
+
+# include "GSYSTEM.h"
+# include "GASCII.h"
+# include "GStrLib.h"
+# include "GStorage.h"
+# include "GNumberIO.h"
+# include "Glibc.h"
+# include "GIndexing.h"
+# include "GM2RTS.h"
+
+typedef unsigned int FIO_File;
+
+FIO_File FIO_StdErr;
+FIO_File FIO_StdOut;
+FIO_File FIO_StdIn;
+# define SEEK_SET 0
+# define SEEK_END 2
+# define UNIXREADONLY 0
+# define UNIXWRITEONLY 1
+# define CreatePermissions 0666
+# define MaxBufferLength (1024*16)
+# define MaxErrorString (1024*8)
+typedef struct FIO_NameInfo_r FIO_NameInfo;
+
+typedef struct FIO_buf_r FIO_buf;
+
+typedef FIO_buf *FIO_Buffer;
+
+typedef struct FIO_fds_r FIO_fds;
+
+typedef FIO_fds *FIO_FileDescriptor;
+
+typedef struct FIO__T7_a FIO__T7;
+
+typedef char *FIO_PtrToChar;
+
+typedef enum {FIO_successful, FIO_outofmemory, FIO_toomanyfilesopen, FIO_failed, FIO_connectionfailure, FIO_endofline, FIO_endoffile} FIO_FileStatus;
+
+typedef enum {FIO_unused, FIO_openedforread, FIO_openedforwrite, FIO_openedforrandom} FIO_FileUsage;
+
+struct FIO_NameInfo_r {
+ void *address;
+ unsigned int size;
+ };
+
+struct FIO_buf_r {
+ unsigned int valid;
+ long int bufstart;
+ unsigned int position;
+ void *address;
+ unsigned int filled;
+ unsigned int size;
+ unsigned int left;
+ FIO__T7 *contents;
+ };
+
+struct FIO__T7_a { char array[MaxBufferLength+1]; };
+struct FIO_fds_r {
+ int unixfd;
+ FIO_NameInfo name;
+ FIO_FileStatus state;
+ FIO_FileUsage usage;
+ unsigned int output;
+ FIO_Buffer buffer;
+ long int abspos;
+ };
+
+static Indexing_Index FileInfo;
+static FIO_File Error;
+
+/*
+ IsNoError - returns a TRUE if no error has occured on file, f.
+*/
+
+extern "C" unsigned int FIO_IsNoError (FIO_File f);
+
+/*
+ IsActive - returns TRUE if the file, f, is still active.
+*/
+
+extern "C" unsigned int FIO_IsActive (FIO_File f);
+extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile);
+
+/*
+ Close - close a file which has been previously opened using:
+ OpenToRead, OpenToWrite, OpenForRandom.
+ It is correct to close a file which has an error status.
+*/
+
+extern "C" void FIO_Close (FIO_File f);
+
+/*
+ exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int FIO_exists (void * fname, unsigned int flength);
+
+/*
+ openToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength);
+
+/*
+ openToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength);
+
+/*
+ openForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+*/
+
+extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile);
+
+/*
+ FlushBuffer - flush contents of file, f.
+*/
+
+extern "C" void FIO_FlushBuffer (FIO_File f);
+
+/*
+ ReadNBytes - reads nBytes of a file into memory area, dest, returning
+ the number of bytes actually read.
+ This function will consume from the buffer and then
+ perform direct libc reads. It is ideal for large reads.
+*/
+
+extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest);
+
+/*
+ ReadAny - reads HIGH(a) bytes into, a. All input
+ is fully buffered, unlike ReadNBytes and thus is more
+ suited to small reads.
+*/
+
+extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high);
+
+/*
+ WriteNBytes - writes nBytes from memory area src to a file
+ returning the number of bytes actually written.
+ This function will flush the buffer and then
+ write the nBytes using a direct write from libc.
+ It is ideal for large writes.
+*/
+
+extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src);
+
+/*
+ WriteAny - writes HIGH(a) bytes onto, file, f. All output
+ is fully buffered, unlike WriteNBytes and thus is more
+ suited to small writes.
+*/
+
+extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high);
+
+/*
+ WriteChar - writes a single character to file, f.
+*/
+
+extern "C" void FIO_WriteChar (FIO_File f, char ch);
+
+/*
+ EOF - tests to see whether a file, f, has reached end of file.
+*/
+
+extern "C" unsigned int FIO_EOF (FIO_File f);
+
+/*
+ EOLN - tests to see whether a file, f, is upon a newline.
+ It does NOT consume the newline.
+*/
+
+extern "C" unsigned int FIO_EOLN (FIO_File f);
+
+/*
+ WasEOLN - tests to see whether a file, f, has just seen a newline.
+*/
+
+extern "C" unsigned int FIO_WasEOLN (FIO_File f);
+
+/*
+ ReadChar - returns a character read from file f.
+ Sensible to check with IsNoError or EOF after calling
+ this function.
+*/
+
+extern "C" char FIO_ReadChar (FIO_File f);
+
+/*
+ UnReadChar - replaces a character, ch, back into file f.
+ This character must have been read by ReadChar
+ and it does not allow successive calls. It may
+ only be called if the previous read was successful
+ or end of file was seen.
+ If the state was previously endoffile then it
+ is altered to successful.
+ Otherwise it is left alone.
+*/
+
+extern "C" void FIO_UnReadChar (FIO_File f, char ch);
+
+/*
+ WriteLine - writes out a linefeed to file, f.
+*/
+
+extern "C" void FIO_WriteLine (FIO_File f);
+
+/*
+ WriteString - writes a string to file, f.
+*/
+
+extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high);
+
+/*
+ ReadString - reads a string from file, f, into string, a.
+ It terminates the string if HIGH is reached or
+ if a newline is seen or an error occurs.
+*/
+
+extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high);
+
+/*
+ WriteCardinal - writes a CARDINAL to file, f.
+ It writes the binary image of the cardinal
+ to file, f.
+*/
+
+extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c);
+
+/*
+ ReadCardinal - reads a CARDINAL from file, f.
+ It reads a binary image of a CARDINAL
+ from a file, f.
+*/
+
+extern "C" unsigned int FIO_ReadCardinal (FIO_File f);
+
+/*
+ GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+*/
+
+extern "C" int FIO_GetUnixFileDescriptor (FIO_File f);
+
+/*
+ SetPositionFromBeginning - sets the position from the beginning of the file.
+*/
+
+extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos);
+
+/*
+ SetPositionFromEnd - sets the position from the end of the file.
+*/
+
+extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos);
+
+/*
+ FindPosition - returns the current absolute position in file, f.
+*/
+
+extern "C" long int FIO_FindPosition (FIO_File f);
+
+/*
+ GetFileName - assigns, a, with the filename associated with, f.
+*/
+
+extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high);
+
+/*
+ getFileName - returns the address of the filename associated with, f.
+*/
+
+extern "C" void * FIO_getFileName (FIO_File f);
+
+/*
+ getFileNameLength - returns the number of characters associated with filename, f.
+*/
+
+extern "C" unsigned int FIO_getFileNameLength (FIO_File f);
+
+/*
+ FlushOutErr - flushes, StdOut, and, StdErr.
+ It is also called when the application calls M2RTS.Terminate.
+ (which is automatically placed in program modules by the GM2
+ scaffold).
+*/
+
+extern "C" void FIO_FlushOutErr (void);
+
+/*
+ Max - returns the maximum of two values.
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b);
+
+/*
+ Min - returns the minimum of two values.
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b);
+
+/*
+ GetNextFreeDescriptor - returns the index to the FileInfo array indicating
+ the next free slot.
+*/
+
+static FIO_File GetNextFreeDescriptor (void);
+
+/*
+ SetState - sets the field, state, of file, f, to, s.
+*/
+
+static void SetState (FIO_File f, FIO_FileStatus s);
+
+/*
+ InitializeFile - initialize a file descriptor
+*/
+
+static FIO_File InitializeFile (FIO_File f, void * fname, unsigned int flength, FIO_FileStatus fstate, FIO_FileUsage use, unsigned int towrite, unsigned int buflength);
+
+/*
+ ConnectToUnix - connects a FIO file to a UNIX file descriptor.
+*/
+
+static void ConnectToUnix (FIO_File f, unsigned int towrite, unsigned int newfile);
+
+/*
+ ReadFromBuffer - attempts to read, nBytes, from file, f.
+ It firstly consumes the buffer and then performs
+ direct unbuffered reads. This should only be used
+ when wishing to read large files.
+
+ The actual number of bytes read is returned.
+ -1 is returned if EOF is reached.
+*/
+
+static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes);
+
+/*
+ BufferedRead - will read, nBytes, through the buffer.
+ Similar to ReadFromBuffer, but this function will always
+ read into the buffer before copying into memory.
+
+ Useful when performing small reads.
+*/
+
+static int BufferedRead (FIO_File f, unsigned int nBytes, void * a);
+
+/*
+ HandleEscape - translates
+ and \t into their respective ascii codes.
+*/
+
+static void HandleEscape (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, unsigned int *i, unsigned int *j, unsigned int HighSrc, unsigned int HighDest);
+
+/*
+ Cast - casts a := b
+*/
+
+static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high);
+
+/*
+ StringFormat1 - converts string, src, into, dest, together with encapsulated
+ entity, w. It only formats the first %s or %d with n.
+*/
+
+static void StringFormat1 (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ FormatError - provides a orthoganal counterpart to the procedure below.
+*/
+
+static void FormatError (const char *a_, unsigned int _a_high);
+
+/*
+ FormatError1 - generic error procedure taking standard format string
+ and single parameter.
+*/
+
+static void FormatError1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ FormatError2 - generic error procedure taking standard format string
+ and two parameters.
+*/
+
+static void FormatError2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+
+/*
+ CheckAccess - checks to see whether a file f has been
+ opened for read/write.
+*/
+
+static void CheckAccess (FIO_File f, FIO_FileUsage use, unsigned int towrite);
+
+/*
+ SetEndOfLine -
+*/
+
+static void SetEndOfLine (FIO_File f, char ch);
+
+/*
+ BufferedWrite - will write, nBytes, through the buffer.
+ Similar to WriteNBytes, but this function will always
+ write into the buffer before copying into memory.
+
+ Useful when performing small writes.
+*/
+
+static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a);
+
+/*
+ PreInitialize - preinitialize the file descriptor.
+*/
+
+static void PreInitialize (FIO_File f, const char *fname_, unsigned int _fname_high, FIO_FileStatus state, FIO_FileUsage use, unsigned int towrite, int osfd, unsigned int bufsize);
+
+/*
+ Init - initialize the modules, global variables.
+*/
+
+static void Init (void);
+
+
+/*
+ Max - returns the maximum of two values.
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Min - returns the minimum of two values.
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetNextFreeDescriptor - returns the index to the FileInfo array indicating
+ the next free slot.
+*/
+
+static FIO_File GetNextFreeDescriptor (void)
+{
+ FIO_File f;
+ FIO_File h;
+ FIO_FileDescriptor fd;
+
+ f = Error+1;
+ h = Indexing_HighIndice (FileInfo);
+ for (;;)
+ {
+ if (f <= h)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ return f;
+ }
+ }
+ f += 1;
+ if (f > h)
+ {
+ Indexing_PutIndice (FileInfo, f, NULL); /* create new slot */
+ return f; /* create new slot */
+ }
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetState - sets the field, state, of file, f, to, s.
+*/
+
+static void SetState (FIO_File f, FIO_FileStatus s)
+{
+ FIO_FileDescriptor fd;
+
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ fd->state = s;
+}
+
+
+/*
+ InitializeFile - initialize a file descriptor
+*/
+
+static FIO_File InitializeFile (FIO_File f, void * fname, unsigned int flength, FIO_FileStatus fstate, FIO_FileUsage use, unsigned int towrite, unsigned int buflength)
+{
+ FIO_PtrToChar p;
+ FIO_FileDescriptor fd;
+
+ Storage_ALLOCATE ((void **) &fd, sizeof (FIO_fds));
+ if (fd == NULL)
+ {
+ SetState (Error, FIO_outofmemory);
+ return Error;
+ }
+ else
+ {
+ Indexing_PutIndice (FileInfo, f, reinterpret_cast<void *> (fd));
+ fd->name.size = flength+1; /* need to guarantee the nul for C */
+ fd->usage = use; /* need to guarantee the nul for C */
+ fd->output = towrite;
+ Storage_ALLOCATE (&fd->name.address, fd->name.size);
+ if (fd->name.address == NULL)
+ {
+ fd->state = FIO_outofmemory;
+ return f;
+ }
+ fd->name.address = libc_strncpy (fd->name.address, fname, flength);
+ /* and assign nul to the last byte */
+ p = static_cast<FIO_PtrToChar> (fd->name.address);
+ p += flength;
+ (*p) = ASCII_nul;
+ fd->abspos = 0;
+ /* now for the buffer */
+ Storage_ALLOCATE ((void **) &fd->buffer, sizeof (FIO_buf));
+ if (fd->buffer == NULL)
+ {
+ SetState (Error, FIO_outofmemory);
+ return Error;
+ }
+ else
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->bufstart = 0;
+ fd->buffer->size = buflength;
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ if (fd->buffer->size == 0)
+ {
+ fd->buffer->address = NULL;
+ }
+ else
+ {
+ Storage_ALLOCATE (&fd->buffer->address, fd->buffer->size);
+ if (fd->buffer->address == NULL)
+ {
+ fd->state = FIO_outofmemory;
+ return f;
+ }
+ }
+ if (towrite)
+ {
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->buffer->left = 0;
+ }
+ fd->buffer->contents = reinterpret_cast<FIO__T7 *> (fd->buffer->address); /* provides easy access for reading characters */
+ fd->state = fstate; /* provides easy access for reading characters */
+ }
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConnectToUnix - connects a FIO file to a UNIX file descriptor.
+*/
+
+static void ConnectToUnix (FIO_File f, unsigned int towrite, unsigned int newfile)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if (towrite)
+ {
+ if (newfile)
+ {
+ fd->unixfd = libc_creat (fd->name.address, CreatePermissions);
+ }
+ else
+ {
+ fd->unixfd = libc_open (fd->name.address, UNIXWRITEONLY, 0);
+ }
+ }
+ else
+ {
+ fd->unixfd = libc_open (fd->name.address, UNIXREADONLY, 0);
+ }
+ if (fd->unixfd < 0)
+ {
+ fd->state = FIO_connectionfailure;
+ }
+ }
+ }
+}
+
+
+/*
+ ReadFromBuffer - attempts to read, nBytes, from file, f.
+ It firstly consumes the buffer and then performs
+ direct unbuffered reads. This should only be used
+ when wishing to read large files.
+
+ The actual number of bytes read is returned.
+ -1 is returned if EOF is reached.
+*/
+
+static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes)
+{
+ typedef unsigned char *ReadFromBuffer__T1;
+
+ void * t;
+ int result;
+ unsigned int total;
+ unsigned int n;
+ ReadFromBuffer__T1 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ total = 0; /* how many bytes have we read */
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f)); /* how many bytes have we read */
+ /* extract from the buffer first */
+ if ((fd->buffer != NULL) && fd->buffer->valid)
+ {
+ if (fd->buffer->left > 0)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (nBytes == 1)
+ {
+ /* too expensive to call memcpy for 1 character */
+ p = static_cast<ReadFromBuffer__T1> (a);
+ (*p) = static_cast<unsigned char> ((*fd->buffer->contents).array[fd->buffer->position]);
+ fd->buffer->left -= 1; /* remove consumed bytes */
+ fd->buffer->position += 1; /* move onwards n bytes */
+ nBytes = 0;
+ /* read */
+ return 1;
+ }
+ else
+ {
+ n = Min (fd->buffer->left, nBytes);
+ t = fd->buffer->address;
+ t = reinterpret_cast<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
+ p = static_cast<ReadFromBuffer__T1> (libc_memcpy (a, t, static_cast<size_t> (n)));
+ fd->buffer->left -= n; /* remove consumed bytes */
+ fd->buffer->position += n; /* move onwards n bytes */
+ /* move onwards ready for direct reads */
+ a = reinterpret_cast<void *> (reinterpret_cast<char *> (a)+n);
+ nBytes -= n; /* reduce the amount for future direct */
+ /* read */
+ total += n;
+ return total; /* much cleaner to return now, */
+ }
+ /* difficult to record an error if */
+ }
+ /* the read below returns -1 */
+ }
+ if (nBytes > 0)
+ {
+ /* still more to read */
+ result = static_cast<int> (libc_read (fd->unixfd, a, static_cast<size_t> ((int ) (nBytes))));
+ if (result > 0)
+ {
+ /* avoid dangling else. */
+ total += result;
+ fd->abspos += result;
+ /* now disable the buffer as we read directly into, a. */
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ }
+ }
+ else
+ {
+ if (result == 0)
+ {
+ /* eof reached */
+ fd->state = FIO_endoffile;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ }
+ /* indicate buffer is empty */
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->left = 0;
+ fd->buffer->position = 0;
+ if (fd->buffer->address != NULL)
+ {
+ (*fd->buffer->contents).array[fd->buffer->position] = ASCII_nul;
+ }
+ }
+ return -1;
+ }
+ }
+ return total;
+ }
+ else
+ {
+ return -1;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ BufferedRead - will read, nBytes, through the buffer.
+ Similar to ReadFromBuffer, but this function will always
+ read into the buffer before copying into memory.
+
+ Useful when performing small reads.
+*/
+
+static int BufferedRead (FIO_File f, unsigned int nBytes, void * a)
+{
+ typedef unsigned char *BufferedRead__T3;
+
+ void * t;
+ int result;
+ int total;
+ int n;
+ BufferedRead__T3 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ total = 0; /* how many bytes have we read */
+ if (fd != NULL) /* how many bytes have we read */
+ {
+ /* extract from the buffer first */
+ if (fd->buffer != NULL)
+ {
+ while (nBytes > 0)
+ {
+ if ((fd->buffer->left > 0) && fd->buffer->valid)
+ {
+ if (nBytes == 1)
+ {
+ /* too expensive to call memcpy for 1 character */
+ p = static_cast<BufferedRead__T3> (a);
+ (*p) = static_cast<unsigned char> ((*fd->buffer->contents).array[fd->buffer->position]);
+ fd->buffer->left -= 1; /* remove consumed byte */
+ fd->buffer->position += 1; /* move onwards n byte */
+ total += 1; /* move onwards n byte */
+ return total;
+ }
+ else
+ {
+ n = Min (fd->buffer->left, nBytes);
+ t = fd->buffer->address;
+ t = reinterpret_cast<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
+ p = static_cast<BufferedRead__T3> (libc_memcpy (a, t, static_cast<size_t> (n)));
+ fd->buffer->left -= n; /* remove consumed bytes */
+ fd->buffer->position += n; /* move onwards n bytes */
+ /* move onwards ready for direct reads */
+ a = reinterpret_cast<void *> (reinterpret_cast<char *> (a)+n);
+ nBytes -= n; /* reduce the amount for future direct */
+ /* read */
+ total += n;
+ }
+ }
+ else
+ {
+ /* refill buffer */
+ n = static_cast<int> (libc_read (fd->unixfd, fd->buffer->address, static_cast<size_t> (fd->buffer->size)));
+ if (n >= 0)
+ {
+ /* avoid dangling else. */
+ fd->buffer->valid = TRUE;
+ fd->buffer->position = 0;
+ fd->buffer->left = n;
+ fd->buffer->filled = n;
+ fd->buffer->bufstart = fd->abspos;
+ fd->abspos += n;
+ if (n == 0)
+ {
+ /* eof reached */
+ fd->state = FIO_endoffile;
+ return -1;
+ }
+ }
+ else
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->position = 0;
+ fd->buffer->left = 0;
+ fd->buffer->filled = 0;
+ fd->state = FIO_failed;
+ return total;
+ }
+ }
+ }
+ return total;
+ }
+ }
+ }
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ HandleEscape - translates
+ and \t into their respective ascii codes.
+*/
+
+static void HandleEscape (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, unsigned int *i, unsigned int *j, unsigned int HighSrc, unsigned int HighDest)
+{
+ char src[_src_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (src, src_, _src_high+1);
+
+ if (((((*i)+1) < HighSrc) && (src[(*i)] == '\\')) && ((*j) < HighDest))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (src[(*i)+1] == 'n')
+ {
+ /* requires a newline */
+ dest[(*j)] = ASCII_nl;
+ (*j) += 1;
+ (*i) += 2;
+ }
+ else if (src[(*i)+1] == 't')
+ {
+ /* avoid dangling else. */
+ /* requires a tab (yuck) tempted to fake this but I better not.. */
+ dest[(*j)] = ASCII_tab;
+ (*j) += 1;
+ (*i) += 2;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ /* copy escaped character */
+ (*i) += 1;
+ dest[(*j)] = src[(*i)];
+ (*j) += 1;
+ (*i) += 1;
+ }
+ }
+}
+
+
+/*
+ Cast - casts a := b
+*/
+
+static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (b, b_, _b_high+1);
+
+ if (_a_high == _b_high)
+ {
+ for (i=0; i<=_a_high; i++)
+ {
+ a[i] = b[i];
+ }
+ }
+ else
+ {
+ FormatError ((const char *) "cast failed", 11);
+ }
+}
+
+
+/*
+ StringFormat1 - converts string, src, into, dest, together with encapsulated
+ entity, w. It only formats the first %s or %d with n.
+*/
+
+static void StringFormat1 (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, const unsigned char *w_, unsigned int _w_high)
+{
+ typedef struct StringFormat1__T8_a StringFormat1__T8;
+
+ typedef char *StringFormat1__T4;
+
+ struct StringFormat1__T8_a { char array[MaxErrorString+1]; };
+ unsigned int HighSrc;
+ unsigned int HighDest;
+ unsigned int c;
+ unsigned int i;
+ unsigned int j;
+ StringFormat1__T8 str;
+ StringFormat1__T4 p;
+ char src[_src_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (src, src_, _src_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ HighSrc = StrLib_StrLen ((const char *) src, _src_high);
+ HighDest = _dest_high;
+ p = NULL;
+ c = 0;
+ i = 0;
+ j = 0;
+ while ((((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest)) && (src[i] != '%'))
+ {
+ if (src[i] == '\\')
+ {
+ HandleEscape ((char *) dest, _dest_high, (const char *) src, _src_high, &i, &j, HighSrc, HighDest);
+ }
+ else
+ {
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ }
+ if ((((i+1) < HighSrc) && (src[i] == '%')) && (j < HighDest))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (src[i+1] == 's')
+ {
+ Cast ((unsigned char *) &p, (sizeof (p)-1), (const unsigned char *) w, _w_high);
+ while ((j < HighDest) && ((*p) != ASCII_nul))
+ {
+ dest[j] = (*p);
+ j += 1;
+ p += 1;
+ }
+ if (j < HighDest)
+ {
+ dest[j] = ASCII_nul;
+ }
+ j = StrLib_StrLen ((const char *) dest, _dest_high);
+ i += 2;
+ }
+ else if (src[i+1] == 'd')
+ {
+ /* avoid dangling else. */
+ dest[j] = ASCII_nul;
+ Cast ((unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) w, _w_high);
+ NumberIO_CardToStr (c, 0, (char *) &str.array[0], MaxErrorString);
+ StrLib_StrConCat ((const char *) dest, _dest_high, (const char *) &str.array[0], MaxErrorString, (char *) dest, _dest_high);
+ j = StrLib_StrLen ((const char *) dest, _dest_high);
+ i += 2;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ }
+ /* and finish off copying src into dest */
+ while (((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest))
+ {
+ if (src[i] == '\\')
+ {
+ HandleEscape ((char *) dest, _dest_high, (const char *) src, _src_high, &i, &j, HighSrc, HighDest);
+ }
+ else
+ {
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ }
+ if (j < HighDest)
+ {
+ dest[j] = ASCII_nul;
+ }
+}
+
+
+/*
+ FormatError - provides a orthoganal counterpart to the procedure below.
+*/
+
+static void FormatError (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ FIO_WriteString (FIO_StdErr, (const char *) a, _a_high);
+}
+
+
+/*
+ FormatError1 - generic error procedure taking standard format string
+ and single parameter.
+*/
+
+static void FormatError1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high)
+{
+ typedef struct FormatError1__T9_a FormatError1__T9;
+
+ struct FormatError1__T9_a { char array[MaxErrorString+1]; };
+ FormatError1__T9 s;
+ char a[_a_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ StringFormat1 ((char *) &s.array[0], MaxErrorString, (const char *) a, _a_high, (const unsigned char *) w, _w_high);
+ FormatError ((const char *) &s.array[0], MaxErrorString);
+}
+
+
+/*
+ FormatError2 - generic error procedure taking standard format string
+ and two parameters.
+*/
+
+static void FormatError2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high)
+{
+ typedef struct FormatError2__T10_a FormatError2__T10;
+
+ struct FormatError2__T10_a { char array[MaxErrorString+1]; };
+ FormatError2__T10 s;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+
+ StringFormat1 ((char *) &s.array[0], MaxErrorString, (const char *) a, _a_high, (const unsigned char *) w1, _w1_high);
+ FormatError1 ((const char *) &s.array[0], MaxErrorString, (const unsigned char *) w2, _w2_high);
+}
+
+
+/*
+ CheckAccess - checks to see whether a file f has been
+ opened for read/write.
+*/
+
+static void CheckAccess (FIO_File f, FIO_FileUsage use, unsigned int towrite)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ /* avoid dangling else. */
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ if (f != FIO_StdErr)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ }
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ if ((use == FIO_openedforwrite) && (fd->usage == FIO_openedforread))
+ {
+ FormatError1 ((const char *) "this file (%s) has been opened for reading but is now being written\\n", 69, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else if ((use == FIO_openedforread) && (fd->usage == FIO_openedforwrite))
+ {
+ /* avoid dangling else. */
+ FormatError1 ((const char *) "this file (%s) has been opened for writing but is now being read\\n", 66, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else if (fd->state == FIO_connectionfailure)
+ {
+ /* avoid dangling else. */
+ FormatError1 ((const char *) "this file (%s) was not successfully opened\\n", 44, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else if (towrite != fd->output)
+ {
+ /* avoid dangling else. */
+ if (fd->output)
+ {
+ FormatError1 ((const char *) "this file (%s) was opened for writing but is now being read\\n", 61, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ FormatError1 ((const char *) "this file (%s) was opened for reading but is now being written\\n", 64, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ }
+ }
+ }
+ else
+ {
+ FormatError ((const char *) "this file has not been opened successfully\\n", 44);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ SetEndOfLine -
+*/
+
+static void SetEndOfLine (FIO_File f, char ch)
+{
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (ch == ASCII_nl)
+ {
+ fd->state = FIO_endofline;
+ }
+ else
+ {
+ fd->state = FIO_successful;
+ }
+ }
+}
+
+
+/*
+ BufferedWrite - will write, nBytes, through the buffer.
+ Similar to WriteNBytes, but this function will always
+ write into the buffer before copying into memory.
+
+ Useful when performing small writes.
+*/
+
+static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a)
+{
+ typedef unsigned char *BufferedWrite__T5;
+
+ void * t;
+ int result;
+ int total;
+ int n;
+ BufferedWrite__T5 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ total = 0; /* how many bytes have we read */
+ if (fd->buffer != NULL) /* how many bytes have we read */
+ {
+ /* place into the buffer first */
+ while (nBytes > 0)
+ {
+ if (fd->buffer->left > 0)
+ {
+ if (nBytes == 1)
+ {
+ /* too expensive to call memcpy for 1 character */
+ p = static_cast<BufferedWrite__T5> (a);
+ (*fd->buffer->contents).array[fd->buffer->position] = static_cast<char> ((*p));
+ fd->buffer->left -= 1; /* reduce space */
+ fd->buffer->position += 1; /* move onwards n byte */
+ total += 1; /* move onwards n byte */
+ return total;
+ }
+ else
+ {
+ n = Min (fd->buffer->left, nBytes);
+ t = fd->buffer->address;
+ t = reinterpret_cast<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
+ p = static_cast<BufferedWrite__T5> (libc_memcpy (a, t, static_cast<size_t> ((unsigned int ) (n))));
+ fd->buffer->left -= n; /* remove consumed bytes */
+ fd->buffer->position += n; /* move onwards n bytes */
+ /* move ready for further writes */
+ a = reinterpret_cast<void *> (reinterpret_cast<char *> (a)+n);
+ nBytes -= n; /* reduce the amount for future writes */
+ total += n; /* reduce the amount for future writes */
+ }
+ }
+ else
+ {
+ FIO_FlushBuffer (f);
+ if ((fd->state != FIO_successful) && (fd->state != FIO_endofline))
+ {
+ nBytes = 0;
+ }
+ }
+ }
+ return total;
+ }
+ }
+ }
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PreInitialize - preinitialize the file descriptor.
+*/
+
+static void PreInitialize (FIO_File f, const char *fname_, unsigned int _fname_high, FIO_FileStatus state, FIO_FileUsage use, unsigned int towrite, int osfd, unsigned int bufsize)
+{
+ FIO_FileDescriptor fd;
+ FIO_FileDescriptor fe;
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ if ((InitializeFile (f, &fname, StrLib_StrLen ((const char *) fname, _fname_high), state, use, towrite, bufsize)) == f)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (f == Error)
+ {
+ fe = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, FIO_StdErr));
+ if (fe == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ fd->unixfd = fe->unixfd; /* the error channel */
+ }
+ }
+ else
+ {
+ fd->unixfd = osfd;
+ }
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ Init - initialize the modules, global variables.
+*/
+
+static void Init (void)
+{
+ FileInfo = Indexing_InitIndex (0);
+ Error = 0;
+ PreInitialize (Error, (const char *) "error", 5, FIO_toomanyfilesopen, FIO_unused, FALSE, -1, 0);
+ FIO_StdIn = 1;
+ PreInitialize (FIO_StdIn, (const char *) "<stdin>", 7, FIO_successful, FIO_openedforread, FALSE, 0, MaxBufferLength);
+ FIO_StdOut = 2;
+ PreInitialize (FIO_StdOut, (const char *) "<stdout>", 8, FIO_successful, FIO_openedforwrite, TRUE, 1, MaxBufferLength);
+ FIO_StdErr = 3;
+ PreInitialize (FIO_StdErr, (const char *) "<stderr>", 8, FIO_successful, FIO_openedforwrite, TRUE, 2, MaxBufferLength);
+ if (! (M2RTS_InstallTerminationProcedure ((PROC ) {(PROC_t) FIO_FlushOutErr})))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ IsNoError - returns a TRUE if no error has occured on file, f.
+*/
+
+extern "C" unsigned int FIO_IsNoError (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f == Error)
+ {
+ return FALSE;
+ }
+ else
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ return (fd != NULL) && (((fd->state == FIO_successful) || (fd->state == FIO_endoffile)) || (fd->state == FIO_endofline));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsActive - returns TRUE if the file, f, is still active.
+*/
+
+extern "C" unsigned int FIO_IsActive (FIO_File f)
+{
+ if (f == Error)
+ {
+ return FALSE;
+ }
+ else
+ {
+ return (Indexing_GetIndice (FileInfo, f)) != NULL;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ /*
+ The following functions are wrappers for the above.
+ */
+ return FIO_exists (&fname, StrLib_StrLen ((const char *) fname, _fname_high));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ return FIO_openToRead (&fname, StrLib_StrLen ((const char *) fname, _fname_high));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ return FIO_openToWrite (&fname, StrLib_StrLen ((const char *) fname, _fname_high));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ return FIO_openForRandom (&fname, StrLib_StrLen ((const char *) fname, _fname_high), towrite, newfile);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Close - close a file which has been previously opened using:
+ OpenToRead, OpenToWrite, OpenForRandom.
+ It is correct to close a file which has an error status.
+*/
+
+extern "C" void FIO_Close (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ /*
+ we allow users to close files which have an error status
+ */
+ if (fd != NULL)
+ {
+ FIO_FlushBuffer (f);
+ if (fd->unixfd >= 0)
+ {
+ if ((libc_close (fd->unixfd)) != 0)
+ {
+ FormatError1 ((const char *) "failed to close file (%s)\\n", 27, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ fd->state = FIO_failed; /* --fixme-- too late to notify user (unless we return a BOOLEAN) */
+ }
+ }
+ if (fd->name.address != NULL)
+ {
+ Storage_DEALLOCATE (&fd->name.address, fd->name.size);
+ }
+ if (fd->buffer != NULL)
+ {
+ if (fd->buffer->address != NULL)
+ {
+ Storage_DEALLOCATE (&fd->buffer->address, fd->buffer->size);
+ }
+ Storage_DEALLOCATE ((void **) &fd->buffer, sizeof (FIO_buf));
+ fd->buffer = NULL;
+ }
+ Storage_DEALLOCATE ((void **) &fd, sizeof (FIO_fds));
+ Indexing_PutIndice (FileInfo, f, NULL);
+ }
+ }
+}
+
+
+/*
+ exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int FIO_exists (void * fname, unsigned int flength)
+{
+ FIO_File f;
+
+ f = FIO_openToRead (fname, flength);
+ if (FIO_IsNoError (f))
+ {
+ FIO_Close (f);
+ return TRUE;
+ }
+ else
+ {
+ FIO_Close (f);
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength)
+{
+ FIO_File f;
+
+ f = GetNextFreeDescriptor ();
+ if (f == Error)
+ {
+ SetState (f, FIO_toomanyfilesopen);
+ }
+ else
+ {
+ f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforread, FALSE, MaxBufferLength);
+ ConnectToUnix (f, FALSE, FALSE);
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength)
+{
+ FIO_File f;
+
+ f = GetNextFreeDescriptor ();
+ if (f == Error)
+ {
+ SetState (f, FIO_toomanyfilesopen);
+ }
+ else
+ {
+ f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforwrite, TRUE, MaxBufferLength);
+ ConnectToUnix (f, TRUE, TRUE);
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+*/
+
+extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile)
+{
+ FIO_File f;
+
+ f = GetNextFreeDescriptor ();
+ if (f == Error)
+ {
+ SetState (f, FIO_toomanyfilesopen);
+ }
+ else
+ {
+ f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforrandom, towrite, MaxBufferLength);
+ ConnectToUnix (f, towrite, newfile);
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FlushBuffer - flush contents of file, f.
+*/
+
+extern "C" void FIO_FlushBuffer (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if (fd->output && (fd->buffer != NULL))
+ {
+ if ((fd->buffer->position == 0) || ((libc_write (fd->unixfd, fd->buffer->address, static_cast<size_t> (fd->buffer->position))) == ((int ) (fd->buffer->position))))
+ {
+ fd->abspos += fd->buffer->position;
+ fd->buffer->bufstart = fd->abspos;
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ }
+ }
+ }
+ }
+}
+
+
+/*
+ ReadNBytes - reads nBytes of a file into memory area, dest, returning
+ the number of bytes actually read.
+ This function will consume from the buffer and then
+ perform direct libc reads. It is ideal for large reads.
+*/
+
+extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest)
+{
+ typedef char *ReadNBytes__T2;
+
+ int n;
+ ReadNBytes__T2 p;
+
+ if (f != Error)
+ {
+ CheckAccess (f, FIO_openedforread, FALSE);
+ n = ReadFromBuffer (f, dest, nBytes);
+ if (n <= 0)
+ {
+ return 0;
+ }
+ else
+ {
+ p = static_cast<ReadNBytes__T2> (dest);
+ p += n-1;
+ SetEndOfLine (f, (*p));
+ return n;
+ }
+ }
+ else
+ {
+ return 0;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ReadAny - reads HIGH(a) bytes into, a. All input
+ is fully buffered, unlike ReadNBytes and thus is more
+ suited to small reads.
+*/
+
+extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high)
+{
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if ((BufferedRead (f, _a_high, a)) == ((int ) (_a_high)))
+ {
+ SetEndOfLine (f, static_cast<char> (a[_a_high]));
+ }
+}
+
+
+/*
+ WriteNBytes - writes nBytes from memory area src to a file
+ returning the number of bytes actually written.
+ This function will flush the buffer and then
+ write the nBytes using a direct write from libc.
+ It is ideal for large writes.
+*/
+
+extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src)
+{
+ int total;
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforwrite, TRUE);
+ FIO_FlushBuffer (f);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ total = static_cast<int> (libc_write (fd->unixfd, src, static_cast<size_t> ((int ) (nBytes))));
+ if (total < 0)
+ {
+ fd->state = FIO_failed;
+ return 0;
+ }
+ else
+ {
+ fd->abspos += (unsigned int ) (total);
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->bufstart = fd->abspos;
+ }
+ return (unsigned int ) (total);
+ }
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteAny - writes HIGH(a) bytes onto, file, f. All output
+ is fully buffered, unlike WriteNBytes and thus is more
+ suited to small writes.
+*/
+
+extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high)
+{
+ CheckAccess (f, FIO_openedforwrite, TRUE);
+ if ((BufferedWrite (f, _a_high, a)) == ((int ) (_a_high)))
+ {} /* empty. */
+}
+
+
+/*
+ WriteChar - writes a single character to file, f.
+*/
+
+extern "C" void FIO_WriteChar (FIO_File f, char ch)
+{
+ CheckAccess (f, FIO_openedforwrite, TRUE);
+ if ((BufferedWrite (f, sizeof (ch), &ch)) == ((int ) (sizeof (ch))))
+ {} /* empty. */
+}
+
+
+/*
+ EOF - tests to see whether a file, f, has reached end of file.
+*/
+
+extern "C" unsigned int FIO_EOF (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ return fd->state == FIO_endoffile;
+ }
+ }
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EOLN - tests to see whether a file, f, is upon a newline.
+ It does NOT consume the newline.
+*/
+
+extern "C" unsigned int FIO_EOLN (FIO_File f)
+{
+ char ch;
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ /*
+ we will read a character and then push it back onto the input stream,
+ having noted the file status, we also reset the status.
+ */
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if ((fd->state == FIO_successful) || (fd->state == FIO_endofline))
+ {
+ ch = FIO_ReadChar (f);
+ if ((fd->state == FIO_successful) || (fd->state == FIO_endofline))
+ {
+ FIO_UnReadChar (f, ch);
+ }
+ return ch == ASCII_nl;
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WasEOLN - tests to see whether a file, f, has just seen a newline.
+*/
+
+extern "C" unsigned int FIO_WasEOLN (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f == Error)
+ {
+ return FALSE;
+ }
+ else
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ return (fd != NULL) && (fd->state == FIO_endofline);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ReadChar - returns a character read from file f.
+ Sensible to check with IsNoError or EOF after calling
+ this function.
+*/
+
+extern "C" char FIO_ReadChar (FIO_File f)
+{
+ char ch;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if ((BufferedRead (f, sizeof (ch), &ch)) == ((int ) (sizeof (ch))))
+ {
+ SetEndOfLine (f, ch);
+ return ch;
+ }
+ else
+ {
+ return ASCII_nul;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ UnReadChar - replaces a character, ch, back into file f.
+ This character must have been read by ReadChar
+ and it does not allow successive calls. It may
+ only be called if the previous read was successful
+ or end of file was seen.
+ If the state was previously endoffile then it
+ is altered to successful.
+ Otherwise it is left alone.
+*/
+
+extern "C" void FIO_UnReadChar (FIO_File f, char ch)
+{
+ FIO_FileDescriptor fd;
+ unsigned int n;
+ void * a;
+ void * b;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (((fd->state == FIO_successful) || (fd->state == FIO_endoffile)) || (fd->state == FIO_endofline))
+ {
+ /* avoid dangling else. */
+ if ((fd->buffer != NULL) && fd->buffer->valid)
+ {
+ /* we assume that a ReadChar has occurred, we will check just in case. */
+ if (fd->state == FIO_endoffile)
+ {
+ fd->buffer->position = MaxBufferLength;
+ fd->buffer->left = 0;
+ fd->buffer->filled = 0;
+ fd->state = FIO_successful;
+ }
+ if (fd->buffer->position > 0)
+ {
+ fd->buffer->position -= 1;
+ fd->buffer->left += 1;
+ (*fd->buffer->contents).array[fd->buffer->position] = ch;
+ }
+ else
+ {
+ /* if possible make room and store ch */
+ if (fd->buffer->filled == fd->buffer->size)
+ {
+ FormatError1 ((const char *) "performing too many UnReadChar calls on file (%d)\\n", 51, (const unsigned char *) &f, (sizeof (f)-1));
+ }
+ else
+ {
+ n = fd->buffer->filled-fd->buffer->position;
+ b = &(*fd->buffer->contents).array[fd->buffer->position];
+ a = &(*fd->buffer->contents).array[fd->buffer->position+1];
+ a = libc_memcpy (a, b, static_cast<size_t> (n));
+ fd->buffer->filled += 1;
+ (*fd->buffer->contents).array[fd->buffer->position] = ch;
+ }
+ }
+ }
+ }
+ else
+ {
+ FormatError1 ((const char *) "UnReadChar can only be called if the previous read was successful or end of file, error on file (%d)\\n", 102, (const unsigned char *) &f, (sizeof (f)-1));
+ }
+ }
+}
+
+
+/*
+ WriteLine - writes out a linefeed to file, f.
+*/
+
+extern "C" void FIO_WriteLine (FIO_File f)
+{
+ FIO_WriteChar (f, ASCII_nl);
+}
+
+
+/*
+ WriteString - writes a string to file, f.
+*/
+
+extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high)
+{
+ unsigned int l;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ l = StrLib_StrLen ((const char *) a, _a_high);
+ if ((FIO_WriteNBytes (f, l, &a)) != l)
+ {} /* empty. */
+}
+
+
+/*
+ ReadString - reads a string from file, f, into string, a.
+ It terminates the string if HIGH is reached or
+ if a newline is seen or an error occurs.
+*/
+
+extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high)
+{
+ unsigned int high;
+ unsigned int i;
+ char ch;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ high = _a_high;
+ i = 0;
+ do {
+ ch = FIO_ReadChar (f);
+ if (i <= high)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (((ch == ASCII_nl) || (! (FIO_IsNoError (f)))) || (FIO_EOF (f)))
+ {
+ a[i] = ASCII_nul;
+ i += 1;
+ }
+ else
+ {
+ a[i] = ch;
+ i += 1;
+ }
+ }
+ } while (! ((((ch == ASCII_nl) || (i > high)) || (! (FIO_IsNoError (f)))) || (FIO_EOF (f))));
+}
+
+
+/*
+ WriteCardinal - writes a CARDINAL to file, f.
+ It writes the binary image of the cardinal
+ to file, f.
+*/
+
+extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c)
+{
+ FIO_WriteAny (f, (unsigned char *) &c, (sizeof (c)-1));
+}
+
+
+/*
+ ReadCardinal - reads a CARDINAL from file, f.
+ It reads a binary image of a CARDINAL
+ from a file, f.
+*/
+
+extern "C" unsigned int FIO_ReadCardinal (FIO_File f)
+{
+ unsigned int c;
+
+ FIO_ReadAny (f, (unsigned char *) &c, (sizeof (c)-1));
+ return c;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+*/
+
+extern "C" int FIO_GetUnixFileDescriptor (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ return fd->unixfd;
+ }
+ }
+ FormatError1 ((const char *) "file %d has not been opened or is out of range\\n", 48, (const unsigned char *) &f, (sizeof (f)-1));
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetPositionFromBeginning - sets the position from the beginning of the file.
+*/
+
+extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos)
+{
+ long int offset;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ /* always force the lseek, until we are confident that abspos is always correct,
+ basically it needs some hard testing before we should remove the OR TRUE. */
+ if ((fd->abspos != pos) || TRUE)
+ {
+ FIO_FlushBuffer (f);
+ if (fd->buffer != NULL)
+ {
+ if (fd->output)
+ {
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->buffer->left = 0;
+ }
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ }
+ offset = libc_lseek (fd->unixfd, pos, SEEK_SET);
+ if ((offset >= 0) && (pos == offset))
+ {
+ fd->abspos = pos;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ fd->abspos = 0;
+ }
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->bufstart = fd->abspos;
+ }
+ }
+ }
+ }
+}
+
+
+/*
+ SetPositionFromEnd - sets the position from the end of the file.
+*/
+
+extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos)
+{
+ long int offset;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ FIO_FlushBuffer (f);
+ if (fd->buffer != NULL)
+ {
+ if (fd->output)
+ {
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->buffer->left = 0;
+ }
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ }
+ offset = libc_lseek (fd->unixfd, pos, SEEK_END);
+ if (offset >= 0)
+ {
+ fd->abspos = offset;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ fd->abspos = 0;
+ offset = 0;
+ }
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->bufstart = offset;
+ }
+ }
+ }
+}
+
+
+/*
+ FindPosition - returns the current absolute position in file, f.
+*/
+
+extern "C" long int FIO_FindPosition (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if ((fd->buffer == NULL) || ! fd->buffer->valid)
+ {
+ return fd->abspos;
+ }
+ else
+ {
+ return fd->buffer->bufstart+((long int ) (fd->buffer->position));
+ }
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetFileName - assigns, a, with the filename associated with, f.
+*/
+
+extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high)
+{
+ typedef char *GetFileName__T6;
+
+ unsigned int i;
+ GetFileName__T6 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ if (fd->name.address == NULL)
+ {
+ StrLib_StrCopy ((const char *) "", 0, (char *) a, _a_high);
+ }
+ else
+ {
+ p = static_cast<GetFileName__T6> (fd->name.address);
+ i = 0;
+ while (((*p) != ASCII_nul) && (i <= _a_high))
+ {
+ a[i] = (*p);
+ p += 1;
+ i += 1;
+ }
+ }
+ }
+ }
+}
+
+
+/*
+ getFileName - returns the address of the filename associated with, f.
+*/
+
+extern "C" void * FIO_getFileName (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return fd->name.address;
+ }
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getFileNameLength - returns the number of characters associated with filename, f.
+*/
+
+extern "C" unsigned int FIO_getFileNameLength (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return fd->name.size;
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FlushOutErr - flushes, StdOut, and, StdErr.
+ It is also called when the application calls M2RTS.Terminate.
+ (which is automatically placed in program modules by the GM2
+ scaffold).
+*/
+
+extern "C" void FIO_FlushOutErr (void)
+{
+ if (FIO_IsNoError (FIO_StdOut))
+ {
+ FIO_FlushBuffer (FIO_StdOut);
+ }
+ if (FIO_IsNoError (FIO_StdErr))
+ {
+ FIO_FlushBuffer (FIO_StdErr);
+ }
+}
+
+extern "C" void _M2_FIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_FIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ FIO_FlushOutErr ();
+}
--- /dev/null
+/* do not edit automatically generated by mc from IO. */
+/* IO.mod provides Read, Write, Errors procedures mapping onto 0, 1 and 2.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stdlib.h>
+#include <unistd.h>
+#define _IO_H
+#define _IO_C
+
+# include "GStrLib.h"
+# include "GSYSTEM.h"
+# include "Glibc.h"
+# include "GFIO.h"
+# include "Gerrno.h"
+# include "GASCII.h"
+# include "Gtermios.h"
+
+# define MaxDefaultFd 2
+typedef struct IO_BasicFds_r IO_BasicFds;
+
+typedef struct IO__T1_a IO__T1;
+
+struct IO_BasicFds_r {
+ unsigned int IsEof;
+ unsigned int IsRaw;
+ };
+
+struct IO__T1_a { IO_BasicFds array[MaxDefaultFd+1]; };
+static IO__T1 fdState;
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+extern "C" void IO_Read (char *ch);
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Write (char ch);
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Error (char ch);
+extern "C" void IO_UnBufferedMode (int fd, unsigned int input);
+extern "C" void IO_BufferedMode (int fd, unsigned int input);
+
+/*
+ EchoOn - turns on echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOn (int fd, unsigned int input);
+
+/*
+ EchoOff - turns off echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOff (int fd, unsigned int input);
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+static unsigned int IsDefaultFd (int fd);
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+static void doWrite (int fd, FIO_File f, char ch);
+
+/*
+ setFlag - sets or unsets the appropriate flag in, t.
+*/
+
+static void setFlag (termios_TERMIOS t, termios_Flag f, unsigned int b);
+
+/*
+ doraw - sets all the flags associated with making this
+ file descriptor into raw input/output.
+*/
+
+static void doraw (termios_TERMIOS term);
+
+/*
+ dononraw - sets all the flags associated with making this
+ file descriptor into non raw input/output.
+*/
+
+static void dononraw (termios_TERMIOS term);
+
+/*
+ Init -
+*/
+
+static void Init (void);
+
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+static unsigned int IsDefaultFd (int fd)
+{
+ return (fd <= MaxDefaultFd) && (fd >= 0);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+static void doWrite (int fd, FIO_File f, char ch)
+{
+ int r;
+
+ if (fdState.array[fd].IsRaw)
+ {
+ /* avoid dangling else. */
+ if (! fdState.array[fd].IsEof)
+ {
+ for (;;)
+ {
+ r = static_cast<int> (libc_write (FIO_GetUnixFileDescriptor (f), &ch, static_cast<size_t> (1)));
+ if (r == 1)
+ {
+ return ;
+ }
+ else if (r == -1)
+ {
+ /* avoid dangling else. */
+ r = errno_geterrno ();
+ if ((r != errno_EAGAIN) && (r != errno_EINTR))
+ {
+ fdState.array[fd].IsEof = TRUE;
+ return ;
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ FIO_WriteChar (f, ch);
+ }
+}
+
+
+/*
+ setFlag - sets or unsets the appropriate flag in, t.
+*/
+
+static void setFlag (termios_TERMIOS t, termios_Flag f, unsigned int b)
+{
+ if (termios_SetFlag (t, f, b))
+ {} /* empty. */
+}
+
+
+/*
+ doraw - sets all the flags associated with making this
+ file descriptor into raw input/output.
+*/
+
+static void doraw (termios_TERMIOS term)
+{
+ /*
+ * from man 3 termios
+ * termios_p->c_iflag &= ~(IGNBRK | BRKINT | PARMRK | ISTRIP
+ * | INLCR | IGNCR | ICRNL | IXON);
+ * termios_p->c_oflag &= ~OPOST;
+ * termios_p->c_lflag &= ~(ECHO | ECHONL | ICANON | ISIG | IEXTEN);
+ * termios_p->c_cflag &= ~(CSIZE | PARENB);
+ * termios_p->c_cflag |= CS8;
+ */
+ setFlag (term, termios_ignbrk, FALSE);
+ setFlag (term, termios_ibrkint, FALSE);
+ setFlag (term, termios_iparmrk, FALSE);
+ setFlag (term, termios_istrip, FALSE);
+ setFlag (term, termios_inlcr, FALSE);
+ setFlag (term, termios_igncr, FALSE);
+ setFlag (term, termios_icrnl, FALSE);
+ setFlag (term, termios_ixon, FALSE);
+ setFlag (term, termios_opost, FALSE);
+ setFlag (term, termios_lecho, FALSE);
+ setFlag (term, termios_lechonl, FALSE);
+ setFlag (term, termios_licanon, FALSE);
+ setFlag (term, termios_lisig, FALSE);
+ setFlag (term, termios_liexten, FALSE);
+ setFlag (term, termios_parenb, FALSE);
+ setFlag (term, termios_cs8, TRUE);
+}
+
+
+/*
+ dononraw - sets all the flags associated with making this
+ file descriptor into non raw input/output.
+*/
+
+static void dononraw (termios_TERMIOS term)
+{
+ /*
+ * we undo these settings, (although we leave the character size alone)
+ *
+ * from man 3 termios
+ * termios_p->c_iflag &= ~(IGNBRK | BRKINT | PARMRK | ISTRIP
+ * | INLCR | IGNCR | ICRNL | IXON);
+ * termios_p->c_oflag &= ~OPOST;
+ * termios_p->c_lflag &= ~(ECHO | ECHONL | ICANON | ISIG | IEXTEN);
+ * termios_p->c_cflag &= ~(CSIZE | PARENB);
+ * termios_p->c_cflag |= CS8;
+ */
+ setFlag (term, termios_ignbrk, TRUE);
+ setFlag (term, termios_ibrkint, TRUE);
+ setFlag (term, termios_iparmrk, TRUE);
+ setFlag (term, termios_istrip, TRUE);
+ setFlag (term, termios_inlcr, TRUE);
+ setFlag (term, termios_igncr, TRUE);
+ setFlag (term, termios_icrnl, TRUE);
+ setFlag (term, termios_ixon, TRUE);
+ setFlag (term, termios_opost, TRUE);
+ setFlag (term, termios_lecho, TRUE);
+ setFlag (term, termios_lechonl, TRUE);
+ setFlag (term, termios_licanon, TRUE);
+ setFlag (term, termios_lisig, TRUE);
+ setFlag (term, termios_liexten, TRUE);
+}
+
+
+/*
+ Init -
+*/
+
+static void Init (void)
+{
+ fdState.array[0].IsEof = FALSE;
+ fdState.array[0].IsRaw = FALSE;
+ fdState.array[1].IsEof = FALSE;
+ fdState.array[1].IsRaw = FALSE;
+ fdState.array[2].IsEof = FALSE;
+ fdState.array[2].IsRaw = FALSE;
+}
+
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+extern "C" void IO_Read (char *ch)
+{
+ int r;
+
+ FIO_FlushBuffer (FIO_StdOut);
+ FIO_FlushBuffer (FIO_StdErr);
+ if (fdState.array[0].IsRaw)
+ {
+ if (fdState.array[0].IsEof)
+ {
+ (*ch) = ASCII_eof;
+ }
+ else
+ {
+ for (;;)
+ {
+ r = static_cast<int> (libc_read (FIO_GetUnixFileDescriptor (FIO_StdIn), ch, static_cast<size_t> (1)));
+ if (r == 1)
+ {
+ return ;
+ }
+ else if (r == -1)
+ {
+ /* avoid dangling else. */
+ r = errno_geterrno ();
+ if (r != errno_EAGAIN)
+ {
+ fdState.array[0].IsEof = TRUE;
+ (*ch) = ASCII_eof;
+ return ;
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ (*ch) = FIO_ReadChar (FIO_StdIn);
+ }
+}
+
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Write (char ch)
+{
+ doWrite (1, FIO_StdOut, ch);
+}
+
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Error (char ch)
+{
+ doWrite (2, FIO_StdErr, ch);
+}
+
+extern "C" void IO_UnBufferedMode (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int result;
+
+ if (IsDefaultFd (fd))
+ {
+ fdState.array[fd].IsRaw = TRUE;
+ }
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ doraw (term);
+ if (input)
+ {
+ result = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ result = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+extern "C" void IO_BufferedMode (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int r;
+
+ if (IsDefaultFd (fd))
+ {
+ fdState.array[fd].IsRaw = FALSE;
+ }
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ dononraw (term);
+ if (input)
+ {
+ r = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ r = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+
+/*
+ EchoOn - turns on echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOn (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int result;
+
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ setFlag (term, termios_lecho, TRUE);
+ if (input)
+ {
+ result = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ result = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+
+/*
+ EchoOff - turns off echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOff (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int result;
+
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ setFlag (term, termios_lecho, FALSE);
+ if (input)
+ {
+ result = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ result = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+extern "C" void _M2_IO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_IO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Indexing. */
+/* Indexing.mod provides a dynamic indexing mechanism for CARDINAL.
+
+Copyright (C) 2003-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+#include <stdlib.h>
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _Indexing_H
+#define _Indexing_C
+
+# include "Glibc.h"
+# include "GStorage.h"
+# include "GSYSTEM.h"
+# include "GM2RTS.h"
+
+typedef struct Indexing_IndexProcedure_p Indexing_IndexProcedure;
+
+# define MinSize 128
+typedef struct Indexing__T2_r Indexing__T2;
+
+typedef void * *Indexing_PtrToAddress;
+
+typedef Indexing__T2 *Indexing_Index;
+
+typedef unsigned char *Indexing_PtrToByte;
+
+typedef void (*Indexing_IndexProcedure_t) (void *);
+struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; };
+
+struct Indexing__T2_r {
+ void *ArrayStart;
+ unsigned int ArraySize;
+ unsigned int Used;
+ unsigned int Low;
+ unsigned int High;
+ unsigned int Debug;
+ unsigned int Map;
+ };
+
+
+/*
+ InitIndex - creates and returns an Index.
+*/
+
+extern "C" Indexing_Index Indexing_InitIndex (unsigned int low);
+
+/*
+ KillIndex - returns Index to free storage.
+*/
+
+extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i);
+
+/*
+ DebugIndex - turns on debugging within an index.
+*/
+
+extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i);
+
+/*
+ InBounds - returns TRUE if indice, n, is within the bounds
+ of the dynamic array.
+*/
+
+extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n);
+
+/*
+ HighIndice - returns the last legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_HighIndice (Indexing_Index i);
+
+/*
+ LowIndice - returns the first legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_LowIndice (Indexing_Index i);
+
+/*
+ PutIndice - places, a, into the dynamic array at position i[n]
+*/
+
+extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a);
+
+/*
+ GetIndice - retrieves, element i[n] from the dynamic array.
+*/
+
+extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n);
+
+/*
+ IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*/
+
+extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a);
+
+/*
+ RemoveIndiceFromIndex - removes, a, from Index, i.
+*/
+
+extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a);
+
+/*
+ DeleteIndice - delete i[j] from the array.
+*/
+
+extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j);
+
+/*
+ IncludeIndiceIntoIndex - if the indice is not in the index, then
+ add it at the end.
+*/
+
+extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a);
+
+/*
+ ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*/
+
+extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p);
+
+
+/*
+ InitIndex - creates and returns an Index.
+*/
+
+extern "C" Indexing_Index Indexing_InitIndex (unsigned int low)
+{
+ Indexing_Index i;
+
+ Storage_ALLOCATE ((void **) &i, sizeof (Indexing__T2));
+ i->Low = low;
+ i->High = 0;
+ i->ArraySize = MinSize;
+ Storage_ALLOCATE (&i->ArrayStart, MinSize);
+ i->ArrayStart = libc_memset (i->ArrayStart, 0, static_cast<size_t> (i->ArraySize));
+ i->Debug = FALSE;
+ i->Used = 0;
+ i->Map = (unsigned int) 0;
+ return i;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillIndex - returns Index to free storage.
+*/
+
+extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i)
+{
+ Storage_DEALLOCATE (&i->ArrayStart, i->ArraySize);
+ Storage_DEALLOCATE ((void **) &i, sizeof (Indexing__T2));
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DebugIndex - turns on debugging within an index.
+*/
+
+extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i)
+{
+ i->Debug = TRUE;
+ return i;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InBounds - returns TRUE if indice, n, is within the bounds
+ of the dynamic array.
+*/
+
+extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n)
+{
+ if (i == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return (n >= i->Low) && (n <= i->High);
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ HighIndice - returns the last legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_HighIndice (Indexing_Index i)
+{
+ if (i == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return i->High;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ LowIndice - returns the first legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_LowIndice (Indexing_Index i)
+{
+ if (i == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return i->Low;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutIndice - places, a, into the dynamic array at position i[n]
+*/
+
+extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a)
+{
+ typedef unsigned int * *PutIndice__T1;
+
+ unsigned int oldSize;
+ void * b;
+ PutIndice__T1 p;
+
+ if (! (Indexing_InBounds (i, n)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (n < i->Low)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ oldSize = i->ArraySize;
+ while (((n-i->Low)*sizeof (void *)) >= i->ArraySize)
+ {
+ i->ArraySize = i->ArraySize*2;
+ }
+ if (oldSize != i->ArraySize)
+ {
+ /*
+ IF Debug
+ THEN
+ printf2('increasing memory hunk from %d to %d
+ ',
+ oldSize, ArraySize)
+ END ;
+ */
+ Storage_REALLOCATE (&i->ArrayStart, i->ArraySize);
+ /* and initialize the remainder of the array to NIL */
+ b = i->ArrayStart;
+ b = reinterpret_cast<void *> (reinterpret_cast<char *> (b)+oldSize);
+ b = libc_memset (b, 0, static_cast<size_t> (i->ArraySize-oldSize));
+ }
+ i->High = n;
+ }
+ }
+ b = i->ArrayStart;
+ b = reinterpret_cast<void *> (reinterpret_cast<char *> (b)+(n-i->Low)*sizeof (void *));
+ p = static_cast<PutIndice__T1> (b);
+ (*p) = reinterpret_cast<unsigned int *> (a);
+ i->Used += 1;
+ if (i->Debug)
+ {
+ if (n < 32)
+ {
+ i->Map |= (1 << (n ));
+ }
+ }
+}
+
+
+/*
+ GetIndice - retrieves, element i[n] from the dynamic array.
+*/
+
+extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n)
+{
+ Indexing_PtrToByte b;
+ Indexing_PtrToAddress p;
+
+ if (! (Indexing_InBounds (i, n)))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ b += (n-i->Low)*sizeof (void *);
+ p = (Indexing_PtrToAddress) (b);
+ if (i->Debug)
+ {
+ if (((n < 32) && (! ((((1 << (n)) & (i->Map)) != 0)))) && ((*p) != NULL))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ }
+ return (*p);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*/
+
+extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a)
+{
+ unsigned int j;
+ Indexing_PtrToByte b;
+ Indexing_PtrToAddress p;
+
+ j = i->Low;
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ while (j <= i->High)
+ {
+ p = (Indexing_PtrToAddress) (b);
+ if ((*p) == a)
+ {
+ return TRUE;
+ }
+ /* we must not INC(p, ..) as p2c gets confused */
+ b += sizeof (void *);
+ j += 1;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveIndiceFromIndex - removes, a, from Index, i.
+*/
+
+extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a)
+{
+ unsigned int j;
+ unsigned int k;
+ Indexing_PtrToAddress p;
+ Indexing_PtrToByte b;
+
+ j = i->Low;
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ while (j <= i->High)
+ {
+ p = (Indexing_PtrToAddress) (b);
+ b += sizeof (void *);
+ if ((*p) == a)
+ {
+ Indexing_DeleteIndice (i, j);
+ }
+ j += 1;
+ }
+}
+
+
+/*
+ DeleteIndice - delete i[j] from the array.
+*/
+
+extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j)
+{
+ Indexing_PtrToAddress p;
+ Indexing_PtrToByte b;
+
+ if (Indexing_InBounds (i, j))
+ {
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ b += sizeof (void *)*(j-i->Low);
+ p = (Indexing_PtrToAddress) (b);
+ b += sizeof (void *);
+ p = static_cast<Indexing_PtrToAddress> (libc_memmove (reinterpret_cast<void *> (p), reinterpret_cast<void *> (b), static_cast<size_t> ((i->High-j)*sizeof (void *))));
+ i->High -= 1;
+ i->Used -= 1;
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ IncludeIndiceIntoIndex - if the indice is not in the index, then
+ add it at the end.
+*/
+
+extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a)
+{
+ if (! (Indexing_IsIndiceInIndex (i, a)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (i->Used == 0)
+ {
+ Indexing_PutIndice (i, Indexing_LowIndice (i), a);
+ }
+ else
+ {
+ Indexing_PutIndice (i, (Indexing_HighIndice (i))+1, a);
+ }
+ }
+}
+
+
+/*
+ ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*/
+
+extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p)
+{
+ unsigned int j;
+
+ j = Indexing_LowIndice (i);
+ while (j <= (Indexing_HighIndice (i)))
+ {
+ (*p.proc) (Indexing_GetIndice (i, j));
+ j += 1;
+ }
+}
+
+extern "C" void _M2_Indexing_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Indexing_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Lists. */
+/* Lists.mod provides an unordered list manipulation package.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _Lists_H
+#define _Lists_C
+
+# include "GStorage.h"
+
+typedef struct SymbolKey_PerformOperation_p SymbolKey_PerformOperation;
+
+# define MaxNoOfElements 5
+typedef struct Lists_list_r Lists_list;
+
+typedef struct Lists__T1_a Lists__T1;
+
+typedef Lists_list *Lists_List;
+
+typedef void (*SymbolKey_PerformOperation_t) (unsigned int);
+struct SymbolKey_PerformOperation_p { SymbolKey_PerformOperation_t proc; };
+
+struct Lists__T1_a { unsigned int array[MaxNoOfElements-1+1]; };
+struct Lists_list_r {
+ unsigned int NoOfElements;
+ Lists__T1 Elements;
+ Lists_List Next;
+ };
+
+
+/*
+ InitList - creates a new list, l.
+*/
+
+extern "C" void Lists_InitList (Lists_List *l);
+
+/*
+ KillList - deletes the complete list, l.
+*/
+
+extern "C" void Lists_KillList (Lists_List *l);
+
+/*
+ PutItemIntoList - places a WORD, c, into list, l.
+*/
+
+extern "C" void Lists_PutItemIntoList (Lists_List l, unsigned int c);
+extern "C" unsigned int Lists_GetItemFromList (Lists_List l, unsigned int n);
+
+/*
+ GetIndexOfList - returns the index for WORD, c, in list, l.
+ If more than one WORD, c, exists the index
+ for the first is returned.
+*/
+
+extern "C" unsigned int Lists_GetIndexOfList (Lists_List l, unsigned int c);
+
+/*
+ NoOfItemsInList - returns the number of items in list, l.
+ (iterative algorithm of the above).
+*/
+
+extern "C" unsigned int Lists_NoOfItemsInList (Lists_List l);
+
+/*
+ IncludeItemIntoList - adds a WORD, c, into a list providing
+ the value does not already exist.
+*/
+
+extern "C" void Lists_IncludeItemIntoList (Lists_List l, unsigned int c);
+
+/*
+ RemoveItemFromList - removes a WORD, c, from a list.
+ It assumes that this value only appears once.
+*/
+
+extern "C" void Lists_RemoveItemFromList (Lists_List l, unsigned int c);
+
+/*
+ IsItemInList - returns true if a WORD, c, was found in list, l.
+*/
+
+extern "C" unsigned int Lists_IsItemInList (Lists_List l, unsigned int c);
+
+/*
+ ForeachItemInListDo - calls procedure, P, foreach item in list, l.
+*/
+
+extern "C" void Lists_ForeachItemInListDo (Lists_List l, SymbolKey_PerformOperation P);
+
+/*
+ DuplicateList - returns a duplicate list derived from, l.
+*/
+
+extern "C" Lists_List Lists_DuplicateList (Lists_List l);
+
+/*
+ RemoveItem - remove an element at index, i, from the list data type.
+*/
+
+static void RemoveItem (Lists_List p, Lists_List l, unsigned int i);
+
+
+/*
+ RemoveItem - remove an element at index, i, from the list data type.
+*/
+
+static void RemoveItem (Lists_List p, Lists_List l, unsigned int i)
+{
+ l->NoOfElements -= 1;
+ while (i <= l->NoOfElements)
+ {
+ l->Elements.array[i-1] = l->Elements.array[i+1-1];
+ i += 1;
+ }
+ if ((l->NoOfElements == 0) && (p != NULL))
+ {
+ p->Next = l->Next;
+ Storage_DEALLOCATE ((void **) &l, sizeof (Lists_list));
+ }
+}
+
+
+/*
+ InitList - creates a new list, l.
+*/
+
+extern "C" void Lists_InitList (Lists_List *l)
+{
+ Storage_ALLOCATE ((void **) &(*l), sizeof (Lists_list));
+ (*l)->NoOfElements = 0;
+ (*l)->Next = NULL;
+}
+
+
+/*
+ KillList - deletes the complete list, l.
+*/
+
+extern "C" void Lists_KillList (Lists_List *l)
+{
+ if ((*l) != NULL)
+ {
+ if ((*l)->Next != NULL)
+ {
+ Lists_KillList (&(*l)->Next);
+ }
+ Storage_DEALLOCATE ((void **) &(*l), sizeof (Lists_list));
+ }
+}
+
+
+/*
+ PutItemIntoList - places a WORD, c, into list, l.
+*/
+
+extern "C" void Lists_PutItemIntoList (Lists_List l, unsigned int c)
+{
+ if (l->NoOfElements < MaxNoOfElements)
+ {
+ l->NoOfElements += 1;
+ l->Elements.array[l->NoOfElements-1] = c;
+ }
+ else if (l->Next != NULL)
+ {
+ /* avoid dangling else. */
+ Lists_PutItemIntoList (l->Next, c);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ Lists_InitList (&l->Next);
+ Lists_PutItemIntoList (l->Next, c);
+ }
+}
+
+extern "C" unsigned int Lists_GetItemFromList (Lists_List l, unsigned int n)
+{
+ /* iterative solution */
+ while (l != NULL)
+ {
+ if (n <= l->NoOfElements)
+ {
+ return l->Elements.array[n-1];
+ }
+ else
+ {
+ n -= l->NoOfElements;
+ }
+ l = l->Next;
+ }
+ return static_cast<unsigned int> (0);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetIndexOfList - returns the index for WORD, c, in list, l.
+ If more than one WORD, c, exists the index
+ for the first is returned.
+*/
+
+extern "C" unsigned int Lists_GetIndexOfList (Lists_List l, unsigned int c)
+{
+ unsigned int i;
+
+ if (l == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ i = 1;
+ while (i <= l->NoOfElements)
+ {
+ if (l->Elements.array[i-1] == c)
+ {
+ return i;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ return l->NoOfElements+(Lists_GetIndexOfList (l->Next, c));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ NoOfItemsInList - returns the number of items in list, l.
+ (iterative algorithm of the above).
+*/
+
+extern "C" unsigned int Lists_NoOfItemsInList (Lists_List l)
+{
+ unsigned int t;
+
+ if (l == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ t = 0;
+ do {
+ t += l->NoOfElements;
+ l = l->Next;
+ } while (! (l == NULL));
+ return t;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IncludeItemIntoList - adds a WORD, c, into a list providing
+ the value does not already exist.
+*/
+
+extern "C" void Lists_IncludeItemIntoList (Lists_List l, unsigned int c)
+{
+ if (! (Lists_IsItemInList (l, c)))
+ {
+ Lists_PutItemIntoList (l, c);
+ }
+}
+
+
+/*
+ RemoveItemFromList - removes a WORD, c, from a list.
+ It assumes that this value only appears once.
+*/
+
+extern "C" void Lists_RemoveItemFromList (Lists_List l, unsigned int c)
+{
+ Lists_List p;
+ unsigned int i;
+ unsigned int Found;
+
+ if (l != NULL)
+ {
+ Found = FALSE;
+ p = NULL;
+ do {
+ i = 1;
+ while ((i <= l->NoOfElements) && (l->Elements.array[i-1] != c))
+ {
+ i += 1;
+ }
+ if ((i <= l->NoOfElements) && (l->Elements.array[i-1] == c))
+ {
+ Found = TRUE;
+ }
+ else
+ {
+ p = l;
+ l = l->Next;
+ }
+ } while (! ((l == NULL) || Found));
+ if (Found)
+ {
+ RemoveItem (p, l, i);
+ }
+ }
+}
+
+
+/*
+ IsItemInList - returns true if a WORD, c, was found in list, l.
+*/
+
+extern "C" unsigned int Lists_IsItemInList (Lists_List l, unsigned int c)
+{
+ unsigned int i;
+
+ do {
+ i = 1;
+ while (i <= l->NoOfElements)
+ {
+ if (l->Elements.array[i-1] == c)
+ {
+ return TRUE;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ l = l->Next;
+ } while (! (l == NULL));
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ForeachItemInListDo - calls procedure, P, foreach item in list, l.
+*/
+
+extern "C" void Lists_ForeachItemInListDo (Lists_List l, SymbolKey_PerformOperation P)
+{
+ unsigned int i;
+ unsigned int n;
+
+ n = Lists_NoOfItemsInList (l);
+ i = 1;
+ while (i <= n)
+ {
+ (*P.proc) (Lists_GetItemFromList (l, i));
+ i += 1;
+ }
+}
+
+
+/*
+ DuplicateList - returns a duplicate list derived from, l.
+*/
+
+extern "C" Lists_List Lists_DuplicateList (Lists_List l)
+{
+ Lists_List m;
+ unsigned int n;
+ unsigned int i;
+
+ Lists_InitList (&m);
+ n = Lists_NoOfItemsInList (l);
+ i = 1;
+ while (i <= n)
+ {
+ Lists_PutItemIntoList (m, Lists_GetItemFromList (l, i));
+ i += 1;
+ }
+ return m;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_Lists_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Lists_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from M2Dependent. */
+/* M2Dependent.mod implements the run time module dependencies.
+
+Copyright (C) 2022-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+#include <string.h>
+#include <limits.h>
+#include <stdlib.h>
+# include "GStorage.h"
+#include <unistd.h>
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _M2Dependent_H
+#define _M2Dependent_C
+
+# include "Glibc.h"
+# include "GM2LINK.h"
+# include "GASCII.h"
+# include "GSYSTEM.h"
+# include "GStorage.h"
+# include "GStrLib.h"
+# include "GM2RTS.h"
+
+typedef struct M2Dependent_ArgCVEnvP_p M2Dependent_ArgCVEnvP;
+
+typedef struct M2Dependent_DependencyList_r M2Dependent_DependencyList;
+
+typedef struct M2Dependent__T2_r M2Dependent__T2;
+
+typedef M2Dependent__T2 *M2Dependent_ModuleChain;
+
+typedef struct M2Dependent__T3_a M2Dependent__T3;
+
+typedef enum {M2Dependent_unregistered, M2Dependent_unordered, M2Dependent_started, M2Dependent_ordered, M2Dependent_user} M2Dependent_DependencyState;
+
+typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *);
+struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; };
+
+struct M2Dependent_DependencyList_r {
+ PROC proc;
+ unsigned int forced;
+ unsigned int forc;
+ unsigned int appl;
+ M2Dependent_DependencyState state;
+ };
+
+struct M2Dependent__T3_a { M2Dependent_ModuleChain array[M2Dependent_user-M2Dependent_unregistered+1]; };
+struct M2Dependent__T2_r {
+ void *name;
+ void *libname;
+ M2Dependent_ArgCVEnvP init;
+ M2Dependent_ArgCVEnvP fini;
+ M2Dependent_DependencyList dependency;
+ M2Dependent_ModuleChain prev;
+ M2Dependent_ModuleChain next;
+ };
+
+static M2Dependent__T3 Modules;
+static unsigned int Initialized;
+static unsigned int WarningTrace;
+static unsigned int ModuleTrace;
+static unsigned int HexTrace;
+static unsigned int DependencyTrace;
+static unsigned int PreTrace;
+static unsigned int PostTrace;
+static unsigned int ForceTrace;
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
+
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ AppendModule - append chain to end of the list.
+*/
+
+static void AppendModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain);
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain);
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr);
+
+/*
+ max -
+*/
+
+static unsigned int max (unsigned int a, unsigned int b);
+
+/*
+ min -
+*/
+
+static unsigned int min (unsigned int a, unsigned int b);
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen);
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname);
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high);
+
+/*
+ strcmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b);
+
+/*
+ strncmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n);
+
+/*
+ strlen - returns the length of string.
+*/
+
+static int strlen_ (M2LINK_PtrToChar string);
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high);
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg);
+
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2);
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChain mptr);
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname);
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
+
+/*
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
+*/
+
+static void ResolveDependencies (void * currentmodule, void * libname);
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high);
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag);
+
+/*
+ combine - dest := src + dest. Places src at the front of list dest.
+ Pre condition: src, dest are lists.
+ Post condition : dest := src + dest
+ src := NIL.
+*/
+
+static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest);
+
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
+/*
+ ForceDependencies - if the user has specified a forced order then we override
+ the dynamic ordering with the preference.
+*/
+
+static void ForceDependencies (void);
+
+/*
+ CheckApplication - check to see that the application is the last entry in the list.
+ This might happen if the application only imports FOR C modules.
+*/
+
+static void CheckApplication (void);
+
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2);
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high);
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,hex,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ hex dump the modules ctor functions address in hex.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved dynamically.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void);
+
+/*
+ Init - initialize the debug flags and set all lists to NIL.
+*/
+
+static void Init (void);
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void);
+
+
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+ M2Dependent_ModuleChain mptr;
+ void * p0;
+ void * p1;
+
+ Storage_ALLOCATE ((void **) &mptr, sizeof (M2Dependent__T2));
+ mptr->name = name;
+ mptr->libname = libname;
+ mptr->init = init;
+ mptr->fini = fini;
+ mptr->dependency.proc = dependencies;
+ mptr->dependency.state = M2Dependent_unregistered;
+ mptr->prev = NULL;
+ mptr->next = NULL;
+ if (HexTrace)
+ {
+ libc_printf ((const char *) " (init: %p fini: %p", 22, init, fini);
+ libc_printf ((const char *) " dep: %p)", 10, dependencies);
+ }
+ return mptr;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AppendModule - append chain to end of the list.
+*/
+
+static void AppendModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain)
+{
+ if ((*head) == NULL)
+ {
+ (*head) = chain;
+ chain->prev = chain;
+ chain->next = chain;
+ }
+ else
+ {
+ chain->next = (*head); /* Add Item to the end of list. */
+ chain->prev = (*head)->prev; /* Add Item to the end of list. */
+ (*head)->prev->next = chain;
+ (*head)->prev = chain;
+ }
+}
+
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain)
+{
+ if ((chain->next == (*head)) && (chain == (*head)))
+ {
+ (*head) = NULL;
+ }
+ else
+ {
+ if ((*head) == chain)
+ {
+ (*head) = (*head)->next;
+ }
+ chain->prev->next = chain->next;
+ chain->next->prev = chain->prev;
+ }
+}
+
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr)
+{
+ M2Dependent_ModuleChain ptr;
+
+ if (Modules.array[state-M2Dependent_unregistered] != NULL)
+ {
+ ptr = Modules.array[state-M2Dependent_unregistered];
+ do {
+ if (ptr == mptr)
+ {
+ return TRUE;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-M2Dependent_unregistered]));
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ max -
+*/
+
+static unsigned int max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ min -
+*/
+
+static unsigned int min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen)
+{
+ M2Dependent_ModuleChain ptr;
+
+ if (Modules.array[state-M2Dependent_unregistered] != NULL)
+ {
+ ptr = Modules.array[state-M2Dependent_unregistered];
+ do {
+ if (((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), max (namelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->name)))))) == 0) && ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname), reinterpret_cast<M2LINK_PtrToChar> (libname), max (libnamelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname)))))) == 0))
+ {
+ return ptr;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-M2Dependent_unregistered]));
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname)
+{
+ return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))), libname, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (libname))));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high)
+{
+ unsigned int high;
+ unsigned int i;
+ unsigned int j;
+
+ i = 0;
+ high = _str_high;
+ while (i < high)
+ {
+ if ((i < high) && (str[i] == '\\'))
+ {
+ if (str[i+1] == 'n')
+ {
+ str[i] = ASCII_nl;
+ j = i+1;
+ while (j < high)
+ {
+ str[j] = str[j+1];
+ j += 1;
+ }
+ }
+ }
+ i += 1;
+ }
+}
+
+
+/*
+ strcmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b)
+{
+ if ((a != NULL) && (b != NULL))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a == b)
+ {
+ return 0;
+ }
+ else
+ {
+ while ((*a) == (*b))
+ {
+ if ((*a) == ASCII_nul)
+ {
+ return 0;
+ }
+ a += 1;
+ b += 1;
+ }
+ }
+ }
+ return 1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ strncmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n)
+{
+ if (n == 0)
+ {
+ return 0;
+ }
+ else if ((a != NULL) && (b != NULL))
+ {
+ /* avoid dangling else. */
+ if (a == b)
+ {
+ return 0;
+ }
+ else
+ {
+ while (((*a) == (*b)) && (n > 0))
+ {
+ if (((*a) == ASCII_nul) || (n == 1))
+ {
+ return 0;
+ }
+ a += 1;
+ b += 1;
+ n -= 1;
+ }
+ }
+ }
+ return 1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ strlen - returns the length of string.
+*/
+
+static int strlen_ (M2LINK_PtrToChar string)
+{
+ int count;
+
+ if (string == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ count = 0;
+ while ((*string) != ASCII_nul)
+ {
+ string += 1;
+ count += 1;
+ }
+ return count;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ libc_printf ((const char *) str, _str_high);
+ }
+}
+
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg)
+{
+ char ch;
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ if (arg == NULL)
+ {
+ ch = (char) 0;
+ arg = &ch;
+ }
+ libc_printf ((const char *) str, _str_high, arg);
+ }
+}
+
+
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2)
+{
+ char ch;
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ if (arg1 == NULL)
+ {
+ ch = (char) 0;
+ arg1 = &ch;
+ }
+ if (arg2 == NULL)
+ {
+ ch = (char) 0;
+ arg2 = &ch;
+ }
+ libc_printf ((const char *) str, _str_high, arg1, arg2);
+ }
+}
+
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChain mptr)
+{
+ if (onChain (mptr->dependency.state, mptr))
+ {
+ RemoveModule (&Modules.array[mptr->dependency.state-M2Dependent_unregistered], mptr);
+ }
+ mptr->dependency.state = newstate;
+ AppendModule (&Modules.array[mptr->dependency.state-M2Dependent_unregistered], mptr);
+}
+
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname)
+{
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not been registered via a global constructor\\n", 68, currentmodule, libname);
+ }
+ else
+ {
+ if (onChain (M2Dependent_started, mptr))
+ {
+ traceprintf (DependencyTrace, (const char *) " processing...\\n", 18);
+ }
+ else
+ {
+ moveTo (M2Dependent_started, mptr);
+ traceprintf3 (DependencyTrace, (const char *) " starting: %s [%s]\\n", 22, currentmodule, libname);
+ (*mptr->dependency.proc.proc) (); /* Invoke and process the dependency graph. */
+ traceprintf3 (DependencyTrace, (const char *) " finished: %s [%s]\\n", 22, currentmodule, libname); /* Invoke and process the dependency graph. */
+ moveTo (M2Dependent_ordered, mptr);
+ }
+ }
+}
+
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
+ if (dependantmodule == NULL)
+ {
+ /* avoid dangling else. */
+ traceprintf (DependencyTrace, (const char *) " has finished its import graph\\n", 32);
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
+ if (mptr != NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is now ordered\\n", 33, modulename, libname);
+ moveTo (M2Dependent_ordered, mptr);
+ }
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " imports from %s [%s]\\n", 23, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_ordered, dependantmodule, dependantlibname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not ordered\\n", 33, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_unordered, dependantmodule, dependantlibname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not unordered\\n", 35, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_started, dependantmodule, dependantlibname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not started\\n", 34, dependantmodule, dependantlibname);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] attempting to import from", 42, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " %s [%s] which has not registered itself via a constructor\\n", 60, dependantmodule, dependantlibname);
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has registered itself and has started\\n", 56, dependantmodule, dependantlibname);
+ }
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] resolving\\n", 28, dependantmodule, dependantlibname);
+ ResolveDependant (mptr, dependantmodule, dependantlibname);
+ }
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " dependant %s [%s] is ordered\\n", 31, dependantmodule, dependantlibname);
+ }
+ }
+}
+
+
+/*
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
+*/
+
+static void ResolveDependencies (void * currentmodule, void * libname)
+{
+ M2Dependent_ModuleChain mptr;
+
+ mptr = LookupModule (M2Dependent_unordered, currentmodule, libname);
+ while (mptr != NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s [%s]\\n", 53, currentmodule, libname);
+ ResolveDependant (mptr, currentmodule, libname);
+ mptr = Modules.array[M2Dependent_unordered-M2Dependent_unregistered];
+ }
+}
+
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high)
+{
+ M2Dependent_ModuleChain mptr;
+ unsigned int count;
+ char desc[_desc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (desc, desc_, _desc_high+1);
+
+ if (Modules.array[state-M2Dependent_unregistered] != NULL)
+ {
+ libc_printf ((const char *) "%s modules\\n", 12, &desc);
+ mptr = Modules.array[state-M2Dependent_unregistered];
+ count = 0;
+ do {
+ if (mptr->name == NULL)
+ {
+ libc_printf ((const char *) " %d %s []", 11, count, mptr->name);
+ }
+ else
+ {
+ libc_printf ((const char *) " %d %s [%s]", 13, count, mptr->name, mptr->libname);
+ }
+ count += 1;
+ if (mptr->dependency.appl)
+ {
+ libc_printf ((const char *) " application", 12);
+ }
+ if (mptr->dependency.forc)
+ {
+ libc_printf ((const char *) " for C", 6);
+ }
+ if (mptr->dependency.forced)
+ {
+ libc_printf ((const char *) " forced ordering", 16);
+ }
+ libc_printf ((const char *) "\\n", 2);
+ mptr = mptr->next;
+ } while (! (mptr == Modules.array[state-M2Dependent_unregistered]));
+ }
+}
+
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag)
+{
+ M2Dependent_ModuleChain mptr;
+
+ if (flag)
+ {
+ DisplayModuleInfo (M2Dependent_unregistered, (const char *) "unregistered", 12);
+ DisplayModuleInfo (M2Dependent_unordered, (const char *) "unordered", 9);
+ DisplayModuleInfo (M2Dependent_started, (const char *) "started", 7);
+ DisplayModuleInfo (M2Dependent_ordered, (const char *) "ordered", 7);
+ }
+}
+
+
+/*
+ combine - dest := src + dest. Places src at the front of list dest.
+ Pre condition: src, dest are lists.
+ Post condition : dest := src + dest
+ src := NIL.
+*/
+
+static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest)
+{
+ M2Dependent_ModuleChain last;
+
+ while (Modules.array[src-M2Dependent_unregistered] != NULL)
+ {
+ last = Modules.array[src-M2Dependent_unregistered]->prev;
+ moveTo (M2Dependent_ordered, last);
+ Modules.array[dest-M2Dependent_unregistered] = last; /* New item is at the head. */
+ }
+}
+
+
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ typedef struct tracemodule__T4_a tracemodule__T4;
+
+ struct tracemodule__T4_a { char array[100+1]; };
+ tracemodule__T4 buffer;
+ unsigned int len;
+
+ if (flag)
+ {
+ len = min (modlen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, modname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) "%s ", 3, &buffer);
+ len = min (liblen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, libname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) " [%s]", 5, &buffer);
+ }
+}
+
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf (ForceTrace, (const char *) "forcing module: ", 16);
+ tracemodule (ForceTrace, modname, modlen, libname, liblen);
+ traceprintf (ForceTrace, (const char *) "\\n", 2);
+ mptr = LookupModuleN (M2Dependent_ordered, modname, modlen, libname, liblen);
+ if (mptr != NULL)
+ {
+ mptr->dependency.forced = TRUE;
+ moveTo (M2Dependent_user, mptr);
+ }
+}
+
+
+/*
+ ForceDependencies - if the user has specified a forced order then we override
+ the dynamic ordering with the preference.
+*/
+
+static void ForceDependencies (void)
+{
+ unsigned int len;
+ unsigned int modlen;
+ unsigned int liblen;
+ M2LINK_PtrToChar modname;
+ M2LINK_PtrToChar libname;
+ M2LINK_PtrToChar pc;
+ M2LINK_PtrToChar start;
+
+ if (M2LINK_ForcedModuleInitOrder != NULL)
+ {
+ traceprintf2 (ForceTrace, (const char *) "user forcing order: %s\\n", 24, reinterpret_cast<void *> (M2LINK_ForcedModuleInitOrder));
+ pc = M2LINK_ForcedModuleInitOrder;
+ start = pc;
+ len = 0;
+ modname = NULL;
+ modlen = 0;
+ libname = NULL;
+ liblen = 0;
+ while ((*pc) != ASCII_nul)
+ {
+ switch ((*pc))
+ {
+ case ':':
+ libname = start;
+ liblen = len;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+ case ',':
+ modname = start;
+ modlen = len;
+ ForceModule (reinterpret_cast<void *> (modname), modlen, reinterpret_cast<void *> (libname), liblen);
+ libname = NULL;
+ liblen = 0;
+ modlen = 0;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+
+ default:
+ pc += 1;
+ len += 1;
+ break;
+ }
+ }
+ if (start != pc)
+ {
+ ForceModule (reinterpret_cast<void *> (start), len, reinterpret_cast<void *> (libname), liblen);
+ }
+ combine (M2Dependent_user, M2Dependent_ordered);
+ }
+}
+
+
+/*
+ CheckApplication - check to see that the application is the last entry in the list.
+ This might happen if the application only imports FOR C modules.
+*/
+
+static void CheckApplication (void)
+{
+ M2Dependent_ModuleChain mptr;
+ M2Dependent_ModuleChain appl;
+
+ mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered];
+ if (mptr != NULL)
+ {
+ appl = NULL;
+ do {
+ if (mptr->dependency.appl)
+ {
+ appl = mptr;
+ }
+ else
+ {
+ mptr = mptr->next;
+ }
+ } while (! ((appl != NULL) || (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered])));
+ if (appl != NULL)
+ {
+ RemoveModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
+ AppendModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
+ }
+ }
+}
+
+
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2)
+{
+ typedef struct warning3__T5_a warning3__T5;
+
+ struct warning3__T5_a { char array[4096+1]; };
+ warning3__T5 buffer;
+ int len;
+ char format[_format_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (format, format_, _format_high+1);
+
+ if (WarningTrace)
+ {
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) "warning: ", 9);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) format, _format_high, arg1, arg2);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ }
+}
+
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ return (strncmp (reinterpret_cast<M2LINK_PtrToChar> (cstr), reinterpret_cast<M2LINK_PtrToChar> (&str), StrLib_StrLen ((const char *) str, _str_high))) == 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,hex,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ hex dump the modules ctor functions address in hex.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved dynamically.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void)
+{
+ typedef char *SetupDebugFlags__T1;
+
+ SetupDebugFlags__T1 pc;
+
+ ModuleTrace = FALSE;
+ DependencyTrace = FALSE;
+ PostTrace = FALSE;
+ PreTrace = FALSE;
+ ForceTrace = FALSE;
+ HexTrace = FALSE;
+ WarningTrace = FALSE;
+ pc = static_cast<SetupDebugFlags__T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
+ while ((pc != NULL) && ((*pc) != ASCII_nul))
+ {
+ if (equal (reinterpret_cast<void *> (pc), (const char *) "all", 3))
+ {
+ ModuleTrace = TRUE;
+ DependencyTrace = TRUE;
+ PreTrace = TRUE;
+ PostTrace = TRUE;
+ ForceTrace = TRUE;
+ HexTrace = TRUE;
+ WarningTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "module", 6))
+ {
+ /* avoid dangling else. */
+ ModuleTrace = TRUE;
+ pc += 6;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "warning", 7))
+ {
+ /* avoid dangling else. */
+ WarningTrace = TRUE;
+ pc += 7;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "hex", 3))
+ {
+ /* avoid dangling else. */
+ HexTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
+ {
+ /* avoid dangling else. */
+ DependencyTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "pre", 3))
+ {
+ /* avoid dangling else. */
+ PreTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "post", 4))
+ {
+ /* avoid dangling else. */
+ PostTrace = TRUE;
+ pc += 4;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "force", 5))
+ {
+ /* avoid dangling else. */
+ ForceTrace = TRUE;
+ pc += 5;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ pc += 1;
+ }
+ }
+}
+
+
+/*
+ Init - initialize the debug flags and set all lists to NIL.
+*/
+
+static void Init (void)
+{
+ M2Dependent_DependencyState state;
+
+ SetupDebugFlags ();
+ for (state=M2Dependent_unregistered; state<=M2Dependent_user; state= static_cast<M2Dependent_DependencyState>(static_cast<int>(state+1)))
+ {
+ Modules.array[state-M2Dependent_unregistered] = NULL;
+ }
+}
+
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void)
+{
+ if (! Initialized)
+ {
+ Initialized = TRUE;
+ Init ();
+ }
+}
+
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_ModuleChain mptr;
+ M2Dependent_ArgCVEnvP nulp;
+
+ CheckInitialized ();
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, applicationmodule, libname);
+ mptr = LookupModule (M2Dependent_unordered, applicationmodule, libname);
+ if (mptr != NULL)
+ {
+ mptr->dependency.appl = TRUE;
+ }
+ traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26);
+ DumpModuleData (PreTrace);
+ ResolveDependencies (applicationmodule, libname);
+ traceprintf (PreTrace, (const char *) "Post resolving dependents\\n", 27);
+ DumpModuleData (PostTrace);
+ ForceDependencies ();
+ traceprintf (ForceTrace, (const char *) "After user forcing ordering\\n", 29);
+ DumpModuleData (ForceTrace);
+ CheckApplication ();
+ traceprintf (ForceTrace, (const char *) "After runtime forces application to the end\\n", 45);
+ DumpModuleData (ForceTrace);
+ if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
+ {
+ traceprintf3 (ModuleTrace, (const char *) " module: %s [%s] has not registered itself using a global constructor\\n", 72, applicationmodule, libname);
+ traceprintf2 (ModuleTrace, (const char *) " hint try compile and linking using: gm2 %s.mod\\n", 50, applicationmodule);
+ traceprintf2 (ModuleTrace, (const char *) " or try using: gm2 -fscaffold-static %s.mod\\n", 46, applicationmodule);
+ }
+ else
+ {
+ mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered];
+ do {
+ if (mptr->dependency.forc)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s] for C\\n", 36, mptr->name, mptr->libname);
+ }
+ else
+ {
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s]\\n", 30, mptr->name, mptr->libname);
+ }
+ if (mptr->dependency.appl)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, mptr->name, mptr->libname);
+ traceprintf (ModuleTrace, (const char *) " calling M2RTS_ExecuteInitialProcedures\\n", 42);
+ M2RTS_ExecuteInitialProcedures ();
+ traceprintf (ModuleTrace, (const char *) " calling application module\\n", 30);
+ }
+ (*mptr->init.proc) (argc, argv, envp);
+ mptr = mptr->next;
+ } while (! (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered]));
+ }
+}
+
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf3 (ModuleTrace, (const char *) "application module finishing: %s [%s]\\n", 39, applicationmodule, libname);
+ if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
+ {
+ traceprintf (ModuleTrace, (const char *) " no ordered modules found during finishing\\n", 45);
+ }
+ else
+ {
+ traceprintf (ModuleTrace, (const char *) "ExecuteTerminationProcedures\\n", 30);
+ M2RTS_ExecuteTerminationProcedures ();
+ traceprintf (ModuleTrace, (const char *) "terminating modules in sequence\\n", 33);
+ mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered]->prev;
+ do {
+ if (mptr->dependency.forc)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s] for C\\n", 34, mptr->name, mptr->libname);
+ }
+ else
+ {
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s]\\n", 28, mptr->name, mptr->libname);
+ }
+ (*mptr->fini.proc) (argc, argv, envp);
+ mptr = mptr->prev;
+ } while (! (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered]->prev));
+ }
+}
+
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+ M2Dependent_ModuleChain mptr;
+
+ CheckInitialized ();
+ if (! M2LINK_StaticInitialization)
+ {
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "module: %s [%s] registering", 27, modulename, libname);
+ moveTo (M2Dependent_unordered, CreateModule (modulename, libname, init, fini, dependencies));
+ traceprintf (ModuleTrace, (const char *) "\\n", 2);
+ }
+ else
+ {
+ warning3 ((const char *) "module: %s [%s] (ignoring duplicate registration)\\n", 51, modulename, libname);
+ }
+ }
+}
+
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
+{
+ CheckInitialized ();
+ if (! M2LINK_StaticInitialization)
+ {
+ PerformRequestDependant (modulename, libname, dependantmodule, dependantlibname);
+ }
+}
+
+extern "C" void _M2_M2Dependent_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ CheckInitialized ();
+}
+
+extern "C" void _M2_M2Dependent_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from M2EXCEPTION. */
+/* M2EXCEPTION.mod implement M2Exception and IsM2Exception.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#include <limits.h>
+# include "Gmcrts.h"
+#define _M2EXCEPTION_H
+#define _M2EXCEPTION_C
+
+# include "GSYSTEM.h"
+# include "GRTExceptions.h"
+
+typedef enum {M2EXCEPTION_indexException, M2EXCEPTION_rangeException, M2EXCEPTION_caseSelectException, M2EXCEPTION_invalidLocation, M2EXCEPTION_functionException, M2EXCEPTION_wholeValueException, M2EXCEPTION_wholeDivException, M2EXCEPTION_realValueException, M2EXCEPTION_realDivException, M2EXCEPTION_complexValueException, M2EXCEPTION_complexDivException, M2EXCEPTION_protException, M2EXCEPTION_sysException, M2EXCEPTION_coException, M2EXCEPTION_exException} M2EXCEPTION_M2Exceptions;
+
+extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void);
+extern "C" unsigned int M2EXCEPTION_IsM2Exception (void);
+
+extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void)
+{
+ RTExceptions_EHBlock e;
+ unsigned int n;
+
+ /* If the program or coroutine is in the exception state then return the enumeration
+ value representing the exception cause. If it is not in the exception state then
+ raises and exception (exException). */
+ e = RTExceptions_GetExceptionBlock ();
+ n = RTExceptions_GetNumber (e);
+ if (n == (UINT_MAX))
+ {
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*> (reinterpret_cast<const void*>("M2Exception")), const_cast<void*> (reinterpret_cast<const void*>("current coroutine is not in the exceptional execution state")));
+ }
+ else
+ {
+ return (M2EXCEPTION_M2Exceptions) (n);
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int M2EXCEPTION_IsM2Exception (void)
+{
+ RTExceptions_EHBlock e;
+
+ /* Returns TRUE if the program or coroutine is in the exception state.
+ Returns FALSE if the program or coroutine is not in the exception state. */
+ e = RTExceptions_GetExceptionBlock ();
+ return (RTExceptions_GetNumber (e)) != (UINT_MAX);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_M2EXCEPTION_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ RTExceptions_SetExceptionBlock (RTExceptions_InitExceptionBlock ());
+}
+
+extern "C" void _M2_M2EXCEPTION_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* GM2LINK.c a handwritten module for mc.
+
+Copyright (C) 2022-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaiusmod2@gmail.com>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+/* mc currently is built using a static scaffold. */
+
+#include <cstddef>
+
+int M2LINK_StaticInitialization = 1;
+char *M2LINK_ForcedModuleInitOrder = NULL;
--- /dev/null
+/* do not edit automatically generated by mc from M2RTS. */
+/* M2RTS.mod Implements the run time system facilities of Modula-2.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+#include <string.h>
+#include <limits.h>
+#include <stdlib.h>
+# include "GStorage.h"
+#include <unistd.h>
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _M2RTS_H
+#define _M2RTS_C
+
+# include "Glibc.h"
+# include "GNumberIO.h"
+# include "GStrLib.h"
+# include "GSYSTEM.h"
+# include "GASCII.h"
+# include "GStorage.h"
+# include "GRTExceptions.h"
+# include "GM2EXCEPTION.h"
+# include "GM2Dependent.h"
+
+typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
+
+# define stderrFd 2
+typedef struct M2RTS_ProcedureList_r M2RTS_ProcedureList;
+
+typedef char *M2RTS_PtrToChar;
+
+typedef struct M2RTS__T1_r M2RTS__T1;
+
+typedef M2RTS__T1 *M2RTS_ProcedureChain;
+
+typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
+struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
+
+struct M2RTS_ProcedureList_r {
+ M2RTS_ProcedureChain head;
+ M2RTS_ProcedureChain tail;
+ };
+
+struct M2RTS__T1_r {
+ PROC p;
+ M2RTS_ProcedureChain prev;
+ M2RTS_ProcedureChain next;
+ };
+
+static M2RTS_ProcedureList InitialProc;
+static M2RTS_ProcedureList TerminateProc;
+static int ExitValue;
+static unsigned int isHalting;
+static unsigned int CallExit;
+static unsigned int Initialized;
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*/
+
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
+
+/*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*/
+
+extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p);
+
+/*
+ ExecuteInitialProcedures - executes the initial procedures installed by
+ InstallInitialProcedure.
+*/
+
+extern "C" void M2RTS_ExecuteInitialProcedures (void);
+
+/*
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
+*/
+
+extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p);
+
+/*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*/
+
+extern "C" void M2RTS_ExecuteTerminationProcedures (void);
+
+/*
+ Terminate - provides compatibility for pim. It calls exit with
+ the exitcode provided in a prior call to ExitOnHalt
+ (or zero if ExitOnHalt was never called). It does
+ not call ExecuteTerminationProcedures.
+*/
+
+extern "C" void M2RTS_Terminate (void);
+
+/*
+ HALT - terminate the current program. The procedure
+ ExecuteTerminationProcedures
+ is called before the program is stopped. The parameter
+ exitcode is optional. If the parameter is not supplied
+ HALT will call libc 'abort', otherwise it will exit with
+ the code supplied. Supplying a parameter to HALT has the
+ same effect as calling ExitOnHalt with the same code and
+ then calling HALT with no parameter.
+*/
+
+extern "C" void M2RTS_HALT (int exitcode);
+
+/*
+ Halt - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high);
+
+/*
+ HaltC - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description);
+
+/*
+ ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*/
+
+extern "C" void M2RTS_ExitOnHalt (int e);
+
+/*
+ ErrorMessage - emits an error message to stderr and then calls exit (1).
+*/
+
+extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high);
+
+/*
+ Length - returns the length of a string, a. This is called whenever
+ the user calls LENGTH and the parameter cannot be calculated
+ at compile time.
+*/
+
+extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high);
+extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+
+/*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*/
+
+static void ExecuteReverse (M2RTS_ProcedureChain procptr);
+
+/*
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
+*/
+
+static unsigned int AppendProc (M2RTS_ProcedureList *proclist, PROC proc);
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high);
+
+/*
+ ErrorStringC - writes a string to stderr.
+*/
+
+static void ErrorStringC (void * str);
+
+/*
+ ErrorMessageC - emits an error message to stderr and then calls exit (1).
+*/
+
+static void ErrorMessageC (void * message, void * filename, unsigned int line, void * function);
+
+/*
+ InitProcList - initialize the head and tail pointers to NIL.
+*/
+
+static void InitProcList (M2RTS_ProcedureList *p);
+
+/*
+ Init - initialize the initial, terminate procedure lists and booleans.
+*/
+
+static void Init (void);
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void);
+
+
+/*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*/
+
+static void ExecuteReverse (M2RTS_ProcedureChain procptr)
+{
+ while (procptr != NULL)
+ {
+ (*procptr->p.proc) (); /* Invoke the procedure. */
+ procptr = procptr->prev; /* Invoke the procedure. */
+ }
+}
+
+
+/*
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
+*/
+
+static unsigned int AppendProc (M2RTS_ProcedureList *proclist, PROC proc)
+{
+ M2RTS_ProcedureChain pdes;
+
+ Storage_ALLOCATE ((void **) &pdes, sizeof (M2RTS__T1));
+ pdes->p = proc;
+ pdes->prev = (*proclist).tail;
+ pdes->next = NULL;
+ if ((*proclist).head == NULL)
+ {
+ (*proclist).head = pdes;
+ }
+ (*proclist).tail = pdes;
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high)
+{
+ int n;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ n = static_cast<int> (libc_write (stderrFd, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
+}
+
+
+/*
+ ErrorStringC - writes a string to stderr.
+*/
+
+static void ErrorStringC (void * str)
+{
+ int len;
+
+ len = static_cast<int> (libc_write (stderrFd, str, libc_strlen (str)));
+}
+
+
+/*
+ ErrorMessageC - emits an error message to stderr and then calls exit (1).
+*/
+
+static void ErrorMessageC (void * message, void * filename, unsigned int line, void * function)
+{
+ typedef struct ErrorMessageC__T2_a ErrorMessageC__T2;
+
+ struct ErrorMessageC__T2_a { char array[10+1]; };
+ ErrorMessageC__T2 buffer;
+
+ ErrorStringC (filename);
+ ErrorString ((const char *) ":", 1);
+ NumberIO_CardToStr (line, 0, (char *) &buffer.array[0], 10);
+ ErrorString ((const char *) &buffer.array[0], 10);
+ ErrorString ((const char *) ":", 1);
+ if ((libc_strlen (function)) > 0)
+ {
+ ErrorString ((const char *) "in ", 3);
+ ErrorStringC (function);
+ ErrorString ((const char *) " has caused ", 12);
+ }
+ ErrorStringC (message);
+ buffer.array[0] = ASCII_nl;
+ buffer.array[1] = ASCII_nul;
+ ErrorString ((const char *) &buffer.array[0], 10);
+ libc_exit (1);
+}
+
+
+/*
+ InitProcList - initialize the head and tail pointers to NIL.
+*/
+
+static void InitProcList (M2RTS_ProcedureList *p)
+{
+ (*p).head = NULL;
+ (*p).tail = NULL;
+}
+
+
+/*
+ Init - initialize the initial, terminate procedure lists and booleans.
+*/
+
+static void Init (void)
+{
+ InitProcList (&InitialProc);
+ InitProcList (&TerminateProc);
+ ExitValue = 0;
+ isHalting = FALSE;
+ CallExit = FALSE; /* default by calling abort */
+}
+
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void)
+{
+ if (! Initialized)
+ {
+ Initialized = TRUE;
+ Init ();
+ }
+}
+
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_ConstructModules (applicationmodule, libname, argc, argv, envp);
+}
+
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_DeconstructModules (applicationmodule, libname, argc, argv, envp);
+}
+
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+{
+ M2Dependent_RegisterModule (name, libname, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies);
+}
+
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*/
+
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
+{
+ M2Dependent_RequestDependant (modulename, libname, dependantmodule, dependantlibname);
+}
+
+
+/*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*/
+
+extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p)
+{
+ return AppendProc (&TerminateProc, p);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ExecuteInitialProcedures - executes the initial procedures installed by
+ InstallInitialProcedure.
+*/
+
+extern "C" void M2RTS_ExecuteInitialProcedures (void)
+{
+ ExecuteReverse (InitialProc.tail);
+}
+
+
+/*
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
+*/
+
+extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p)
+{
+ return AppendProc (&InitialProc, p);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*/
+
+extern "C" void M2RTS_ExecuteTerminationProcedures (void)
+{
+ ExecuteReverse (TerminateProc.tail);
+}
+
+
+/*
+ Terminate - provides compatibility for pim. It calls exit with
+ the exitcode provided in a prior call to ExitOnHalt
+ (or zero if ExitOnHalt was never called). It does
+ not call ExecuteTerminationProcedures.
+*/
+
+extern "C" void M2RTS_Terminate (void)
+{
+ libc_exit (ExitValue);
+}
+
+
+/*
+ HALT - terminate the current program. The procedure
+ ExecuteTerminationProcedures
+ is called before the program is stopped. The parameter
+ exitcode is optional. If the parameter is not supplied
+ HALT will call libc 'abort', otherwise it will exit with
+ the code supplied. Supplying a parameter to HALT has the
+ same effect as calling ExitOnHalt with the same code and
+ then calling HALT with no parameter.
+*/
+
+extern "C" void M2RTS_HALT (int exitcode)
+{
+ if (exitcode != -1)
+ {
+ CallExit = TRUE;
+ ExitValue = exitcode;
+ }
+ if (isHalting)
+ {
+ /* double HALT found */
+ libc_exit (-1);
+ }
+ else
+ {
+ isHalting = TRUE;
+ M2RTS_ExecuteTerminationProcedures ();
+ }
+ if (CallExit)
+ {
+ libc_exit (ExitValue);
+ }
+ else
+ {
+ libc_abort ();
+ }
+}
+
+
+/*
+ Halt - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high)
+{
+ char filename[_filename_high+1];
+ char function[_function_high+1];
+ char description[_description_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (filename, filename_, _filename_high+1);
+ memcpy (function, function_, _function_high+1);
+ memcpy (description, description_, _description_high+1);
+
+ M2RTS_ErrorMessage ((const char *) description, _description_high, (const char *) filename, _filename_high, line, (const char *) function, _function_high);
+}
+
+
+/*
+ HaltC - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description)
+{
+ ErrorMessageC (description, filename, line, function);
+}
+
+
+/*
+ ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*/
+
+extern "C" void M2RTS_ExitOnHalt (int e)
+{
+ ExitValue = e;
+ CallExit = TRUE;
+}
+
+
+/*
+ ErrorMessage - emits an error message to stderr and then calls exit (1).
+*/
+
+extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high)
+{
+ typedef struct ErrorMessage__T3_a ErrorMessage__T3;
+
+ struct ErrorMessage__T3_a { char array[10+1]; };
+ ErrorMessage__T3 buffer;
+ char message[_message_high+1];
+ char filename[_filename_high+1];
+ char function[_function_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (message, message_, _message_high+1);
+ memcpy (filename, filename_, _filename_high+1);
+ memcpy (function, function_, _function_high+1);
+
+ ErrorString ((const char *) filename, _filename_high);
+ ErrorString ((const char *) ":", 1);
+ NumberIO_CardToStr (line, 0, (char *) &buffer.array[0], 10);
+ ErrorString ((const char *) &buffer.array[0], 10);
+ ErrorString ((const char *) ":", 1);
+ if (! (StrLib_StrEqual ((const char *) function, _function_high, (const char *) "", 0)))
+ {
+ ErrorString ((const char *) "in ", 3);
+ ErrorString ((const char *) function, _function_high);
+ ErrorString ((const char *) " has caused ", 12);
+ }
+ ErrorString ((const char *) message, _message_high);
+ buffer.array[0] = ASCII_nl;
+ buffer.array[1] = ASCII_nul;
+ ErrorString ((const char *) &buffer.array[0], 10);
+ libc_exit (1);
+}
+
+
+/*
+ Length - returns the length of a string, a. This is called whenever
+ the user calls LENGTH and the parameter cannot be calculated
+ at compile time.
+*/
+
+extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high)
+{
+ unsigned int l;
+ unsigned int h;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ l = 0;
+ h = _a_high;
+ while ((l <= h) && (a[l] != ASCII_nul))
+ {
+ l += 1;
+ }
+ return l;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ /*
+ The following are the runtime exception handler routines.
+ */
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), filename, line, column, scope, message);
+}
+
+extern "C" void _M2_M2RTS_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ CheckInitialized ();
+}
+
+extern "C" void _M2_M2RTS_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from NameKey. */
+/* NameKey.mod provides a dynamic binary tree name to key.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+#include <string.h>
+#include <limits.h>
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _NameKey_H
+#define _NameKey_C
+
+# include "GSYSTEM.h"
+# include "GStorage.h"
+# include "GIndexing.h"
+# include "GStrIO.h"
+# include "GStdIO.h"
+# include "GNumberIO.h"
+# include "GStrLib.h"
+# include "Glibc.h"
+# include "GASCII.h"
+# include "GM2RTS.h"
+
+# define NameKey_NulName 0
+typedef unsigned int NameKey_Name;
+
+typedef struct NameKey_Node_r NameKey_Node;
+
+typedef char *NameKey_PtrToChar;
+
+typedef NameKey_Node *NameKey_NameNode;
+
+typedef enum {NameKey_less, NameKey_equal, NameKey_greater} NameKey_Comparison;
+
+struct NameKey_Node_r {
+ NameKey_PtrToChar Data;
+ NameKey_Name Key;
+ NameKey_NameNode Left;
+ NameKey_NameNode Right;
+ };
+
+static NameKey_NameNode BinaryTree;
+static Indexing_Index KeyIndex;
+static unsigned int LastIndice;
+
+/*
+ MakeKey - returns the Key of the symbol, a. If a is not in the
+ name table then it is added, otherwise the Key of a is returned
+ directly. Note that the name table has no scope - it merely
+ presents a more convienient way of expressing strings. By a Key.
+*/
+
+extern "C" NameKey_Name NameKey_MakeKey (const char *a_, unsigned int _a_high);
+
+/*
+ makekey - returns the Key of the symbol, a. If a is not in the
+ name table then it is added, otherwise the Key of a is returned
+ directly. Note that the name table has no scope - it merely
+ presents a more convienient way of expressing strings. By a Key.
+ These keys last for the duration of compilation.
+*/
+
+extern "C" NameKey_Name NameKey_makekey (void * a);
+
+/*
+ GetKey - returns the name, a, of the key, Key.
+*/
+
+extern "C" void NameKey_GetKey (NameKey_Name key, char *a, unsigned int _a_high);
+
+/*
+ LengthKey - returns the StrLen of Key.
+*/
+
+extern "C" unsigned int NameKey_LengthKey (NameKey_Name Key);
+
+/*
+ IsKey - returns TRUE if string, a, is currently a key.
+ We dont use the Compare function, we inline it and avoid
+ converting, a, into a String, for speed.
+*/
+
+extern "C" unsigned int NameKey_IsKey (const char *a_, unsigned int _a_high);
+
+/*
+ KeyToCharStar - returns the C char * string equivalent for, key.
+*/
+
+extern "C" void NameKey_WriteKey (NameKey_Name key);
+
+/*
+ IsSameExcludingCase - returns TRUE if key1 and key2 are
+ the same. It is case insensitive.
+ This function deliberately inlines CAP for speed.
+*/
+
+extern "C" unsigned int NameKey_IsSameExcludingCase (NameKey_Name key1, NameKey_Name key2);
+
+/*
+ KeyToCharStar - returns the C char * string equivalent for, key.
+*/
+
+extern "C" void * NameKey_KeyToCharStar (NameKey_Name key);
+
+/*
+ CharKey - returns the key[i] character.
+*/
+
+extern "C" char NameKey_CharKey (NameKey_Name key, unsigned int i);
+
+/*
+ DoMakeKey - finds the name, n, in the tree or else create a name.
+ If a name is found then the string, n, is deallocated.
+*/
+
+static NameKey_Name DoMakeKey (NameKey_PtrToChar n, unsigned int higha);
+
+/*
+ Compare - return the result of Names[i] with Names[j]
+*/
+
+static NameKey_Comparison Compare (NameKey_PtrToChar pi, NameKey_Name j);
+
+/*
+ FindNodeAndParentInTree - search BinaryTree for a name.
+ If this name is found in the BinaryTree then
+ child is set to this name and father is set to the node above.
+ A comparison is returned to assist adding entries into this tree.
+*/
+
+static NameKey_Comparison FindNodeAndParentInTree (NameKey_PtrToChar n, NameKey_NameNode *child, NameKey_NameNode *father);
+
+
+/*
+ DoMakeKey - finds the name, n, in the tree or else create a name.
+ If a name is found then the string, n, is deallocated.
+*/
+
+static NameKey_Name DoMakeKey (NameKey_PtrToChar n, unsigned int higha)
+{
+ NameKey_Comparison result;
+ NameKey_NameNode father;
+ NameKey_NameNode child;
+ NameKey_Name k;
+
+ result = FindNodeAndParentInTree (n, &child, &father);
+ if (child == NULL)
+ {
+ if (result == NameKey_less)
+ {
+ Storage_ALLOCATE ((void **) &child, sizeof (NameKey_Node));
+ father->Left = child;
+ }
+ else if (result == NameKey_greater)
+ {
+ /* avoid dangling else. */
+ Storage_ALLOCATE ((void **) &child, sizeof (NameKey_Node));
+ father->Right = child;
+ }
+ child->Right = NULL;
+ child->Left = NULL;
+ LastIndice += 1;
+ child->Key = LastIndice;
+ child->Data = n;
+ Indexing_PutIndice (KeyIndex, child->Key, reinterpret_cast<void *> (n));
+ k = LastIndice;
+ }
+ else
+ {
+ Storage_DEALLOCATE (reinterpret_cast<void **> (&n), higha+1);
+ k = child->Key;
+ }
+ return k;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Compare - return the result of Names[i] with Names[j]
+*/
+
+static NameKey_Comparison Compare (NameKey_PtrToChar pi, NameKey_Name j)
+{
+ NameKey_PtrToChar pj;
+ char c1;
+ char c2;
+
+ pj = static_cast<NameKey_PtrToChar> (NameKey_KeyToCharStar (j));
+ c1 = (*pi);
+ c2 = (*pj);
+ while ((c1 != ASCII_nul) || (c2 != ASCII_nul))
+ {
+ if (c1 < c2)
+ {
+ return NameKey_less;
+ }
+ else if (c1 > c2)
+ {
+ /* avoid dangling else. */
+ return NameKey_greater;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ pi += 1;
+ pj += 1;
+ c1 = (*pi);
+ c2 = (*pj);
+ }
+ }
+ return NameKey_equal;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FindNodeAndParentInTree - search BinaryTree for a name.
+ If this name is found in the BinaryTree then
+ child is set to this name and father is set to the node above.
+ A comparison is returned to assist adding entries into this tree.
+*/
+
+static NameKey_Comparison FindNodeAndParentInTree (NameKey_PtrToChar n, NameKey_NameNode *child, NameKey_NameNode *father)
+{
+ NameKey_Comparison result;
+
+ /* firstly set up the initial values of child and father, using sentinal node */
+ (*father) = BinaryTree;
+ (*child) = BinaryTree->Left;
+ if ((*child) == NULL)
+ {
+ return NameKey_less;
+ }
+ else
+ {
+ do {
+ result = Compare (n, (*child)->Key);
+ if (result == NameKey_less)
+ {
+ (*father) = (*child);
+ (*child) = (*child)->Left;
+ }
+ else if (result == NameKey_greater)
+ {
+ /* avoid dangling else. */
+ (*father) = (*child);
+ (*child) = (*child)->Right;
+ }
+ } while (! (((*child) == NULL) || (result == NameKey_equal)));
+ return result;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ MakeKey - returns the Key of the symbol, a. If a is not in the
+ name table then it is added, otherwise the Key of a is returned
+ directly. Note that the name table has no scope - it merely
+ presents a more convienient way of expressing strings. By a Key.
+*/
+
+extern "C" NameKey_Name NameKey_MakeKey (const char *a_, unsigned int _a_high)
+{
+ NameKey_PtrToChar n;
+ NameKey_PtrToChar p;
+ unsigned int i;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ Storage_ALLOCATE (reinterpret_cast<void **> (&p), higha+1);
+ if (p == NULL)
+ {
+ M2RTS_HALT (-1); /* out of memory error */
+ __builtin_unreachable ();
+ }
+ else
+ {
+ n = p;
+ i = 0;
+ while (i < higha)
+ {
+ (*p) = a[i];
+ i += 1;
+ p += 1;
+ }
+ (*p) = ASCII_nul;
+ return DoMakeKey (n, higha);
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-compiler/NameKey.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ makekey - returns the Key of the symbol, a. If a is not in the
+ name table then it is added, otherwise the Key of a is returned
+ directly. Note that the name table has no scope - it merely
+ presents a more convienient way of expressing strings. By a Key.
+ These keys last for the duration of compilation.
+*/
+
+extern "C" NameKey_Name NameKey_makekey (void * a)
+{
+ NameKey_PtrToChar n;
+ NameKey_PtrToChar p;
+ NameKey_PtrToChar pa;
+ unsigned int i;
+ unsigned int higha;
+
+ if (a == NULL)
+ {
+ return NameKey_NulName;
+ }
+ else
+ {
+ higha = static_cast<unsigned int> (libc_strlen (a));
+ Storage_ALLOCATE (reinterpret_cast<void **> (&p), higha+1);
+ if (p == NULL)
+ {
+ M2RTS_HALT (-1); /* out of memory error */
+ __builtin_unreachable ();
+ }
+ else
+ {
+ n = p;
+ pa = static_cast<NameKey_PtrToChar> (a);
+ i = 0;
+ while (i < higha)
+ {
+ (*p) = (*pa);
+ i += 1;
+ p += 1;
+ pa += 1;
+ }
+ (*p) = ASCII_nul;
+ return DoMakeKey (n, higha);
+ }
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-compiler/NameKey.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetKey - returns the name, a, of the key, Key.
+*/
+
+extern "C" void NameKey_GetKey (NameKey_Name key, char *a, unsigned int _a_high)
+{
+ NameKey_PtrToChar p;
+ unsigned int i;
+ unsigned int higha;
+
+ p = static_cast<NameKey_PtrToChar> (NameKey_KeyToCharStar (key));
+ i = 0;
+ higha = _a_high;
+ while (((p != NULL) && (i <= higha)) && ((*p) != ASCII_nul))
+ {
+ a[i] = (*p);
+ p += 1;
+ i += 1;
+ }
+ if (i <= higha)
+ {
+ a[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ LengthKey - returns the StrLen of Key.
+*/
+
+extern "C" unsigned int NameKey_LengthKey (NameKey_Name Key)
+{
+ unsigned int i;
+ NameKey_PtrToChar p;
+
+ p = static_cast<NameKey_PtrToChar> (NameKey_KeyToCharStar (Key));
+ i = 0;
+ while ((*p) != ASCII_nul)
+ {
+ i += 1;
+ p += 1;
+ }
+ return i;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsKey - returns TRUE if string, a, is currently a key.
+ We dont use the Compare function, we inline it and avoid
+ converting, a, into a String, for speed.
+*/
+
+extern "C" unsigned int NameKey_IsKey (const char *a_, unsigned int _a_high)
+{
+ NameKey_NameNode child;
+ NameKey_PtrToChar p;
+ unsigned int i;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ /* firstly set up the initial values of child, using sentinal node */
+ child = BinaryTree->Left;
+ if (child != NULL)
+ {
+ do {
+ i = 0;
+ higha = _a_high;
+ p = static_cast<NameKey_PtrToChar> (NameKey_KeyToCharStar (child->Key));
+ while ((i <= higha) && (a[i] != ASCII_nul))
+ {
+ if (a[i] < (*p))
+ {
+ child = child->Left;
+ i = higha;
+ }
+ else if (a[i] > (*p))
+ {
+ /* avoid dangling else. */
+ child = child->Right;
+ i = higha;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ if ((a[i] == ASCII_nul) || (i == higha))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((*p) == ASCII_nul)
+ {
+ return TRUE;
+ }
+ else
+ {
+ child = child->Left;
+ }
+ }
+ p += 1;
+ }
+ i += 1;
+ }
+ } while (! (child == NULL));
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KeyToCharStar - returns the C char * string equivalent for, key.
+*/
+
+extern "C" void NameKey_WriteKey (NameKey_Name key)
+{
+ NameKey_PtrToChar s;
+
+ s = static_cast<NameKey_PtrToChar> (NameKey_KeyToCharStar (key));
+ while ((s != NULL) && ((*s) != ASCII_nul))
+ {
+ StdIO_Write ((*s));
+ s += 1;
+ }
+}
+
+
+/*
+ IsSameExcludingCase - returns TRUE if key1 and key2 are
+ the same. It is case insensitive.
+ This function deliberately inlines CAP for speed.
+*/
+
+extern "C" unsigned int NameKey_IsSameExcludingCase (NameKey_Name key1, NameKey_Name key2)
+{
+ NameKey_PtrToChar pi;
+ NameKey_PtrToChar pj;
+ char c1;
+ char c2;
+
+ if (key1 == key2)
+ {
+ return TRUE;
+ }
+ else
+ {
+ pi = static_cast<NameKey_PtrToChar> (NameKey_KeyToCharStar (key1));
+ pj = static_cast<NameKey_PtrToChar> (NameKey_KeyToCharStar (key2));
+ c1 = (*pi);
+ c2 = (*pj);
+ while ((c1 != ASCII_nul) && (c2 != ASCII_nul))
+ {
+ if (((c1 == c2) || (((c1 >= 'A') && (c1 <= 'Z')) && (c2 == ((char) (( ((unsigned int) (c1))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))))))) || (((c2 >= 'A') && (c2 <= 'Z')) && (c1 == ((char) (( ((unsigned int) (c2))- ((unsigned int) ('A')))+ ((unsigned int) ('a')))))))
+ {
+ pi += 1;
+ pj += 1;
+ c1 = (*pi);
+ c2 = (*pj);
+ }
+ else
+ {
+ /* difference found */
+ return FALSE;
+ }
+ }
+ return c1 == c2;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KeyToCharStar - returns the C char * string equivalent for, key.
+*/
+
+extern "C" void * NameKey_KeyToCharStar (NameKey_Name key)
+{
+ if ((key == NameKey_NulName) || (! (Indexing_InBounds (KeyIndex, key))))
+ {
+ return NULL;
+ }
+ else
+ {
+ return Indexing_GetIndice (KeyIndex, key);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CharKey - returns the key[i] character.
+*/
+
+extern "C" char NameKey_CharKey (NameKey_Name key, unsigned int i)
+{
+ NameKey_PtrToChar p;
+
+ if (i >= (NameKey_LengthKey (key)))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ p = static_cast<NameKey_PtrToChar> (NameKey_KeyToCharStar (key));
+ p += i;
+ return (*p);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_NameKey_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ LastIndice = 0;
+ KeyIndex = Indexing_InitIndex (1);
+ Storage_ALLOCATE ((void **) &BinaryTree, sizeof (NameKey_Node));
+ BinaryTree->Left = NULL;
+}
+
+extern "C" void _M2_NameKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from NumberIO. */
+/* NumberIO.mod provides conversion of ordinal numbers.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <string.h>
+#include <limits.h>
+#include <stdlib.h>
+#define _NumberIO_H
+#define _NumberIO_C
+
+# include "GASCII.h"
+# include "GStrIO.h"
+# include "GStrLib.h"
+# include "GM2RTS.h"
+
+# define MaxLineLength 79
+# define MaxDigits 20
+# define MaxHexDigits 20
+# define MaxOctDigits 40
+# define MaxBits 64
+extern "C" void NumberIO_ReadCard (unsigned int *x);
+extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n);
+extern "C" void NumberIO_ReadHex (unsigned int *x);
+extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n);
+extern "C" void NumberIO_ReadInt (int *x);
+extern "C" void NumberIO_WriteInt (int x, unsigned int n);
+extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_ReadOct (unsigned int *x);
+extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n);
+extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_ReadBin (unsigned int *x);
+extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n);
+extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x);
+
+extern "C" void NumberIO_ReadCard (unsigned int *x)
+{
+ typedef struct ReadCard__T1_a ReadCard__T1;
+
+ struct ReadCard__T1_a { char array[MaxLineLength+1]; };
+ ReadCard__T1 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToCard ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n)
+{
+ typedef struct WriteCard__T2_a WriteCard__T2;
+
+ struct WriteCard__T2_a { char array[MaxLineLength+1]; };
+ WriteCard__T2 a;
+
+ NumberIO_CardToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_ReadHex (unsigned int *x)
+{
+ typedef struct ReadHex__T3_a ReadHex__T3;
+
+ struct ReadHex__T3_a { char array[MaxLineLength+1]; };
+ ReadHex__T3 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToHex ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n)
+{
+ typedef struct WriteHex__T4_a WriteHex__T4;
+
+ struct WriteHex__T4_a { char array[MaxLineLength+1]; };
+ WriteHex__T4 a;
+
+ NumberIO_HexToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_ReadInt (int *x)
+{
+ typedef struct ReadInt__T5_a ReadInt__T5;
+
+ struct ReadInt__T5_a { char array[MaxLineLength+1]; };
+ ReadInt__T5 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToInt ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteInt (int x, unsigned int n)
+{
+ typedef struct WriteInt__T6_a WriteInt__T6;
+
+ struct WriteInt__T6_a { char array[MaxLineLength+1]; };
+ WriteInt__T6 a;
+
+ NumberIO_IntToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct CardToStr__T7_a CardToStr__T7;
+
+ struct CardToStr__T7_a { unsigned int array[MaxDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ CardToStr__T7 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 10;
+ x = x / 10;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ while ((i > 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if ((a[i] < '0') || (a[i] > '9'))
+ {
+ i += 1;
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ (*x) = (10*(*x))+( ((unsigned int) (a[i]))- ((unsigned int) ('0')));
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '9'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct HexToStr__T8_a HexToStr__T8;
+
+ struct HexToStr__T8_a { unsigned int array[MaxHexDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ HexToStr__T8 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxHexDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 0x010;
+ x = x / 0x010;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = '0';
+ j += 1;
+ n -= 1;
+ }
+ while ((i != 0) && (j <= Higha))
+ {
+ if (buf.array[i-1] < 10)
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ }
+ else
+ {
+ a[j] = ((char) ((buf.array[i-1]+ ((unsigned int) ('A')))-10));
+ }
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ NumberIO_StrToHexInt ((const char *) a, _a_high, &i);
+ (*x) = (unsigned int ) (i);
+}
+
+extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct IntToStr__T9_a IntToStr__T9;
+
+ struct IntToStr__T9_a { unsigned int array[MaxDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int c;
+ unsigned int Higha;
+ IntToStr__T9 buf;
+ unsigned int Negative;
+
+ if (x < 0)
+ {
+ /* avoid dangling else. */
+ Negative = TRUE;
+ c = ((unsigned int ) (abs (x+1)))+1;
+ if (n > 0)
+ {
+ n -= 1;
+ }
+ }
+ else
+ {
+ c = x;
+ Negative = FALSE;
+ }
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = c % 10;
+ c = c / 10;
+ } while (! (c == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ if (Negative)
+ {
+ a[j] = '-';
+ j += 1;
+ }
+ while ((i != 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int Negative;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ Negative = FALSE;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if (a[i] == '-')
+ {
+ i += 1;
+ Negative = ! Negative;
+ }
+ else if ((a[i] < '0') || (a[i] > '9'))
+ {
+ /* avoid dangling else. */
+ i += 1;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ if (Negative)
+ {
+ (*x) = (10*(*x))-((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ }
+ else
+ {
+ (*x) = (10*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ }
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '9'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_ReadOct (unsigned int *x)
+{
+ typedef struct ReadOct__T10_a ReadOct__T10;
+
+ struct ReadOct__T10_a { char array[MaxLineLength+1]; };
+ ReadOct__T10 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToOct ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n)
+{
+ typedef struct WriteOct__T11_a WriteOct__T11;
+
+ struct WriteOct__T11_a { char array[MaxLineLength+1]; };
+ WriteOct__T11 a;
+
+ NumberIO_OctToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct OctToStr__T12_a OctToStr__T12;
+
+ struct OctToStr__T12_a { unsigned int array[MaxOctDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ OctToStr__T12 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxOctDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 8;
+ x = x / 8;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ while ((i > 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ NumberIO_StrToOctInt ((const char *) a, _a_high, &i);
+ (*x) = (unsigned int ) (i);
+}
+
+extern "C" void NumberIO_ReadBin (unsigned int *x)
+{
+ typedef struct ReadBin__T13_a ReadBin__T13;
+
+ struct ReadBin__T13_a { char array[MaxLineLength+1]; };
+ ReadBin__T13 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToBin ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n)
+{
+ typedef struct WriteBin__T14_a WriteBin__T14;
+
+ struct WriteBin__T14_a { char array[MaxLineLength+1]; };
+ WriteBin__T14 a;
+
+ NumberIO_BinToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct BinToStr__T15_a BinToStr__T15;
+
+ struct BinToStr__T15_a { unsigned int array[MaxBits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ BinToStr__T15 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxBits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxBits", 27);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 2;
+ x = x / 2;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ while ((i > 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ NumberIO_StrToBinInt ((const char *) a, _a_high, &i);
+ (*x) = (unsigned int ) (i);
+}
+
+extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if ((a[i] < '0') || (a[i] > '1'))
+ {
+ i += 1;
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ (*x) = (2*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '1'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if (((a[i] >= '0') && (a[i] <= '9')) || ((a[i] >= 'A') && (a[i] <= 'F')))
+ {
+ ok = FALSE;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ if ((a[i] >= '0') && (a[i] <= '9'))
+ {
+ (*x) = (0x010*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ }
+ else if ((a[i] >= 'A') && (a[i] <= 'F'))
+ {
+ /* avoid dangling else. */
+ (*x) = (0x010*(*x))+((int ) (( ((unsigned int) (a[i]))- ((unsigned int) ('A')))+10));
+ }
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if (((a[i] < '0') || (a[i] > '9')) && ((a[i] < 'A') || (a[i] > 'F')))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if ((a[i] < '0') || (a[i] > '7'))
+ {
+ i += 1;
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ (*x) = (8*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '7'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void _M2_NumberIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_NumberIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Output. */
+/* Output.mod redirect output.
+
+Copyright (C) 2021-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+#include <string.h>
+#include <limits.h>
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _Output_H
+#define _Output_C
+
+# include "GFIO.h"
+# include "GSFIO.h"
+# include "GStrLib.h"
+# include "GNameKey.h"
+# include "GNumberIO.h"
+# include "GASCII.h"
+# include "GDynamicStrings.h"
+
+static unsigned int stdout_;
+static FIO_File outputFile;
+static DynamicStrings_String buffer;
+
+/*
+ Open - attempt to open filename as the output file.
+ TRUE is returned if success, FALSE otherwise.
+*/
+
+extern "C" unsigned int Output_Open (const char *filename_, unsigned int _filename_high);
+
+/*
+ Close - close the output file.
+*/
+
+extern "C" void Output_Close (void);
+
+/*
+ Write - write a single character to the output file.
+*/
+
+extern "C" void Output_Write (char ch);
+
+/*
+ WriteString - write an unformatted string to the output.
+*/
+
+extern "C" void Output_WriteString (const char *s_, unsigned int _s_high);
+
+/*
+ KillWriteS - write a string to the output and free the string afterwards.
+*/
+
+extern "C" void Output_KillWriteS (DynamicStrings_String s);
+
+/*
+ WriteS - write a string to the output. The string is not freed.
+*/
+
+extern "C" void Output_WriteS (DynamicStrings_String s);
+
+/*
+ WriteKey - write a key to the output.
+*/
+
+extern "C" void Output_WriteKey (NameKey_Name key);
+
+/*
+ WriteLn - write a newline to the output.
+*/
+
+extern "C" void Output_WriteLn (void);
+
+/*
+ WriteCard - write a cardinal using fieldlength characters.
+*/
+
+extern "C" void Output_WriteCard (unsigned int card, unsigned int fieldlength);
+
+/*
+ StartBuffer - create a buffer into which any output is redirected.
+*/
+
+extern "C" void Output_StartBuffer (void);
+
+/*
+ EndBuffer - end the redirection and return the contents of the buffer.
+*/
+
+extern "C" DynamicStrings_String Output_EndBuffer (void);
+
+
+/*
+ Open - attempt to open filename as the output file.
+ TRUE is returned if success, FALSE otherwise.
+*/
+
+extern "C" unsigned int Output_Open (const char *filename_, unsigned int _filename_high)
+{
+ char filename[_filename_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (filename, filename_, _filename_high+1);
+
+ if ((StrLib_StrEqual ((const char *) filename, _filename_high, (const char *) "<stdout>", 8)) || (StrLib_StrEqual ((const char *) filename, _filename_high, (const char *) "-", 1)))
+ {
+ outputFile = FIO_StdOut;
+ stdout_ = TRUE;
+ return TRUE;
+ }
+ else
+ {
+ outputFile = FIO_OpenToWrite ((const char *) filename, _filename_high);
+ stdout_ = FALSE;
+ return FIO_IsNoError (outputFile);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Close - close the output file.
+*/
+
+extern "C" void Output_Close (void)
+{
+ FIO_Close (outputFile);
+}
+
+
+/*
+ Write - write a single character to the output file.
+*/
+
+extern "C" void Output_Write (char ch)
+{
+ if (buffer == NULL)
+ {
+ FIO_WriteChar (outputFile, ch);
+ }
+ else
+ {
+ buffer = DynamicStrings_ConCatChar (buffer, ch);
+ }
+}
+
+
+/*
+ WriteString - write an unformatted string to the output.
+*/
+
+extern "C" void Output_WriteString (const char *s_, unsigned int _s_high)
+{
+ char s[_s_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (s, s_, _s_high+1);
+
+ if (buffer == NULL)
+ {
+ FIO_WriteString (outputFile, (const char *) s, _s_high);
+ }
+ else
+ {
+ buffer = DynamicStrings_ConCat (buffer, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) s, _s_high)));
+ }
+}
+
+
+/*
+ KillWriteS - write a string to the output and free the string afterwards.
+*/
+
+extern "C" void Output_KillWriteS (DynamicStrings_String s)
+{
+ if ((DynamicStrings_KillString (SFIO_WriteS (outputFile, s))) == NULL)
+ {} /* empty. */
+}
+
+
+/*
+ WriteS - write a string to the output. The string is not freed.
+*/
+
+extern "C" void Output_WriteS (DynamicStrings_String s)
+{
+ if ((SFIO_WriteS (outputFile, s)) == s)
+ {} /* empty. */
+}
+
+
+/*
+ WriteKey - write a key to the output.
+*/
+
+extern "C" void Output_WriteKey (NameKey_Name key)
+{
+ if (buffer == NULL)
+ {
+ Output_KillWriteS (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (key)));
+ }
+ else
+ {
+ buffer = DynamicStrings_ConCat (buffer, DynamicStrings_Mark (DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (key))));
+ }
+}
+
+
+/*
+ WriteLn - write a newline to the output.
+*/
+
+extern "C" void Output_WriteLn (void)
+{
+ if (buffer == NULL)
+ {
+ FIO_WriteLine (outputFile);
+ }
+ else
+ {
+ Output_Write (ASCII_nl);
+ }
+}
+
+
+/*
+ WriteCard - write a cardinal using fieldlength characters.
+*/
+
+extern "C" void Output_WriteCard (unsigned int card, unsigned int fieldlength)
+{
+ typedef struct WriteCard__T1_a WriteCard__T1;
+
+ struct WriteCard__T1_a { char array[20+1]; };
+ WriteCard__T1 s;
+
+ NumberIO_CardToStr (card, fieldlength, (char *) &s.array[0], 20);
+ Output_WriteString ((const char *) &s.array[0], 20);
+}
+
+
+/*
+ StartBuffer - create a buffer into which any output is redirected.
+*/
+
+extern "C" void Output_StartBuffer (void)
+{
+ if (buffer != NULL)
+ {
+ buffer = DynamicStrings_KillString (buffer);
+ }
+ buffer = DynamicStrings_InitString ((const char *) "", 0);
+}
+
+
+/*
+ EndBuffer - end the redirection and return the contents of the buffer.
+*/
+
+extern "C" DynamicStrings_String Output_EndBuffer (void)
+{
+ DynamicStrings_String s;
+
+ s = buffer;
+ buffer = static_cast<DynamicStrings_String> (NULL);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_Output_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ stdout_ = TRUE;
+ buffer = static_cast<DynamicStrings_String> (NULL);
+ outputFile = FIO_StdOut;
+}
+
+extern "C" void _M2_Output_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from PushBackInput. */
+/* PushBackInput.mod provides a method for pushing back and consuming input.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+#include <string.h>
+#include <limits.h>
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _PushBackInput_H
+#define _PushBackInput_C
+
+# include "GFIO.h"
+# include "GDynamicStrings.h"
+# include "GASCII.h"
+# include "GDebug.h"
+# include "GStrLib.h"
+# include "GNumberIO.h"
+# include "GStrIO.h"
+# include "GStdIO.h"
+# include "Glibc.h"
+
+# define MaxPushBackStack 8192
+# define MaxFileName 4096
+typedef struct PushBackInput__T2_a PushBackInput__T2;
+
+typedef struct PushBackInput__T3_a PushBackInput__T3;
+
+struct PushBackInput__T2_a { char array[MaxFileName+1]; };
+struct PushBackInput__T3_a { char array[MaxPushBackStack+1]; };
+static PushBackInput__T2 FileName;
+static PushBackInput__T3 CharStack;
+static unsigned int ExitStatus;
+static unsigned int Column;
+static unsigned int StackPtr;
+static unsigned int LineNo;
+static unsigned int Debugging;
+
+/*
+ Open - opens a file for reading.
+*/
+
+extern "C" FIO_File PushBackInput_Open (const char *a_, unsigned int _a_high);
+
+/*
+ GetCh - gets a character from either the push back stack or
+ from file, f.
+*/
+
+extern "C" char PushBackInput_GetCh (FIO_File f);
+
+/*
+ PutCh - pushes a character onto the push back stack, it also
+ returns the character which has been pushed.
+*/
+
+extern "C" char PushBackInput_PutCh (char ch);
+
+/*
+ PutString - pushes a string onto the push back stack.
+*/
+
+extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high);
+
+/*
+ PutStr - pushes a dynamic string onto the push back stack.
+ The string, s, is not deallocated.
+*/
+
+extern "C" void PushBackInput_PutStr (DynamicStrings_String s);
+
+/*
+ Error - emits an error message with the appropriate file, line combination.
+*/
+
+extern "C" void PushBackInput_Error (const char *a_, unsigned int _a_high);
+
+/*
+ WarnError - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnError (const char *a_, unsigned int _a_high);
+
+/*
+ WarnString - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnString (DynamicStrings_String s);
+
+/*
+ Close - closes the opened file.
+*/
+
+extern "C" void PushBackInput_Close (FIO_File f);
+
+/*
+ GetExitStatus - returns the exit status which will be 1 if any warnings were issued.
+*/
+
+extern "C" unsigned int PushBackInput_GetExitStatus (void);
+
+/*
+ SetDebug - sets the debug flag on or off.
+*/
+
+extern "C" void PushBackInput_SetDebug (unsigned int d);
+
+/*
+ GetColumnPosition - returns the column position of the current character.
+*/
+
+extern "C" unsigned int PushBackInput_GetColumnPosition (void);
+
+/*
+ GetCurrentLine - returns the current line number.
+*/
+
+extern "C" unsigned int PushBackInput_GetCurrentLine (void);
+
+/*
+ ErrChar - writes a char, ch, to stderr.
+*/
+
+static void ErrChar (char ch);
+
+/*
+ Init - initialize global variables.
+*/
+
+static void Init (void);
+
+
+/*
+ ErrChar - writes a char, ch, to stderr.
+*/
+
+static void ErrChar (char ch)
+{
+ FIO_WriteChar (FIO_StdErr, ch);
+}
+
+
+/*
+ Init - initialize global variables.
+*/
+
+static void Init (void)
+{
+ ExitStatus = 0;
+ StackPtr = 0;
+ LineNo = 1;
+ Column = 0;
+}
+
+
+/*
+ Open - opens a file for reading.
+*/
+
+extern "C" FIO_File PushBackInput_Open (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ Init ();
+ StrLib_StrCopy ((const char *) a, _a_high, (char *) &FileName.array[0], MaxFileName);
+ return FIO_OpenToRead ((const char *) a, _a_high);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetCh - gets a character from either the push back stack or
+ from file, f.
+*/
+
+extern "C" char PushBackInput_GetCh (FIO_File f)
+{
+ char ch;
+
+ if (StackPtr > 0)
+ {
+ StackPtr -= 1;
+ if (Debugging)
+ {
+ StdIO_Write (CharStack.array[StackPtr]);
+ }
+ return CharStack.array[StackPtr];
+ }
+ else
+ {
+ if ((FIO_EOF (f)) || (! (FIO_IsNoError (f))))
+ {
+ ch = ASCII_nul;
+ }
+ else
+ {
+ do {
+ ch = FIO_ReadChar (f);
+ } while (! (((ch != ASCII_cr) || (FIO_EOF (f))) || (! (FIO_IsNoError (f)))));
+ if (ch == ASCII_lf)
+ {
+ Column = 0;
+ LineNo += 1;
+ }
+ else
+ {
+ Column += 1;
+ }
+ }
+ if (Debugging)
+ {
+ StdIO_Write (ch);
+ }
+ return ch;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutCh - pushes a character onto the push back stack, it also
+ returns the character which has been pushed.
+*/
+
+extern "C" char PushBackInput_PutCh (char ch)
+{
+ if (StackPtr < MaxPushBackStack)
+ {
+ CharStack.array[StackPtr] = ch;
+ StackPtr += 1;
+ }
+ else
+ {
+ Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ }
+ return ch;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutString - pushes a string onto the push back stack.
+*/
+
+extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high)
+{
+ unsigned int l;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ l = StrLib_StrLen ((const char *) a, _a_high);
+ while (l > 0)
+ {
+ l -= 1;
+ if ((PushBackInput_PutCh (a[l])) != a[l])
+ {
+ Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ }
+ }
+}
+
+
+/*
+ PutStr - pushes a dynamic string onto the push back stack.
+ The string, s, is not deallocated.
+*/
+
+extern "C" void PushBackInput_PutStr (DynamicStrings_String s)
+{
+ unsigned int i;
+
+ i = DynamicStrings_Length (s);
+ while (i > 0)
+ {
+ i -= 1;
+ if ((PushBackInput_PutCh (DynamicStrings_char (s, static_cast<int> (i)))) != (DynamicStrings_char (s, static_cast<int> (i))))
+ {
+ Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ }
+ }
+}
+
+
+/*
+ Error - emits an error message with the appropriate file, line combination.
+*/
+
+extern "C" void PushBackInput_Error (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) ErrChar});
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ StrIO_WriteString ((const char *) a, _a_high);
+ StrIO_WriteLn ();
+ StdIO_PopOutput ();
+ FIO_Close (FIO_StdErr);
+ libc_exit (1);
+}
+
+
+/*
+ WarnError - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnError (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) ErrChar});
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ StrIO_WriteString ((const char *) a, _a_high);
+ StrIO_WriteLn ();
+ StdIO_PopOutput ();
+ ExitStatus = 1;
+}
+
+
+/*
+ WarnString - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnString (DynamicStrings_String s)
+{
+ typedef char *WarnString__T1;
+
+ WarnString__T1 p;
+
+ p = static_cast<WarnString__T1> (DynamicStrings_string (s));
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ do {
+ if (p != NULL)
+ {
+ if ((*p) == ASCII_lf)
+ {
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ }
+ else
+ {
+ StdIO_Write ((*p));
+ }
+ p += 1;
+ }
+ } while (! ((p == NULL) || ((*p) == ASCII_nul)));
+ ExitStatus = 1;
+}
+
+
+/*
+ Close - closes the opened file.
+*/
+
+extern "C" void PushBackInput_Close (FIO_File f)
+{
+ FIO_Close (f);
+}
+
+
+/*
+ GetExitStatus - returns the exit status which will be 1 if any warnings were issued.
+*/
+
+extern "C" unsigned int PushBackInput_GetExitStatus (void)
+{
+ return ExitStatus;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetDebug - sets the debug flag on or off.
+*/
+
+extern "C" void PushBackInput_SetDebug (unsigned int d)
+{
+ Debugging = d;
+}
+
+
+/*
+ GetColumnPosition - returns the column position of the current character.
+*/
+
+extern "C" unsigned int PushBackInput_GetColumnPosition (void)
+{
+ if (StackPtr > Column)
+ {
+ return 0;
+ }
+ else
+ {
+ return Column-StackPtr;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetCurrentLine - returns the current line number.
+*/
+
+extern "C" unsigned int PushBackInput_GetCurrentLine (void)
+{
+ return LineNo;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_PushBackInput_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ PushBackInput_SetDebug (FALSE);
+ Init ();
+}
+
+extern "C" void _M2_PushBackInput_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from RTExceptions. */
+/* RTExceptions.mod runtime exception handler routines.
+
+Copyright (C) 2008-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+#include <string.h>
+#include <limits.h>
+#include <stdlib.h>
+# include "GStorage.h"
+# include "Gmcrts.h"
+#include <unistd.h>
+#ifndef __cplusplus
+extern void throw (unsigned int);
+#endif
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _RTExceptions_H
+#define _RTExceptions_C
+
+# include "GASCII.h"
+# include "GStrLib.h"
+# include "GStorage.h"
+# include "GSYSTEM.h"
+# include "Glibc.h"
+# include "GM2RTS.h"
+# include "GSysExceptions.h"
+# include "GM2EXCEPTION.h"
+
+typedef struct RTExceptions_ProcedureHandler_p RTExceptions_ProcedureHandler;
+
+# define MaxBuffer 4096
+typedef struct RTExceptions__T1_r RTExceptions__T1;
+
+typedef char *RTExceptions_PtrToChar;
+
+typedef struct RTExceptions__T2_a RTExceptions__T2;
+
+typedef struct RTExceptions__T3_r RTExceptions__T3;
+
+typedef RTExceptions__T3 *RTExceptions_Handler;
+
+typedef RTExceptions__T1 *RTExceptions_EHBlock;
+
+typedef void (*RTExceptions_ProcedureHandler_t) (void);
+struct RTExceptions_ProcedureHandler_p { RTExceptions_ProcedureHandler_t proc; };
+
+struct RTExceptions__T2_a { char array[MaxBuffer+1]; };
+struct RTExceptions__T1_r {
+ RTExceptions__T2 buffer;
+ unsigned int number;
+ RTExceptions_Handler handlers;
+ RTExceptions_EHBlock right;
+ };
+
+struct RTExceptions__T3_r {
+ RTExceptions_ProcedureHandler p;
+ unsigned int n;
+ RTExceptions_Handler right;
+ RTExceptions_Handler left;
+ RTExceptions_Handler stack;
+ };
+
+static unsigned int inException;
+static RTExceptions_Handler freeHandler;
+static RTExceptions_EHBlock freeEHB;
+static RTExceptions_EHBlock currentEHB;
+static void * currentSource;
+
+/*
+ Raise - invoke the exception handler associated with, number,
+ in the active EHBlock. It keeps a record of the number
+ and message in the EHBlock for later use.
+*/
+
+extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message) __attribute__ ((noreturn));
+
+/*
+ SetExceptionBlock - sets, source, as the active EHB.
+*/
+
+extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source);
+
+/*
+ GetExceptionBlock - returns the active EHB.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void);
+
+/*
+ GetTextBuffer - returns the address of the EHB buffer.
+*/
+
+extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e);
+
+/*
+ GetTextBufferSize - return the size of the EHB text buffer.
+*/
+
+extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e);
+
+/*
+ GetNumber - return the exception number associated with,
+ source.
+*/
+
+extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source);
+
+/*
+ InitExceptionBlock - creates and returns a new exception block.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void);
+
+/*
+ KillExceptionBlock - destroys the EHB, e, and all its handlers.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e);
+
+/*
+ PushHandler - install a handler in EHB, e.
+*/
+
+extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p);
+
+/*
+ PopHandler - removes the handler associated with, number, from
+ EHB, e.
+*/
+
+extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number);
+
+/*
+ DefaultErrorCatch - displays the current error message in
+ the current exception block and then
+ calls HALT.
+*/
+
+extern "C" void RTExceptions_DefaultErrorCatch (void);
+
+/*
+ BaseExceptionsThrow - configures the Modula-2 exceptions to call
+ THROW which in turn can be caught by an
+ exception block. If this is not called then
+ a Modula-2 exception will simply call an
+ error message routine and then HALT.
+*/
+
+extern "C" void RTExceptions_BaseExceptionsThrow (void);
+
+/*
+ IsInExceptionState - returns TRUE if the program is currently
+ in the exception state.
+*/
+
+extern "C" unsigned int RTExceptions_IsInExceptionState (void);
+
+/*
+ SetExceptionState - returns the current exception state and
+ then sets the current exception state to,
+ to.
+*/
+
+extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to);
+
+/*
+ SwitchExceptionState - assigns, from, with the current exception
+ state and then assigns the current exception
+ to, to.
+*/
+
+extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to);
+
+/*
+ GetBaseExceptionBlock - returns the initial language exception block
+ created.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void);
+
+/*
+ SetExceptionSource - sets the current exception source to, source.
+*/
+
+extern "C" void RTExceptions_SetExceptionSource (void * source);
+
+/*
+ GetExceptionSource - returns the current exception source.
+*/
+
+extern "C" void * RTExceptions_GetExceptionSource (void);
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high);
+
+/*
+ findHandler -
+*/
+
+static RTExceptions_Handler findHandler (RTExceptions_EHBlock e, unsigned int number);
+
+/*
+ InvokeHandler - invokes the associated handler for the current
+ exception in the active EHB.
+*/
+
+static void InvokeHandler (void) __attribute__ ((noreturn));
+
+/*
+ DoThrow - throw the exception number in the exception block.
+*/
+
+static void DoThrow (void);
+
+/*
+ addChar - adds, ch, to the current exception handler text buffer
+ at index, i. The index in then incremented.
+*/
+
+static void addChar (char ch, unsigned int *i);
+
+/*
+ stripPath - returns the filename from the path.
+*/
+
+static void * stripPath (void * s);
+
+/*
+ addFile - adds the filename determined by, s, however it strips
+ any preceeding path.
+*/
+
+static void addFile (void * s, unsigned int *i);
+
+/*
+ addStr - adds a C string from address, s, into the current
+ handler text buffer.
+*/
+
+static void addStr (void * s, unsigned int *i);
+
+/*
+ addNum - adds a number, n, to the current handler
+ text buffer.
+*/
+
+static void addNum (unsigned int n, unsigned int *i);
+
+/*
+ New - returns a new EHBlock.
+*/
+
+static RTExceptions_EHBlock New (void);
+
+/*
+ NewHandler - returns a new handler.
+*/
+
+static RTExceptions_Handler NewHandler (void);
+
+/*
+ KillHandler - returns, NIL, and places, h, onto the free list.
+*/
+
+static RTExceptions_Handler KillHandler (RTExceptions_Handler h);
+
+/*
+ KillHandlers - kills all handlers in the list.
+*/
+
+static RTExceptions_Handler KillHandlers (RTExceptions_Handler h);
+
+/*
+ InitHandler -
+*/
+
+static RTExceptions_Handler InitHandler (RTExceptions_Handler h, RTExceptions_Handler l, RTExceptions_Handler r, RTExceptions_Handler s, unsigned int number, RTExceptions_ProcedureHandler proc);
+
+/*
+ SubHandler -
+*/
+
+static void SubHandler (RTExceptions_Handler h);
+
+/*
+ AddHandler - add, e, to the end of the list of handlers.
+*/
+
+static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h);
+
+/*
+ indexf - raise an index out of bounds exception.
+*/
+
+static void indexf (void * a);
+
+/*
+ range - raise an assignment out of range exception.
+*/
+
+static void range (void * a);
+
+/*
+ casef - raise a case selector out of range exception.
+*/
+
+static void casef (void * a);
+
+/*
+ invalidloc - raise an invalid location exception.
+*/
+
+static void invalidloc (void * a);
+
+/*
+ function - raise a ... function ... exception. --fixme-- what does this exception catch?
+*/
+
+static void function (void * a);
+
+/*
+ wholevalue - raise an illegal whole value exception.
+*/
+
+static void wholevalue (void * a);
+
+/*
+ wholediv - raise a division by zero exception.
+*/
+
+static void wholediv (void * a);
+
+/*
+ realvalue - raise an illegal real value exception.
+*/
+
+static void realvalue (void * a);
+
+/*
+ realdiv - raise a division by zero in a real number exception.
+*/
+
+static void realdiv (void * a);
+
+/*
+ complexvalue - raise an illegal complex value exception.
+*/
+
+static void complexvalue (void * a);
+
+/*
+ complexdiv - raise a division by zero in a complex number exception.
+*/
+
+static void complexdiv (void * a);
+
+/*
+ protection - raise a protection exception.
+*/
+
+static void protection (void * a);
+
+/*
+ systemf - raise a system exception.
+*/
+
+static void systemf (void * a);
+
+/*
+ coroutine - raise a coroutine exception.
+*/
+
+static void coroutine (void * a);
+
+/*
+ exception - raise a exception exception.
+*/
+
+static void exception (void * a);
+
+/*
+ Init - initialises this module.
+*/
+
+static void Init (void);
+
+/*
+ TidyUp - deallocate memory used by this module.
+*/
+
+static void TidyUp (void);
+
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high)
+{
+ int n;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ n = static_cast<int> (libc_write (2, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
+}
+
+
+/*
+ findHandler -
+*/
+
+static RTExceptions_Handler findHandler (RTExceptions_EHBlock e, unsigned int number)
+{
+ RTExceptions_Handler h;
+
+ h = e->handlers->right;
+ while ((h != e->handlers) && (number != h->n))
+ {
+ h = h->right;
+ }
+ if (h == e->handlers)
+ {
+ return NULL;
+ }
+ else
+ {
+ return h;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InvokeHandler - invokes the associated handler for the current
+ exception in the active EHB.
+*/
+
+static void InvokeHandler (void)
+{
+ RTExceptions_Handler h;
+
+ h = findHandler (currentEHB, currentEHB->number);
+ if (h == NULL)
+ {
+ throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ()));
+ }
+ else
+ {
+ (*h->p.proc) ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ DoThrow - throw the exception number in the exception block.
+*/
+
+static void DoThrow (void)
+{
+ throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ()));
+}
+
+
+/*
+ addChar - adds, ch, to the current exception handler text buffer
+ at index, i. The index in then incremented.
+*/
+
+static void addChar (char ch, unsigned int *i)
+{
+ if (((*i) <= MaxBuffer) && (currentEHB != NULL))
+ {
+ currentEHB->buffer.array[(*i)] = ch;
+ (*i) += 1;
+ }
+}
+
+
+/*
+ stripPath - returns the filename from the path.
+*/
+
+static void * stripPath (void * s)
+{
+ RTExceptions_PtrToChar f;
+ RTExceptions_PtrToChar p;
+
+ p = static_cast<RTExceptions_PtrToChar> (s);
+ f = static_cast<RTExceptions_PtrToChar> (s);
+ while ((*p) != ASCII_nul)
+ {
+ if ((*p) == '/')
+ {
+ p += 1;
+ f = p;
+ }
+ else
+ {
+ p += 1;
+ }
+ }
+ return reinterpret_cast<void *> (f);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addFile - adds the filename determined by, s, however it strips
+ any preceeding path.
+*/
+
+static void addFile (void * s, unsigned int *i)
+{
+ RTExceptions_PtrToChar p;
+
+ p = static_cast<RTExceptions_PtrToChar> (stripPath (s));
+ while ((p != NULL) && ((*p) != ASCII_nul))
+ {
+ addChar ((*p), i);
+ p += 1;
+ }
+}
+
+
+/*
+ addStr - adds a C string from address, s, into the current
+ handler text buffer.
+*/
+
+static void addStr (void * s, unsigned int *i)
+{
+ RTExceptions_PtrToChar p;
+
+ p = static_cast<RTExceptions_PtrToChar> (s);
+ while ((p != NULL) && ((*p) != ASCII_nul))
+ {
+ addChar ((*p), i);
+ p += 1;
+ }
+}
+
+
+/*
+ addNum - adds a number, n, to the current handler
+ text buffer.
+*/
+
+static void addNum (unsigned int n, unsigned int *i)
+{
+ if (n < 10)
+ {
+ addChar ( ((char) ((n % 10)+ ((unsigned int) ('0')))), i);
+ }
+ else
+ {
+ addNum (n / 10, i);
+ addNum (n % 10, i);
+ }
+}
+
+
+/*
+ New - returns a new EHBlock.
+*/
+
+static RTExceptions_EHBlock New (void)
+{
+ RTExceptions_EHBlock e;
+
+ if (freeEHB == NULL)
+ {
+ Storage_ALLOCATE ((void **) &e, sizeof (RTExceptions__T1));
+ }
+ else
+ {
+ e = freeEHB;
+ freeEHB = freeEHB->right;
+ }
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ NewHandler - returns a new handler.
+*/
+
+static RTExceptions_Handler NewHandler (void)
+{
+ RTExceptions_Handler h;
+
+ if (freeHandler == NULL)
+ {
+ Storage_ALLOCATE ((void **) &h, sizeof (RTExceptions__T3));
+ }
+ else
+ {
+ h = freeHandler;
+ freeHandler = freeHandler->right;
+ }
+ return h;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillHandler - returns, NIL, and places, h, onto the free list.
+*/
+
+static RTExceptions_Handler KillHandler (RTExceptions_Handler h)
+{
+ h->right = freeHandler;
+ freeHandler = h;
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillHandlers - kills all handlers in the list.
+*/
+
+static RTExceptions_Handler KillHandlers (RTExceptions_Handler h)
+{
+ h->left->right = freeHandler;
+ freeHandler = h;
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitHandler -
+*/
+
+static RTExceptions_Handler InitHandler (RTExceptions_Handler h, RTExceptions_Handler l, RTExceptions_Handler r, RTExceptions_Handler s, unsigned int number, RTExceptions_ProcedureHandler proc)
+{
+ h->p = proc;
+ h->n = number;
+ h->right = r;
+ h->left = l;
+ h->stack = s;
+ return h;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SubHandler -
+*/
+
+static void SubHandler (RTExceptions_Handler h)
+{
+ h->right->left = h->left;
+ h->left->right = h->right;
+}
+
+
+/*
+ AddHandler - add, e, to the end of the list of handlers.
+*/
+
+static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h)
+{
+ h->right = e->handlers;
+ h->left = e->handlers->left;
+ e->handlers->left->right = h;
+ e->handlers->left = h;
+}
+
+
+/*
+ indexf - raise an index out of bounds exception.
+*/
+
+static void indexf (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 613, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("array index out of bounds")));
+}
+
+
+/*
+ range - raise an assignment out of range exception.
+*/
+
+static void range (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 625, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("assignment out of range")));
+}
+
+
+/*
+ casef - raise a case selector out of range exception.
+*/
+
+static void casef (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 637, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
+}
+
+
+/*
+ invalidloc - raise an invalid location exception.
+*/
+
+static void invalidloc (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 649, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("invalid address referenced")));
+}
+
+
+/*
+ function - raise a ... function ... exception. --fixme-- what does this exception catch?
+*/
+
+static void function (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 661, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... function ... "))); /* --fixme-- what has happened ? */
+}
+
+
+/*
+ wholevalue - raise an illegal whole value exception.
+*/
+
+static void wholevalue (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 673, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+}
+
+
+/*
+ wholediv - raise a division by zero exception.
+*/
+
+static void wholediv (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 685, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+}
+
+
+/*
+ realvalue - raise an illegal real value exception.
+*/
+
+static void realvalue (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 697, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal real value exception")));
+}
+
+
+/*
+ realdiv - raise a division by zero in a real number exception.
+*/
+
+static void realdiv (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 709, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("real number division by zero exception")));
+}
+
+
+/*
+ complexvalue - raise an illegal complex value exception.
+*/
+
+static void complexvalue (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 721, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal complex value exception")));
+}
+
+
+/*
+ complexdiv - raise a division by zero in a complex number exception.
+*/
+
+static void complexdiv (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 733, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
+}
+
+
+/*
+ protection - raise a protection exception.
+*/
+
+static void protection (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 745, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
+}
+
+
+/*
+ systemf - raise a system exception.
+*/
+
+static void systemf (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 757, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
+}
+
+
+/*
+ coroutine - raise a coroutine exception.
+*/
+
+static void coroutine (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 769, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
+}
+
+
+/*
+ exception - raise a exception exception.
+*/
+
+static void exception (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 781, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("exception exception")));
+}
+
+
+/*
+ Init - initialises this module.
+*/
+
+static void Init (void)
+{
+ inException = FALSE;
+ freeHandler = NULL;
+ freeEHB = NULL;
+ currentEHB = RTExceptions_InitExceptionBlock ();
+ currentSource = NULL;
+ RTExceptions_BaseExceptionsThrow ();
+ SysExceptions_InitExceptionHandlers ((SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) indexf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) range}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) casef}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) invalidloc}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) function}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholevalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholediv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) protection}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) systemf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) coroutine}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) exception});
+}
+
+
+/*
+ TidyUp - deallocate memory used by this module.
+*/
+
+static void TidyUp (void)
+{
+ RTExceptions_Handler f;
+ RTExceptions_EHBlock e;
+
+ if (currentEHB != NULL)
+ {
+ currentEHB = RTExceptions_KillExceptionBlock (currentEHB);
+ }
+ while (freeHandler != NULL)
+ {
+ f = freeHandler;
+ freeHandler = freeHandler->right;
+ Storage_DEALLOCATE ((void **) &f, sizeof (RTExceptions__T3));
+ }
+ while (freeEHB != NULL)
+ {
+ e = freeEHB;
+ freeEHB = freeEHB->right;
+ Storage_DEALLOCATE ((void **) &e, sizeof (RTExceptions__T1));
+ }
+}
+
+
+/*
+ Raise - invoke the exception handler associated with, number,
+ in the active EHBlock. It keeps a record of the number
+ and message in the EHBlock for later use.
+*/
+
+extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message)
+{
+ unsigned int i;
+
+ currentEHB->number = number;
+ i = 0;
+ addFile (file, &i);
+ addChar (':', &i);
+ addNum (line, &i);
+ addChar (':', &i);
+ addNum (column, &i);
+ addChar (':', &i);
+ addChar (' ', &i);
+ addChar ('I', &i);
+ addChar ('n', &i);
+ addChar (' ', &i);
+ addStr (function, &i);
+ addChar (ASCII_nl, &i);
+ addFile (file, &i);
+ addChar (':', &i);
+ addNum (line, &i);
+ addChar (':', &i);
+ addNum (column, &i);
+ addChar (':', &i);
+ addStr (message, &i);
+ addChar (ASCII_nl, &i);
+ addChar (ASCII_nul, &i);
+ InvokeHandler ();
+}
+
+
+/*
+ SetExceptionBlock - sets, source, as the active EHB.
+*/
+
+extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source)
+{
+ currentEHB = source;
+}
+
+
+/*
+ GetExceptionBlock - returns the active EHB.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void)
+{
+ return currentEHB;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetTextBuffer - returns the address of the EHB buffer.
+*/
+
+extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e)
+{
+ return &e->buffer;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetTextBufferSize - return the size of the EHB text buffer.
+*/
+
+extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e)
+{
+ return sizeof (e->buffer);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetNumber - return the exception number associated with,
+ source.
+*/
+
+extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source)
+{
+ return source->number;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitExceptionBlock - creates and returns a new exception block.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void)
+{
+ RTExceptions_EHBlock e;
+
+ e = New ();
+ e->number = UINT_MAX;
+ e->handlers = NewHandler (); /* add the dummy onto the head */
+ e->handlers->right = e->handlers; /* add the dummy onto the head */
+ e->handlers->left = e->handlers;
+ e->right = e;
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillExceptionBlock - destroys the EHB, e, and all its handlers.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e)
+{
+ e->handlers = KillHandlers (e->handlers);
+ e->right = freeEHB;
+ freeEHB = e;
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PushHandler - install a handler in EHB, e.
+*/
+
+extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p)
+{
+ RTExceptions_Handler h;
+ RTExceptions_Handler i;
+
+ h = findHandler (e, number);
+ if (h == NULL)
+ {
+ i = InitHandler (NewHandler (), NULL, NULL, NULL, number, p);
+ }
+ else
+ {
+ /* remove, h, */
+ SubHandler (h);
+ /* stack it onto a new handler */
+ i = InitHandler (NewHandler (), NULL, NULL, h, number, p);
+ }
+ /* add new handler */
+ AddHandler (e, i);
+}
+
+
+/*
+ PopHandler - removes the handler associated with, number, from
+ EHB, e.
+*/
+
+extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number)
+{
+ RTExceptions_Handler h;
+ RTExceptions_Handler i;
+
+ h = findHandler (e, number);
+ if (h != NULL)
+ {
+ /* remove, h, */
+ SubHandler (h);
+ if (h->stack != NULL)
+ {
+ AddHandler (e, h->stack);
+ }
+ h = KillHandler (h);
+ }
+}
+
+
+/*
+ DefaultErrorCatch - displays the current error message in
+ the current exception block and then
+ calls HALT.
+*/
+
+extern "C" void RTExceptions_DefaultErrorCatch (void)
+{
+ RTExceptions_EHBlock e;
+ int n;
+
+ e = RTExceptions_GetExceptionBlock ();
+ n = static_cast<int> (libc_write (2, RTExceptions_GetTextBuffer (e), libc_strlen (RTExceptions_GetTextBuffer (e))));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ BaseExceptionsThrow - configures the Modula-2 exceptions to call
+ THROW which in turn can be caught by an
+ exception block. If this is not called then
+ a Modula-2 exception will simply call an
+ error message routine and then HALT.
+*/
+
+extern "C" void RTExceptions_BaseExceptionsThrow (void)
+{
+ M2EXCEPTION_M2Exceptions i;
+
+ for (i=M2EXCEPTION_indexException; i<=M2EXCEPTION_exException; i= static_cast<M2EXCEPTION_M2Exceptions>(static_cast<int>(i+1)))
+ {
+ RTExceptions_PushHandler (RTExceptions_GetExceptionBlock (), (unsigned int ) (i), (RTExceptions_ProcedureHandler) {(RTExceptions_ProcedureHandler_t) DoThrow});
+ }
+}
+
+
+/*
+ IsInExceptionState - returns TRUE if the program is currently
+ in the exception state.
+*/
+
+extern "C" unsigned int RTExceptions_IsInExceptionState (void)
+{
+ return inException;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetExceptionState - returns the current exception state and
+ then sets the current exception state to,
+ to.
+*/
+
+extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to)
+{
+ unsigned int old;
+
+ old = inException;
+ inException = to;
+ return old;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SwitchExceptionState - assigns, from, with the current exception
+ state and then assigns the current exception
+ to, to.
+*/
+
+extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to)
+{
+ (*from) = inException;
+ inException = to;
+}
+
+
+/*
+ GetBaseExceptionBlock - returns the initial language exception block
+ created.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void)
+{
+ if (currentEHB == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod", 53, 599, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
+ }
+ else
+ {
+ return currentEHB;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetExceptionSource - sets the current exception source to, source.
+*/
+
+extern "C" void RTExceptions_SetExceptionSource (void * source)
+{
+ currentSource = source;
+}
+
+
+/*
+ GetExceptionSource - returns the current exception source.
+*/
+
+extern "C" void * RTExceptions_GetExceptionSource (void)
+{
+ return currentSource;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_RTExceptions_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_RTExceptions_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ TidyUp ();
+}
--- /dev/null
+/* RTco.c provides dummy access to thread primitives.
+
+Copyright (C) 2019-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#if defined(__cplusplus)
+#define EXTERN extern "C"
+#else
+#define EXTERN
+#endif
+
+EXTERN
+void
+RTco_wait (__attribute__ ((unused)) int sid)
+{
+}
+
+
+EXTERN
+void
+RTco_signal (__attribute__ ((unused)) int sid)
+{
+}
+
+
+EXTERN
+int
+RTco_init (void)
+{
+ return 0;
+}
+
+
+EXTERN
+int
+RTco_initSemaphore (__attribute__ ((unused)) int value)
+{
+ return 0;
+}
+
+
+/* signalThread signal the semaphore associated with thread tid. */
+
+EXTERN
+void
+RTco_signalThread (__attribute__ ((unused)) int tid)
+{
+}
+
+
+/* waitThread wait on the semaphore associated with thread tid. */
+
+EXTERN
+void
+RTco_waitThread (__attribute__ ((unused)) int tid)
+{
+}
+
+
+EXTERN
+int
+RTco_currentThread (void)
+{
+ return 0;
+}
+
+
+EXTERN
+int
+RTco_initThread (__attribute__ ((unused)) void (*proc)(void),
+ __attribute__ ((unused)) unsigned int stackSize)
+{
+ return 0;
+}
+
+
+EXTERN
+void
+RTco_transfer (__attribute__ ((unused)) int *p1, __attribute__ ((unused)) int p2)
+{
+}
+
+
+EXTERN
+int
+RTco_select (__attribute__ ((unused)) int p1,
+ __attribute__ ((unused)) void *p2,
+ __attribute__ ((unused)) void *p3,
+ __attribute__ ((unused)) void *p4,
+ __attribute__ ((unused)) void *p5)
+{
+ return 0;
+}
+
+
+EXTERN
+void
+_M2_RTco_init (void)
+{
+}
+
+EXTERN
+void
+_M2_RTco_finish (void)
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from SFIO. */
+/* SFIO.mod provides a String interface to the opening routines of FIO.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#include <stddef.h>
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _SFIO_H
+#define _SFIO_C
+
+# include "GASCII.h"
+# include "GDynamicStrings.h"
+# include "GFIO.h"
+
+
+/*
+ Exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname);
+
+/*
+ OpenToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname);
+
+/*
+ OpenToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname);
+
+/*
+ OpenForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+ if towrite is TRUE or whether the previous file should
+ be left alone, allowing this descriptor to seek
+ and modify an existing file.
+*/
+
+extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile);
+
+/*
+ WriteS - writes a string, s, to, file. It returns the String, s.
+*/
+
+extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s);
+
+/*
+ ReadS - reads and returns a string from, file.
+ It stops reading the string at the end of line or end of file.
+ It consumes the newline at the end of line but does not place
+ this into the returned string.
+*/
+
+extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file);
+
+
+/*
+ Exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname)
+{
+ return FIO_exists (DynamicStrings_string (fname), DynamicStrings_Length (fname));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OpenToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname)
+{
+ return FIO_openToRead (DynamicStrings_string (fname), DynamicStrings_Length (fname));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OpenToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname)
+{
+ return FIO_openToWrite (DynamicStrings_string (fname), DynamicStrings_Length (fname));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OpenForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+ if towrite is TRUE or whether the previous file should
+ be left alone, allowing this descriptor to seek
+ and modify an existing file.
+*/
+
+extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile)
+{
+ return FIO_openForRandom (DynamicStrings_string (fname), DynamicStrings_Length (fname), towrite, newfile);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteS - writes a string, s, to, file. It returns the String, s.
+*/
+
+extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s)
+{
+ unsigned int nBytes;
+
+ if (s != NULL)
+ {
+ nBytes = FIO_WriteNBytes (file, DynamicStrings_Length (s), DynamicStrings_string (s));
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ReadS - reads and returns a string from, file.
+ It stops reading the string at the end of line or end of file.
+ It consumes the newline at the end of line but does not place
+ this into the returned string.
+*/
+
+extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file)
+{
+ DynamicStrings_String s;
+ unsigned int c;
+
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ while (((! (FIO_EOLN (file))) && (! (FIO_EOF (file)))) && (FIO_IsNoError (file)))
+ {
+ s = DynamicStrings_ConCatChar (s, FIO_ReadChar (file));
+ }
+ if (FIO_EOLN (file))
+ {
+ /* consume nl */
+ if ((FIO_ReadChar (file)) == ASCII_nul)
+ {} /* empty. */
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_SFIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_SFIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* GSYSTEM.c a handwritten dummy module for mc.
+
+Copyright (C) 2018-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#if defined(__cplusplus)
+#define EXTERN extern "C"
+#else
+#define EXTERN
+#endif
+
+EXTERN
+void
+_M2_SYSTEM_init (int argc, char *p)
+{
+}
+
+EXTERN
+void
+_M2_SYSTEM_finish (int argc, char *p)
+{
+}
--- /dev/null
+/* GSelective.c provides access to select for Modula-2.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+/* implementation module in C. */
+
+#include "config.h"
+#include "system.h"
+#include "ansidecl.h"
+
+#include "gm2-libs-host.h"
+
+#if defined(__cplusplus)
+#define EXTERN extern "C"
+#else
+#define EXTERN
+#endif
+
+/* PROCEDURE Select (nooffds: CARDINAL; readfds, writefds, exceptfds:
+SetOfFd; timeout: Timeval) : INTEGER ; */
+
+#if defined(HAVE_SELECT)
+EXTERN
+int
+Selective_Select (int nooffds, fd_set *readfds, fd_set *writefds,
+ fd_set *exceptfds, struct timeval *timeout)
+{
+ return select (nooffds, readfds, writefds, exceptfds, timeout);
+}
+#else
+EXTERN
+int
+Selective_Select (int nooffds, void *readfds, void *writefds, void *exceptfds,
+ void *timeout)
+{
+ return 0;
+}
+#endif
+
+/* PROCEDURE InitTime (sec, usec) : Timeval ; */
+
+#if defined(HAVE_SELECT)
+EXTERN
+struct timeval *
+Selective_InitTime (unsigned int sec, unsigned int usec)
+{
+ struct timeval *t = (struct timeval *)malloc (sizeof (struct timeval));
+
+ t->tv_sec = (long int)sec;
+ t->tv_usec = (long int)usec;
+ return t;
+}
+
+EXTERN
+void
+Selective_GetTime (struct timeval *t, unsigned int *sec, unsigned int *usec)
+{
+ *sec = (unsigned int)t->tv_sec;
+ *usec = (unsigned int)t->tv_usec;
+}
+
+EXTERN
+void
+Selective_SetTime (struct timeval *t, unsigned int sec, unsigned int usec)
+{
+ t->tv_sec = sec;
+ t->tv_usec = usec;
+}
+
+/* PROCEDURE KillTime (t: Timeval) : Timeval ; */
+
+EXTERN
+struct timeval *
+Selective_KillTime (struct timeval *t)
+{
+ free (t);
+ return NULL;
+}
+
+/* PROCEDURE InitSet () : SetOfFd ; */
+
+EXTERN
+fd_set *
+Selective_InitSet (void)
+{
+ fd_set *s = (fd_set *)malloc (sizeof (fd_set));
+
+ return s;
+}
+
+/* PROCEDURE KillSet (s: SetOfFd) : SetOfFd ; */
+
+EXTERN
+fd_set *
+Selective_KillSet (fd_set *s)
+{
+ free (s);
+ return NULL;
+}
+
+/* PROCEDURE FdZero (s: SetOfFd) ; */
+
+EXTERN
+void
+Selective_FdZero (fd_set *s)
+{
+ FD_ZERO (s);
+}
+
+/* PROCEDURE Fd_Set (fd: INTEGER; SetOfFd) ; */
+
+EXTERN
+void
+Selective_FdSet (int fd, fd_set *s)
+{
+ FD_SET (fd, s);
+}
+
+/* PROCEDURE FdClr (fd: INTEGER; SetOfFd) ; */
+
+EXTERN
+void
+Selective_FdClr (int fd, fd_set *s)
+{
+ FD_CLR (fd, s);
+}
+
+/* PROCEDURE FdIsSet (fd: INTEGER; SetOfFd) : BOOLEAN ; */
+
+EXTERN
+int
+Selective_FdIsSet (int fd, fd_set *s)
+{
+ return FD_ISSET (fd, s);
+}
+
+/* GetTimeOfDay - fills in a record, Timeval, filled in with the
+current system time in seconds and microseconds. It returns zero
+(see man 3p gettimeofday) */
+
+EXTERN
+int
+Selective_GetTimeOfDay (struct timeval *t)
+{
+ return gettimeofday (t, NULL);
+}
+#else
+
+EXTERN
+void *
+Selective_InitTime (unsigned int sec, unsigned int usec)
+{
+ return NULL;
+}
+
+EXTERN
+void *
+Selective_KillTime (void *t)
+{
+ return NULL;
+}
+
+EXTERN
+void
+Selective_GetTime (struct timeval *t, unsigned int *sec, unsigned int *usec)
+{
+}
+
+EXTERN
+void
+Selective_SetTime (struct timeval *t, unsigned int sec, unsigned int usec)
+{
+}
+
+EXTERN
+fd_set *
+Selective_InitSet (void)
+{
+ return NULL;
+}
+
+EXTERN
+void
+Selective_FdZero (void *s)
+{
+}
+
+EXTERN
+void
+Selective_FdSet (int fd, void *s)
+{
+}
+
+EXTERN
+void
+Selective_FdClr (int fd, void *s)
+{
+}
+
+EXTERN
+int
+Selective_FdIsSet (int fd, void *s)
+{
+ return 0;
+}
+
+EXTERN
+int
+Selective_GetTimeOfDay (struct timeval *t)
+{
+ return -1;
+}
+#endif
+
+/* PROCEDURE MaxFdsPlusOne (a, b: File) : File ; */
+
+EXTERN
+int
+Selective_MaxFdsPlusOne (int a, int b)
+{
+ if (a > b)
+ return a + 1;
+ else
+ return b + 1;
+}
+
+/* PROCEDURE WriteCharRaw (fd: INTEGER; ch: CHAR) ; */
+
+EXTERN
+void
+Selective_WriteCharRaw (int fd, char ch)
+{
+ write (fd, &ch, 1);
+}
+
+/* PROCEDURE ReadCharRaw (fd: INTEGER) : CHAR ; */
+
+EXTERN
+char
+Selective_ReadCharRaw (int fd)
+{
+ char ch;
+
+ read (fd, &ch, 1);
+ return ch;
+}
+
+EXTERN
+void
+_M2_Selective_init ()
+{
+}
+
+EXTERN
+void
+_M2_Selective_finish ()
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from StdIO. */
+/* StdIO.mod provides general Read and Write procedures.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# include "Gmcrts.h"
+#define _StdIO_H
+#define _StdIO_C
+
+# include "GIO.h"
+# include "GM2RTS.h"
+
+typedef struct StdIO_ProcWrite_p StdIO_ProcWrite;
+
+typedef struct StdIO_ProcRead_p StdIO_ProcRead;
+
+# define MaxStack 40
+typedef struct StdIO__T1_a StdIO__T1;
+
+typedef struct StdIO__T2_a StdIO__T2;
+
+typedef void (*StdIO_ProcWrite_t) (char);
+struct StdIO_ProcWrite_p { StdIO_ProcWrite_t proc; };
+
+typedef void (*StdIO_ProcRead_t) (char *);
+struct StdIO_ProcRead_p { StdIO_ProcRead_t proc; };
+
+struct StdIO__T1_a { StdIO_ProcWrite array[MaxStack+1]; };
+struct StdIO__T2_a { StdIO_ProcRead array[MaxStack+1]; };
+static StdIO__T1 StackW;
+static unsigned int StackWPtr;
+static StdIO__T2 StackR;
+static unsigned int StackRPtr;
+
+/*
+ Read - is the generic procedure that all higher application layers
+ should use to receive a character.
+*/
+
+extern "C" void StdIO_Read (char *ch);
+
+/*
+ Write - is the generic procedure that all higher application layers
+ should use to emit a character.
+*/
+
+extern "C" void StdIO_Write (char ch);
+
+/*
+ PushOutput - pushes the current Write procedure onto a stack,
+ any future references to Write will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushOutput (StdIO_ProcWrite p);
+
+/*
+ PopOutput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopOutput (void);
+
+/*
+ GetCurrentOutput - returns the current output procedure.
+*/
+
+extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void);
+
+/*
+ PushInput - pushes the current Read procedure onto a stack,
+ any future references to Read will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushInput (StdIO_ProcRead p);
+
+/*
+ PopInput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopInput (void);
+
+/*
+ GetCurrentInput - returns the current input procedure.
+*/
+
+extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void);
+
+
+/*
+ Read - is the generic procedure that all higher application layers
+ should use to receive a character.
+*/
+
+extern "C" void StdIO_Read (char *ch)
+{
+ (*StackR.array[StackRPtr].proc) (ch);
+}
+
+
+/*
+ Write - is the generic procedure that all higher application layers
+ should use to emit a character.
+*/
+
+extern "C" void StdIO_Write (char ch)
+{
+ (*StackW.array[StackWPtr].proc) (ch);
+}
+
+
+/*
+ PushOutput - pushes the current Write procedure onto a stack,
+ any future references to Write will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushOutput (StdIO_ProcWrite p)
+{
+ if (StackWPtr == MaxStack)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackWPtr += 1;
+ StackW.array[StackWPtr] = p;
+ }
+}
+
+
+/*
+ PopOutput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopOutput (void)
+{
+ if (StackWPtr == 1)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackWPtr -= 1;
+ }
+}
+
+
+/*
+ GetCurrentOutput - returns the current output procedure.
+*/
+
+extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void)
+{
+ if (StackWPtr > 0)
+ {
+ return StackW.array[StackWPtr];
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ PushInput - pushes the current Read procedure onto a stack,
+ any future references to Read will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushInput (StdIO_ProcRead p)
+{
+ if (StackRPtr == MaxStack)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackRPtr += 1;
+ StackR.array[StackRPtr] = p;
+ }
+}
+
+
+/*
+ PopInput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopInput (void)
+{
+ if (StackRPtr == 1)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackRPtr -= 1;
+ }
+}
+
+
+/*
+ GetCurrentInput - returns the current input procedure.
+*/
+
+extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void)
+{
+ if (StackRPtr > 0)
+ {
+ return StackR.array[StackRPtr];
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_StdIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ StackWPtr = 0;
+ StackRPtr = 0;
+ StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) IO_Write});
+ StdIO_PushInput ((StdIO_ProcRead) {(StdIO_ProcRead_t) IO_Read});
+}
+
+extern "C" void _M2_StdIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from Storage. */
+/* Storage.mod provides access to the dynamic Storage handler.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Storage_H
+#define _Storage_C
+
+# include "GSysStorage.h"
+
+extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size);
+extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size);
+extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size);
+extern "C" unsigned int Storage_Available (unsigned int Size);
+
+extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size)
+{
+ SysStorage_ALLOCATE (a, Size);
+}
+
+extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size)
+{
+ SysStorage_DEALLOCATE (a, Size);
+}
+
+extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size)
+{
+ SysStorage_REALLOCATE (a, Size);
+}
+
+extern "C" unsigned int Storage_Available (unsigned int Size)
+{
+ return SysStorage_Available (Size);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_Storage_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Storage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from StrCase. */
+/* StrCase.mod provides procedure to convert between text case.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#include <string.h>
+#include <limits.h>
+#define _StrCase_H
+#define _StrCase_C
+
+# include "GASCII.h"
+# include "GStrLib.h"
+
+
+/*
+ StrToUpperCase - converts string, a, to uppercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToUpperCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+
+/*
+ StrToLowerCase - converts string, a, to lowercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToLowerCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+
+/*
+ Cap - converts a lower case character into a capital character.
+ If the character is not a lower case character 'a'..'z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Cap (char ch);
+
+/*
+ Lower - converts an upper case character into a lower case character.
+ If the character is not an upper case character 'A'..'Z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Lower (char ch);
+
+
+/*
+ StrToUpperCase - converts string, a, to uppercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToUpperCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high)
+{
+ unsigned int higha;
+ unsigned int highb;
+ unsigned int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ highb = _b_high;
+ i = 0;
+ while (((i < higha) && (a[i] != ASCII_nul)) && (i < highb))
+ {
+ b[i] = StrCase_Cap (a[i]);
+ i += 1;
+ }
+ if (i < highb)
+ {
+ b[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ StrToLowerCase - converts string, a, to lowercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToLowerCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high)
+{
+ unsigned int higha;
+ unsigned int highb;
+ unsigned int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ highb = _b_high;
+ i = 0;
+ while (((i < higha) && (a[i] != ASCII_nul)) && (i < highb))
+ {
+ b[i] = StrCase_Lower (a[i]);
+ i += 1;
+ }
+ if (i < highb)
+ {
+ b[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ Cap - converts a lower case character into a capital character.
+ If the character is not a lower case character 'a'..'z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Cap (char ch)
+{
+ if ((ch >= 'a') && (ch <= 'z'))
+ {
+ ch = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('a')))+ ((unsigned int) ('A'))));
+ }
+ return ch;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Lower - converts an upper case character into a lower case character.
+ If the character is not an upper case character 'A'..'Z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Lower (char ch)
+{
+ if ((ch >= 'A') && (ch <= 'Z'))
+ {
+ ch = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))));
+ }
+ return ch;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_StrCase_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_StrCase_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from StrIO. */
+/* StrIO.mod provides simple string input output routines.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <string.h>
+#include <limits.h>
+#define _StrIO_H
+#define _StrIO_C
+
+# include "GASCII.h"
+# include "GStdIO.h"
+# include "Glibc.h"
+
+static unsigned int IsATTY;
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+extern "C" void StrIO_WriteLn (void);
+
+/*
+ ReadString - reads a sequence of characters into a string.
+ Line editing accepts Del, Ctrl H, Ctrl W and
+ Ctrl U.
+*/
+
+extern "C" void StrIO_ReadString (char *a, unsigned int _a_high);
+
+/*
+ WriteString - writes a string to the default output.
+*/
+
+extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high);
+
+/*
+ Erase - writes a backspace, space and backspace to remove the
+ last character displayed.
+*/
+
+static void Erase (void);
+
+/*
+ Echo - echos the character, ch, onto the output channel if IsATTY
+ is true.
+*/
+
+static void Echo (char ch);
+
+/*
+ AlphaNum- returns true if character, ch, is an alphanumeric character.
+*/
+
+static unsigned int AlphaNum (char ch);
+
+
+/*
+ Erase - writes a backspace, space and backspace to remove the
+ last character displayed.
+*/
+
+static void Erase (void)
+{
+ Echo (ASCII_bs);
+ Echo (' ');
+ Echo (ASCII_bs);
+}
+
+
+/*
+ Echo - echos the character, ch, onto the output channel if IsATTY
+ is true.
+*/
+
+static void Echo (char ch)
+{
+ if (IsATTY)
+ {
+ StdIO_Write (ch);
+ }
+}
+
+
+/*
+ AlphaNum- returns true if character, ch, is an alphanumeric character.
+*/
+
+static unsigned int AlphaNum (char ch)
+{
+ return (((ch >= 'a') && (ch <= 'z')) || ((ch >= 'A') && (ch <= 'Z'))) || ((ch >= '0') && (ch <= '9'));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+extern "C" void StrIO_WriteLn (void)
+{
+ Echo (ASCII_cr);
+ StdIO_Write (ASCII_lf);
+}
+
+
+/*
+ ReadString - reads a sequence of characters into a string.
+ Line editing accepts Del, Ctrl H, Ctrl W and
+ Ctrl U.
+*/
+
+extern "C" void StrIO_ReadString (char *a, unsigned int _a_high)
+{
+ unsigned int n;
+ unsigned int high;
+ char ch;
+
+ high = _a_high;
+ n = 0;
+ do {
+ StdIO_Read (&ch);
+ if ((ch == ASCII_del) || (ch == ASCII_bs))
+ {
+ if (n == 0)
+ {
+ StdIO_Write (ASCII_bel);
+ }
+ else
+ {
+ Erase ();
+ n -= 1;
+ }
+ }
+ else if (ch == ASCII_nak)
+ {
+ /* avoid dangling else. */
+ while (n > 0)
+ {
+ Erase ();
+ n -= 1;
+ }
+ }
+ else if (ch == ASCII_etb)
+ {
+ /* avoid dangling else. */
+ if (n == 0)
+ {
+ Echo (ASCII_bel);
+ }
+ else if (AlphaNum (a[n-1]))
+ {
+ /* avoid dangling else. */
+ do {
+ Erase ();
+ n -= 1;
+ } while (! ((n == 0) || (! (AlphaNum (a[n-1])))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ Erase ();
+ n -= 1;
+ }
+ }
+ else if (n <= high)
+ {
+ /* avoid dangling else. */
+ if ((ch == ASCII_cr) || (ch == ASCII_lf))
+ {
+ a[n] = ASCII_nul;
+ n += 1;
+ }
+ else if (ch == ASCII_ff)
+ {
+ /* avoid dangling else. */
+ a[0] = ch;
+ if (high > 0)
+ {
+ a[1] = ASCII_nul;
+ }
+ ch = ASCII_cr;
+ }
+ else if (ch >= ' ')
+ {
+ /* avoid dangling else. */
+ Echo (ch);
+ a[n] = ch;
+ n += 1;
+ }
+ else if (ch == ASCII_eof)
+ {
+ /* avoid dangling else. */
+ a[n] = ch;
+ n += 1;
+ ch = ASCII_cr;
+ if (n <= high)
+ {
+ a[n] = ASCII_nul;
+ }
+ }
+ }
+ else if (ch != ASCII_cr)
+ {
+ /* avoid dangling else. */
+ Echo (ASCII_bel);
+ }
+ } while (! ((ch == ASCII_cr) || (ch == ASCII_lf)));
+}
+
+
+/*
+ WriteString - writes a string to the default output.
+*/
+
+extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high)
+{
+ unsigned int n;
+ unsigned int high;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ high = _a_high;
+ n = 0;
+ while ((n <= high) && (a[n] != ASCII_nul))
+ {
+ StdIO_Write (a[n]);
+ n += 1;
+ }
+}
+
+extern "C" void _M2_StrIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ /* IsATTY := isatty() */
+ IsATTY = FALSE;
+}
+
+extern "C" void _M2_StrIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from StrLib. */
+/* StrLib.mod provides string manipulation procedures.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <string.h>
+#include <limits.h>
+#define _StrLib_H
+#define _StrLib_C
+
+# include "GASCII.h"
+
+
+/*
+ StrConCat - combines a and b into c.
+*/
+
+extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high);
+
+/*
+ StrLess - returns TRUE if string, a, alphabetically occurs before
+ string, b.
+*/
+
+extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high);
+
+/*
+ StrCopy - copy string src into string dest providing dest is large enough.
+ If dest is smaller than a then src then the string is truncated when
+ dest is full. Add a nul character if there is room in dest.
+*/
+
+extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high);
+
+/*
+ IsSubString - returns true if b is a subcomponent of a.
+*/
+
+extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+
+/*
+ StrRemoveWhitePrefix - copies string, into string, b, excluding any white
+ space infront of a.
+*/
+
+extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch);
+
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch)
+{
+ return (ch == ' ') || (ch == ASCII_tab);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StrConCat - combines a and b into c.
+*/
+
+extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high)
+{
+ unsigned int Highb;
+ unsigned int Highc;
+ unsigned int i;
+ unsigned int j;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ Highb = StrLib_StrLen ((const char *) b, _b_high);
+ Highc = _c_high;
+ StrLib_StrCopy ((const char *) a, _a_high, (char *) c, _c_high);
+ i = StrLib_StrLen ((const char *) c, _c_high);
+ j = 0;
+ while ((j < Highb) && (i <= Highc))
+ {
+ c[i] = b[j];
+ i += 1;
+ j += 1;
+ }
+ if (i <= Highc)
+ {
+ c[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ StrLess - returns TRUE if string, a, alphabetically occurs before
+ string, b.
+*/
+
+extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high)
+{
+ unsigned int Higha;
+ unsigned int Highb;
+ unsigned int i;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ Higha = StrLib_StrLen ((const char *) a, _a_high);
+ Highb = StrLib_StrLen ((const char *) b, _b_high);
+ i = 0;
+ while ((i < Higha) && (i < Highb))
+ {
+ if (a[i] < b[i])
+ {
+ return TRUE;
+ }
+ else if (a[i] > b[i])
+ {
+ /* avoid dangling else. */
+ return FALSE;
+ }
+ /* must be equal, move on to next character */
+ i += 1;
+ }
+ return Higha < Highb; /* substrings are equal so we go on length */
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned int higha;
+ unsigned int highb;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ higha = _a_high;
+ highb = _b_high;
+ i = 0;
+ while ((((i <= higha) && (i <= highb)) && (a[i] != ASCII_nul)) && (b[i] != ASCII_nul))
+ {
+ if (a[i] != b[i])
+ {
+ return FALSE;
+ }
+ i += 1;
+ }
+ return ! (((i <= higha) && (a[i] != ASCII_nul)) || ((i <= highb) && (b[i] != ASCII_nul)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high)
+{
+ unsigned int High;
+ unsigned int Len;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ Len = 0;
+ High = _a_high;
+ while ((Len <= High) && (a[Len] != ASCII_nul))
+ {
+ Len += 1;
+ }
+ return Len;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StrCopy - copy string src into string dest providing dest is large enough.
+ If dest is smaller than a then src then the string is truncated when
+ dest is full. Add a nul character if there is room in dest.
+*/
+
+extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high)
+{
+ unsigned int HighSrc;
+ unsigned int HighDest;
+ unsigned int n;
+ char src[_src_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (src, src_, _src_high+1);
+
+ n = 0;
+ HighSrc = StrLib_StrLen ((const char *) src, _src_high);
+ HighDest = _dest_high;
+ while ((n < HighSrc) && (n <= HighDest))
+ {
+ dest[n] = src[n];
+ n += 1;
+ }
+ if (n <= HighDest)
+ {
+ dest[n] = ASCII_nul;
+ }
+}
+
+
+/*
+ IsSubString - returns true if b is a subcomponent of a.
+*/
+
+extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned int j;
+ unsigned int LengthA;
+ unsigned int LengthB;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ LengthA = StrLib_StrLen ((const char *) a, _a_high);
+ LengthB = StrLib_StrLen ((const char *) b, _b_high);
+ i = 0;
+ if (LengthA > LengthB)
+ {
+ while (i <= (LengthA-LengthB))
+ {
+ j = 0;
+ while ((j < LengthB) && (a[i+j] == b[j]))
+ {
+ j += 1;
+ }
+ if (j == LengthB)
+ {
+ return TRUE;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StrRemoveWhitePrefix - copies string, into string, b, excluding any white
+ space infront of a.
+*/
+
+extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned int j;
+ unsigned int higha;
+ unsigned int highb;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = 0;
+ j = 0;
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ highb = _b_high;
+ while ((i < higha) && (IsWhite (a[i])))
+ {
+ i += 1;
+ }
+ while ((i < higha) && (j <= highb))
+ {
+ b[j] = a[i];
+ i += 1;
+ j += 1;
+ }
+ if (j <= highb)
+ {
+ b[j] = ASCII_nul;
+ }
+}
+
+extern "C" void _M2_StrLib_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_StrLib_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from SymbolKey. */
+/* SymbolKey.mod binary tree operations for storing symbols.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _SymbolKey_H
+#define _SymbolKey_C
+
+# include "GStorage.h"
+# include "GStrIO.h"
+# include "GNumberIO.h"
+# include "GNameKey.h"
+# include "GAssertion.h"
+# include "GDebug.h"
+
+# define SymbolKey_NulKey 0
+typedef struct SymbolKey_IsSymbol_p SymbolKey_IsSymbol;
+
+typedef struct SymbolKey_PerformOperation_p SymbolKey_PerformOperation;
+
+typedef struct SymbolKey_Node_r SymbolKey_Node;
+
+typedef SymbolKey_Node *SymbolKey_SymbolTree;
+
+typedef unsigned int (*SymbolKey_IsSymbol_t) (unsigned int);
+struct SymbolKey_IsSymbol_p { SymbolKey_IsSymbol_t proc; };
+
+typedef void (*SymbolKey_PerformOperation_t) (unsigned int);
+struct SymbolKey_PerformOperation_p { SymbolKey_PerformOperation_t proc; };
+
+struct SymbolKey_Node_r {
+ NameKey_Name KeyName;
+ unsigned int KeySym;
+ SymbolKey_SymbolTree Left;
+ SymbolKey_SymbolTree Right;
+ };
+
+extern "C" void SymbolKey_InitTree (SymbolKey_SymbolTree *t);
+extern "C" void SymbolKey_KillTree (SymbolKey_SymbolTree *t);
+
+/*
+ ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey.
+*/
+
+extern "C" unsigned int SymbolKey_GetSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey);
+
+/*
+ ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey.
+*/
+
+extern "C" void SymbolKey_PutSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey, unsigned int SymKey);
+
+/*
+ DelSymKey - deletes an entry in the binary tree.
+
+ NB in order for this to work we must ensure that the InitTree sets
+ both Left and Right to NIL.
+*/
+
+extern "C" void SymbolKey_DelSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey);
+
+/*
+ IsEmptyTree - returns true if SymbolTree, t, is empty.
+*/
+
+extern "C" unsigned int SymbolKey_IsEmptyTree (SymbolKey_SymbolTree t);
+
+/*
+ DoesTreeContainAny - returns true if SymbolTree, t, contains any
+ symbols which in turn return true when procedure,
+ P, is called with a symbol as its parameter.
+ The SymbolTree root is empty apart from the field,
+ Left, hence we need two procedures.
+*/
+
+extern "C" unsigned int SymbolKey_DoesTreeContainAny (SymbolKey_SymbolTree t, SymbolKey_IsSymbol P);
+
+/*
+ ForeachNodeDo - for each node in SymbolTree, t, a procedure, P,
+ is called with the node symbol as its parameter.
+ The tree root node only contains a legal Left pointer,
+ therefore we need two procedures to examine this tree.
+*/
+
+extern "C" void SymbolKey_ForeachNodeDo (SymbolKey_SymbolTree t, SymbolKey_PerformOperation P);
+
+/*
+ ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey.
+*/
+
+extern "C" unsigned int SymbolKey_ContainsSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey);
+
+/*
+ NoOfNodes - returns the number of nodes in the tree t.
+*/
+
+extern "C" unsigned int SymbolKey_NoOfNodes (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition);
+
+/*
+ ForeachNodeConditionDo - traverse the tree t and for any node which satisfied
+ condition call P.
+*/
+
+extern "C" void SymbolKey_ForeachNodeConditionDo (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, SymbolKey_PerformOperation P);
+
+/*
+ FindNodeParentInTree - find a node, child, in a binary tree, t, with name equal to n.
+ if an entry is found, parent is set to the node above child.
+*/
+
+static void FindNodeParentInTree (SymbolKey_SymbolTree t, NameKey_Name n, SymbolKey_SymbolTree *child, SymbolKey_SymbolTree *parent);
+
+/*
+ SearchForAny - performs the search required for DoesTreeContainAny.
+ The root node always contains a nul data value,
+ therefore we must skip over it.
+*/
+
+static unsigned int SearchForAny (SymbolKey_SymbolTree t, SymbolKey_IsSymbol P);
+
+/*
+ SearchAndDo - searches all the nodes in SymbolTree, t, and
+ calls procedure, P, with a node as its parameter.
+ It traverse the tree in order.
+*/
+
+static void SearchAndDo (SymbolKey_SymbolTree t, SymbolKey_PerformOperation P);
+
+/*
+ CountNodes - wrapper for NoOfNodes.
+*/
+
+static unsigned int CountNodes (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, unsigned int count);
+
+/*
+ SearchConditional - wrapper for ForeachNodeConditionDo.
+*/
+
+static void SearchConditional (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, SymbolKey_PerformOperation P);
+
+
+/*
+ FindNodeParentInTree - find a node, child, in a binary tree, t, with name equal to n.
+ if an entry is found, parent is set to the node above child.
+*/
+
+static void FindNodeParentInTree (SymbolKey_SymbolTree t, NameKey_Name n, SymbolKey_SymbolTree *child, SymbolKey_SymbolTree *parent)
+{
+ /* remember to skip the sentinal value and assign parent and child */
+ (*parent) = t;
+ if (t == NULL)
+ {
+ Debug_Halt ((const char *) "parameter t should never be NIL", 31, 240, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54);
+ }
+ Assertion_Assert (t->Right == NULL);
+ (*child) = t->Left;
+ if ((*child) != NULL)
+ {
+ do {
+ if (n < (*child)->KeyName)
+ {
+ (*parent) = (*child);
+ (*child) = (*child)->Left;
+ }
+ else if (n > (*child)->KeyName)
+ {
+ /* avoid dangling else. */
+ (*parent) = (*child);
+ (*child) = (*child)->Right;
+ }
+ } while (! (((*child) == NULL) || (n == (*child)->KeyName)));
+ }
+}
+
+
+/*
+ SearchForAny - performs the search required for DoesTreeContainAny.
+ The root node always contains a nul data value,
+ therefore we must skip over it.
+*/
+
+static unsigned int SearchForAny (SymbolKey_SymbolTree t, SymbolKey_IsSymbol P)
+{
+ if (t == NULL)
+ {
+ return FALSE;
+ }
+ else
+ {
+ return (((*P.proc) (t->KeySym)) || (SearchForAny (t->Left, P))) || (SearchForAny (t->Right, P));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SearchAndDo - searches all the nodes in SymbolTree, t, and
+ calls procedure, P, with a node as its parameter.
+ It traverse the tree in order.
+*/
+
+static void SearchAndDo (SymbolKey_SymbolTree t, SymbolKey_PerformOperation P)
+{
+ if (t != NULL)
+ {
+ SearchAndDo (t->Right, P);
+ (*P.proc) (t->KeySym);
+ SearchAndDo (t->Left, P);
+ }
+}
+
+
+/*
+ CountNodes - wrapper for NoOfNodes.
+*/
+
+static unsigned int CountNodes (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, unsigned int count)
+{
+ if (t != NULL)
+ {
+ if ((*condition.proc) (t->KeySym))
+ {
+ count += 1;
+ }
+ count = CountNodes (t->Left, condition, count);
+ count = CountNodes (t->Right, condition, count);
+ }
+ return count;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SearchConditional - wrapper for ForeachNodeConditionDo.
+*/
+
+static void SearchConditional (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, SymbolKey_PerformOperation P)
+{
+ if (t != NULL)
+ {
+ SearchConditional (t->Right, condition, P);
+ if ((t->KeySym != 0) && ((*condition.proc) (t->KeySym)))
+ {
+ (*P.proc) (t->KeySym);
+ }
+ SearchConditional (t->Left, condition, P);
+ }
+}
+
+extern "C" void SymbolKey_InitTree (SymbolKey_SymbolTree *t)
+{
+ Storage_ALLOCATE ((void **) &(*t), sizeof (SymbolKey_Node)); /* The value entity */
+ (*t)->Left = NULL;
+ (*t)->Right = NULL;
+}
+
+extern "C" void SymbolKey_KillTree (SymbolKey_SymbolTree *t)
+{
+ /*
+ we used to get problems compiling KillTree below - so it was split
+ into the two procedures below.
+
+
+PROCEDURE KillTree (VAR t: SymbolTree) ;
+BEGIN
+ IF t#NIL
+ THEN
+ Kill(t) ; Would like to place Kill in here but the compiler
+ gives a type incompatible error... so i've split
+ the procedure into two. - Problem i think with
+ VAR t at the top?
+ t := NIL
+ END
+END KillTree ;
+
+
+PROCEDURE Kill (t: SymbolTree) ;
+BEGIN
+ IF t#NIL
+ THEN
+ Kill(t^.Left) ;
+ Kill(t^.Right) ;
+ DISPOSE(t)
+ END
+END Kill ;
+ */
+ if ((*t) != NULL)
+ {
+ SymbolKey_KillTree (&(*t)->Left);
+ SymbolKey_KillTree (&(*t)->Right);
+ Storage_DEALLOCATE ((void **) &(*t), sizeof (SymbolKey_Node));
+ (*t) = NULL;
+ }
+}
+
+
+/*
+ ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey.
+*/
+
+extern "C" unsigned int SymbolKey_GetSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey)
+{
+ SymbolKey_SymbolTree father;
+ SymbolKey_SymbolTree child;
+
+ FindNodeParentInTree (t, NameKey, &child, &father);
+ if (child == NULL)
+ {
+ return static_cast<unsigned int> (SymbolKey_NulKey);
+ }
+ else
+ {
+ return child->KeySym;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey.
+*/
+
+extern "C" void SymbolKey_PutSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey, unsigned int SymKey)
+{
+ SymbolKey_SymbolTree father;
+ SymbolKey_SymbolTree child;
+
+ FindNodeParentInTree (t, NameKey, &child, &father);
+ if (child == NULL)
+ {
+ /* no child found, now is NameKey less than father or greater? */
+ if (father == t)
+ {
+ /* empty tree, add it to the left branch of t */
+ Storage_ALLOCATE ((void **) &child, sizeof (SymbolKey_Node));
+ father->Left = child;
+ }
+ else
+ {
+ if (NameKey < father->KeyName)
+ {
+ Storage_ALLOCATE ((void **) &child, sizeof (SymbolKey_Node));
+ father->Left = child;
+ }
+ else if (NameKey > father->KeyName)
+ {
+ /* avoid dangling else. */
+ Storage_ALLOCATE ((void **) &child, sizeof (SymbolKey_Node));
+ father->Right = child;
+ }
+ }
+ child->Right = NULL;
+ child->Left = NULL;
+ child->KeySym = SymKey;
+ child->KeyName = NameKey;
+ }
+ else
+ {
+ Debug_Halt ((const char *) "symbol already stored", 21, 156, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54);
+ }
+}
+
+
+/*
+ DelSymKey - deletes an entry in the binary tree.
+
+ NB in order for this to work we must ensure that the InitTree sets
+ both Left and Right to NIL.
+*/
+
+extern "C" void SymbolKey_DelSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey)
+{
+ SymbolKey_SymbolTree i;
+ SymbolKey_SymbolTree child;
+ SymbolKey_SymbolTree father;
+
+ FindNodeParentInTree (t, NameKey, &child, &father); /* find father and child of the node */
+ if ((child != NULL) && (child->KeyName == NameKey))
+ {
+ /* Have found the node to be deleted */
+ if (father->Right == child)
+ {
+ /* most branch of child^.Left. */
+ if (child->Left != NULL)
+ {
+ /* Scan for Right most node of child^.Left */
+ i = child->Left;
+ while (i->Right != NULL)
+ {
+ i = i->Right;
+ }
+ i->Right = child->Right;
+ father->Right = child->Left;
+ }
+ else
+ {
+ /* (as in a single linked list) to child^.Right */
+ father->Right = child->Right;
+ }
+ Storage_DEALLOCATE ((void **) &child, sizeof (SymbolKey_Node));
+ }
+ else
+ {
+ /* branch of child^.Right */
+ if (child->Right != NULL)
+ {
+ /* Scan for Left most node of child^.Right */
+ i = child->Right;
+ while (i->Left != NULL)
+ {
+ i = i->Left;
+ }
+ i->Left = child->Left;
+ father->Left = child->Right;
+ }
+ else
+ {
+ /* (as in a single linked list) to child^.Left. */
+ father->Left = child->Left;
+ }
+ Storage_DEALLOCATE ((void **) &child, sizeof (SymbolKey_Node));
+ }
+ }
+ else
+ {
+ Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 223, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54);
+ }
+}
+
+
+/*
+ IsEmptyTree - returns true if SymbolTree, t, is empty.
+*/
+
+extern "C" unsigned int SymbolKey_IsEmptyTree (SymbolKey_SymbolTree t)
+{
+ return t->Left == NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DoesTreeContainAny - returns true if SymbolTree, t, contains any
+ symbols which in turn return true when procedure,
+ P, is called with a symbol as its parameter.
+ The SymbolTree root is empty apart from the field,
+ Left, hence we need two procedures.
+*/
+
+extern "C" unsigned int SymbolKey_DoesTreeContainAny (SymbolKey_SymbolTree t, SymbolKey_IsSymbol P)
+{
+ return SearchForAny (t->Left, P);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ForeachNodeDo - for each node in SymbolTree, t, a procedure, P,
+ is called with the node symbol as its parameter.
+ The tree root node only contains a legal Left pointer,
+ therefore we need two procedures to examine this tree.
+*/
+
+extern "C" void SymbolKey_ForeachNodeDo (SymbolKey_SymbolTree t, SymbolKey_PerformOperation P)
+{
+ SearchAndDo (t->Left, P);
+}
+
+
+/*
+ ContainsSymKey - return TRUE if tree, t, contains an entry for, NameKey.
+*/
+
+extern "C" unsigned int SymbolKey_ContainsSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKey)
+{
+ SymbolKey_SymbolTree father;
+ SymbolKey_SymbolTree child;
+
+ FindNodeParentInTree (t, NameKey, &child, &father);
+ return child != NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ NoOfNodes - returns the number of nodes in the tree t.
+*/
+
+extern "C" unsigned int SymbolKey_NoOfNodes (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition)
+{
+ return CountNodes (t->Left, condition, 0);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ForeachNodeConditionDo - traverse the tree t and for any node which satisfied
+ condition call P.
+*/
+
+extern "C" void SymbolKey_ForeachNodeConditionDo (SymbolKey_SymbolTree t, SymbolKey_IsSymbol condition, SymbolKey_PerformOperation P)
+{
+ if (t != NULL)
+ {
+ Assertion_Assert (t->Right == NULL);
+ SearchConditional (t->Left, condition, P);
+ }
+}
+
+extern "C" void _M2_SymbolKey_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_SymbolKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* GSysExceptions.c low level module interfacing exceptions to the OS.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+
+#include "gm2-libs-host.h"
+
+#if defined(__cplusplus)
+#define EXTERN extern "C"
+#else
+#define EXTERN
+#endif
+
+#if 0
+/* Signals. */
+#define SIGHUP 1 /* Hangup (POSIX). */
+#define SIGINT 2 /* Interrupt (ANSI). */
+#define SIGQUIT 3 /* Quit (POSIX). */
+#define SIGILL 4 /* Illegal instruction (ANSI). */
+#define SIGTRAP 5 /* Trace trap (POSIX). */
+#define SIGABRT 6 /* Abort (ANSI). */
+#define SIGIOT 6 /* IOT trap (4.2 BSD). */
+#define SIGBUS 7 /* BUS error (4.2 BSD). */
+#define SIGFPE 8 /* Floating-point exception (ANSI). */
+#define SIGKILL 9 /* Kill, unblockable (POSIX). */
+#define SIGUSR1 10 /* User-defined signal 1 (POSIX). */
+#define SIGSEGV 11 /* Segmentation violation (ANSI). */
+#define SIGUSR2 12 /* User-defined signal 2 (POSIX). */
+#define SIGPIPE 13 /* Broken pipe (POSIX). */
+#define SIGALRM 14 /* Alarm clock (POSIX). */
+#define SIGTERM 15 /* Termination (ANSI). */
+#define SIGSTKFLT 16 /* Stack fault. */
+#define SIGCLD SIGCHLD /* Same as SIGCHLD (System V). */
+#define SIGCHLD 17 /* Child status has changed (POSIX). */
+#define SIGCONT 18 /* Continue (POSIX). */
+#define SIGSTOP 19 /* Stop, unblockable (POSIX). */
+#define SIGTSTP 20 /* Keyboard stop (POSIX). */
+#define SIGTTIN 21 /* Background read from tty (POSIX). */
+#define SIGTTOU 22 /* Background write to tty (POSIX). */
+#define SIGURG 23 /* Urgent condition on socket (4.2 BSD). */
+#define SIGXCPU 24 /* CPU limit exceeded (4.2 BSD). */
+#define SIGXFSZ 25 /* File size limit exceeded (4.2 BSD). */
+#define SIGVTALRM 26 /* Virtual alarm clock (4.2 BSD). */
+#define SIGPROF 27 /* Profiling alarm clock (4.2 BSD). */
+#define SIGWINCH 28 /* Window size change (4.3 BSD, Sun). */
+#define SIGPOLL SIGIO /* Pollable event occurred (System V). */
+#define SIGIO 29 /* I/O now possible (4.2 BSD). */
+#define SIGPWR 30 /* Power failure restart (System V). */
+#define SIGSYS 31 /* Bad system call. */
+#define SIGUNUSED 31
+
+
+ (indexException, rangeException, caseSelectException, invalidLocation,
+ functionException, wholeValueException, wholeDivException, realValueException,
+ realDivException, complexValueException, complexDivException, protException,
+ sysException, coException, exException
+ );
+
+#endif
+
+/* wholeDivException and realDivException are caught by SIGFPE
+ and depatched to the appropriate Modula-2 runtime routine upon
+ testing FPE_INTDIV or FPE_FLTDIV. realValueException is also
+ caught by SIGFPE and dispatched by testing FFE_FLTOVF or
+ FPE_FLTUND or FPE_FLTRES or FPE_FLTINV. indexException is
+ caught by SIGFPE and dispatched by FPE_FLTSUB. */
+
+#if defined(HAVE_SIGNAL_H)
+static struct sigaction sigbus;
+static struct sigaction sigfpe_;
+static struct sigaction sigsegv;
+
+static void (*indexProc) (void *);
+static void (*rangeProc) (void *);
+static void (*assignmentrangeProc) (void *);
+static void (*caseProc) (void *);
+static void (*invalidlocProc) (void *);
+static void (*functionProc) (void *);
+static void (*wholevalueProc) (void *);
+static void (*wholedivProc) (void *);
+static void (*realvalueProc) (void *);
+static void (*realdivProc) (void *);
+static void (*complexvalueProc) (void *);
+static void (*complexdivProc) (void *);
+static void (*protectionProc) (void *);
+static void (*systemProc) (void *);
+static void (*coroutineProc) (void *);
+static void (*exceptionProc) (void *);
+
+static void
+sigbusDespatcher (int signum, siginfo_t *info, void *ucontext)
+{
+ switch (signum)
+ {
+
+ case SIGSEGV:
+ case SIGBUS:
+ if (info)
+ (*invalidlocProc) (info->si_addr);
+ break;
+ default:
+ perror ("not expecting to arrive here with this signal");
+ }
+}
+
+static void
+sigfpeDespatcher (int signum, siginfo_t *info, void *ucontext)
+{
+ switch (signum)
+ {
+
+ case SIGFPE:
+ if (info)
+ {
+ if (info->si_code | FPE_INTDIV)
+ (*wholedivProc) (info->si_addr); /* integer divide by zero. */
+ if (info->si_code | FPE_INTOVF)
+ (*wholevalueProc) (info->si_addr); /* integer overflow. */
+ if (info->si_code | FPE_FLTDIV)
+ (*realdivProc) (
+ info->si_addr); /* floating-point divide by zero. */
+ if (info->si_code | FPE_FLTOVF)
+ (*realvalueProc) (info->si_addr); /* floating-point overflow. */
+ if (info->si_code | FPE_FLTUND)
+ (*realvalueProc) (info->si_addr); /* floating-point underflow. */
+ if (info->si_code | FPE_FLTRES)
+ (*realvalueProc) (
+ info->si_addr); /* floating-point inexact result. */
+ if (info->si_code | FPE_FLTINV)
+ (*realvalueProc) (
+ info->si_addr); /* floating-point invalid result. */
+ if (info->si_code | FPE_FLTSUB)
+ (*indexProc) (info->si_addr); /* subscript out of range. */
+ }
+ break;
+ default:
+ perror ("not expecting to arrive here with this signal");
+ }
+}
+
+EXTERN
+void
+SysExceptions_InitExceptionHandlers (
+ void (*indexf) (void *), void (*range) (void *), void (*casef) (void *),
+ void (*invalidloc) (void *), void (*function) (void *),
+ void (*wholevalue) (void *), void (*wholediv) (void *),
+ void (*realvalue) (void *), void (*realdiv) (void *),
+ void (*complexvalue) (void *), void (*complexdiv) (void *),
+ void (*protection) (void *), void (*systemf) (void *),
+ void (*coroutine) (void *), void (*exception) (void *))
+{
+ struct sigaction old;
+
+ indexProc = indexf;
+ rangeProc = range;
+ caseProc = casef;
+ invalidlocProc = invalidloc;
+ functionProc = function;
+ wholevalueProc = wholevalue;
+ wholedivProc = wholediv;
+ realvalueProc = realvalue;
+ realdivProc = realdiv;
+ complexvalueProc = complexvalue;
+ complexdivProc = complexdiv;
+ protectionProc = protection;
+ systemProc = systemf;
+ coroutineProc = coroutine;
+ exceptionProc = exception;
+
+ sigbus.sa_sigaction = sigbusDespatcher;
+ sigbus.sa_flags = (SA_SIGINFO);
+ sigemptyset (&sigbus.sa_mask);
+
+ if (sigaction (SIGBUS, &sigbus, &old) != 0)
+ perror ("unable to install the sigbus signal handler");
+
+ sigsegv.sa_sigaction = sigbusDespatcher;
+ sigsegv.sa_flags = (SA_SIGINFO);
+ sigemptyset (&sigsegv.sa_mask);
+
+ if (sigaction (SIGSEGV, &sigsegv, &old) != 0)
+ perror ("unable to install the sigsegv signal handler");
+
+ sigfpe_.sa_sigaction = sigfpeDespatcher;
+ sigfpe_.sa_flags = (SA_SIGINFO);
+ sigemptyset (&sigfpe_.sa_mask);
+
+ if (sigaction (SIGFPE, &sigfpe_, &old) != 0)
+ perror ("unable to install the sigfpe signal handler");
+}
+
+#else
+EXTERN
+void
+SysExceptions_InitExceptionHandlers (void *indexf, void *range, void *casef,
+ void *invalidloc, void *function,
+ void *wholevalue, void *wholediv,
+ void *realvalue, void *realdiv,
+ void *complexvalue, void *complexdiv,
+ void *protection, void *systemf,
+ void *coroutine, void *exception)
+{
+}
+#endif
+
+/* GNU Modula-2 linking fodder. */
+
+EXTERN
+void
+_M2_SysExceptions_init (void)
+{
+}
+
+EXTERN
+void
+_M2_SysExceptions_fini (void)
+{
+}
--- /dev/null
+/* do not edit automatically generated by mc from SysStorage. */
+/* SysStorage.mod provides dynamic allocation for the system components.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+#include <stdlib.h>
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _SysStorage_H
+#define _SysStorage_C
+
+# include "Glibc.h"
+# include "GDebug.h"
+# include "GSYSTEM.h"
+
+# define enableDeallocation TRUE
+# define enableZero FALSE
+# define enableTrace FALSE
+static unsigned int callno;
+static unsigned int zero;
+static unsigned int trace;
+extern "C" void SysStorage_ALLOCATE (void * *a, unsigned int size);
+extern "C" void SysStorage_DEALLOCATE (void * *a, unsigned int size);
+
+/*
+ REALLOCATE - attempts to reallocate storage. The address,
+ a, should either be NIL in which case ALLOCATE
+ is called, or alternatively it should have already
+ been initialized by ALLOCATE. The allocated storage
+ is resized accordingly.
+*/
+
+extern "C" void SysStorage_REALLOCATE (void * *a, unsigned int size);
+
+/*
+ REALLOCATE - attempts to reallocate storage. The address,
+ a, should either be NIL in which case ALLOCATE
+ is called, or alternatively it should have already
+ been initialized by ALLOCATE. The allocated storage
+ is resized accordingly.
+*/
+
+extern "C" unsigned int SysStorage_Available (unsigned int size);
+
+/*
+ Init - initializes the heap. This does nothing on a GNU/Linux system.
+ But it remains here since it might be used in an embedded system.
+*/
+
+extern "C" void SysStorage_Init (void);
+
+extern "C" void SysStorage_ALLOCATE (void * *a, unsigned int size)
+{
+ (*a) = libc_malloc (static_cast<size_t> (size));
+ if ((*a) == NULL)
+ {
+ Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ }
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) "<DEBUG-CALL> %d SysStorage.ALLOCATE (0x%x, %d bytes)\\n", 54, callno, (*a), size);
+ libc_printf ((const char *) "<MEM-ALLOC> %ld %d\\n", 20, (*a), size);
+ callno += 1;
+ }
+}
+
+extern "C" void SysStorage_DEALLOCATE (void * *a, unsigned int size)
+{
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) "<DEBUG-CALL> %d SysStorage.DEALLOCATE (0x%x, %d bytes)\\n", 56, callno, (*a), size);
+ callno += 1;
+ }
+ if (enableZero && zero)
+ {
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) " memset (0x%x, 0, %d bytes)\\n", 30, (*a), size);
+ }
+ if ((libc_memset ((*a), 0, static_cast<size_t> (size))) != (*a))
+ {
+ Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ }
+ }
+ if (enableDeallocation)
+ {
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) " free (0x%x) %d bytes\\n", 26, (*a), size);
+ libc_printf ((const char *) "<MEM-FREE> %ld %d\\n", 19, (*a), size);
+ }
+ libc_free ((*a));
+ }
+ (*a) = NULL;
+}
+
+
+/*
+ REALLOCATE - attempts to reallocate storage. The address,
+ a, should either be NIL in which case ALLOCATE
+ is called, or alternatively it should have already
+ been initialized by ALLOCATE. The allocated storage
+ is resized accordingly.
+*/
+
+extern "C" void SysStorage_REALLOCATE (void * *a, unsigned int size)
+{
+ if ((*a) == NULL)
+ {
+ SysStorage_ALLOCATE (a, size);
+ }
+ else
+ {
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) "<DEBUG-CALL> %d SysStorage.REALLOCATE (0x%x, %d bytes)\\n", 56, callno, (*a), size);
+ callno += 1;
+ }
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) " realloc (0x%x, %d bytes) -> ", 32, (*a), size);
+ libc_printf ((const char *) "<MEM-FREE> %ld %d\\n", 19, (*a), size);
+ }
+ (*a) = libc_realloc ((*a), static_cast<size_t> (size));
+ if ((*a) == NULL)
+ {
+ Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ }
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) "<MEM-ALLOC> %ld %d\\n", 20, (*a), size);
+ libc_printf ((const char *) " 0x%x %d bytes\\n", 18, (*a), size);
+ }
+ }
+}
+
+
+/*
+ REALLOCATE - attempts to reallocate storage. The address,
+ a, should either be NIL in which case ALLOCATE
+ is called, or alternatively it should have already
+ been initialized by ALLOCATE. The allocated storage
+ is resized accordingly.
+*/
+
+extern "C" unsigned int SysStorage_Available (unsigned int size)
+{
+ void * a;
+
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) "<DEBUG-CALL> %d SysStorage.Available (%d bytes)\\n", 49, callno, size);
+ callno += 1;
+ }
+ a = libc_malloc (static_cast<size_t> (size));
+ if (a == NULL)
+ {
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) " no\\n", 7, size);
+ }
+ return FALSE;
+ }
+ else
+ {
+ if (enableTrace && trace)
+ {
+ libc_printf ((const char *) " yes\\n", 8, size);
+ }
+ libc_free (a);
+ return TRUE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Init - initializes the heap. This does nothing on a GNU/Linux system.
+ But it remains here since it might be used in an embedded system.
+*/
+
+extern "C" void SysStorage_Init (void)
+{
+}
+
+extern "C" void _M2_SysStorage_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ callno = 0;
+ if (enableTrace)
+ {
+ trace = (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("M2DEBUG_SYSSTORAGE_trace")))) != NULL;
+ }
+ else
+ {
+ trace = FALSE;
+ }
+ if (enableZero)
+ {
+ zero = (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("M2DEBUG_SYSSTORAGE_zero")))) != NULL;
+ }
+ else
+ {
+ zero = FALSE;
+ }
+}
+
+extern "C" void _M2_SysStorage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* Gabort.c a GCC style abort function.
+
+Copyright (C) 2022-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+
+void
+fancy_abort (const char *filename, int line, const char *func)
+{
+ fprintf (stderr, "%s:%d%s: aborting\n", filename, line, func);
+ exit (1);
+}
--- /dev/null
+/* do not edit automatically generated by mc from bnflex. */
+/* bnflex.mod provides a simple lexical package for pg.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <string.h>
+#include <limits.h>
+#define _bnflex_H
+#define _bnflex_C
+
+# include "GPushBackInput.h"
+# include "GSymbolKey.h"
+# include "GASCII.h"
+# include "GDebug.h"
+# include "GNameKey.h"
+# include "GStrLib.h"
+# include "GFIO.h"
+# include "GStrCase.h"
+# include "GStdIO.h"
+
+# define MaxNameLength 8192
+typedef enum {bnflex_identtok, bnflex_literaltok, bnflex_codetok, bnflex_lbecomestok, bnflex_rbecomestok, bnflex_bartok, bnflex_lsparatok, bnflex_rsparatok, bnflex_lcparatok, bnflex_rcparatok, bnflex_lparatok, bnflex_rparatok, bnflex_errortok, bnflex_tfunctok, bnflex_symfunctok, bnflex_squotetok, bnflex_dquotetok, bnflex_moduletok, bnflex_begintok, bnflex_rulestok, bnflex_endtok, bnflex_lesstok, bnflex_gretok, bnflex_tokentok, bnflex_specialtok, bnflex_firsttok, bnflex_followtok, bnflex_BNFtok, bnflex_FNBtok, bnflex_declarationtok, bnflex_epsilontok, bnflex_eoftok} bnflex_TokenType;
+
+static FIO_File f;
+static SymbolKey_SymbolTree ReservedWords;
+static NameKey_Name CurrentToken;
+static bnflex_TokenType CurrentType;
+static unsigned int Debugging;
+static unsigned int InQuote;
+static char QuoteChar;
+
+/*
+ OpenSource - Attempts to open the source file, a.
+ The success of the operation is returned.
+*/
+
+extern "C" unsigned int bnflex_OpenSource (const char *a_, unsigned int _a_high);
+
+/*
+ CloseSource - Closes the current open file.
+*/
+
+extern "C" void bnflex_CloseSource (void);
+
+/*
+ GetChar - returns the current character on the input stream.
+*/
+
+extern "C" char bnflex_GetChar (void);
+
+/*
+ PutChar - pushes a character onto the push back stack, it also
+ returns the character which has been pushed.
+*/
+
+extern "C" char bnflex_PutChar (char ch);
+
+/*
+ SymIs - if t is equal to the current token the next token is read
+ and true is returned, otherwise false is returned.
+*/
+
+extern "C" unsigned int bnflex_SymIs (bnflex_TokenType t);
+
+/*
+ IsSym - returns the result of the comparison between the current token
+ type and t.
+*/
+
+extern "C" unsigned int bnflex_IsSym (bnflex_TokenType t);
+
+/*
+ GetCurrentTokenType - returns the type of current token.
+*/
+
+extern "C" bnflex_TokenType bnflex_GetCurrentTokenType (void);
+
+/*
+ GetCurrentToken - returns the NameKey of the current token.
+*/
+
+extern "C" NameKey_Name bnflex_GetCurrentToken (void);
+
+/*
+ SkipUntilWhite - skips all characters until white space is seen.
+*/
+
+extern "C" void bnflex_SkipUntilWhite (void);
+
+/*
+ SkipWhite - skips all white space.
+*/
+
+extern "C" void bnflex_SkipWhite (void);
+
+/*
+ SkipUntilEoln - skips until a lf is seen. It consumes the lf.
+*/
+
+extern "C" void bnflex_SkipUntilEoln (void);
+
+/*
+ AdvanceToken - advances to the next token.
+*/
+
+extern "C" void bnflex_AdvanceToken (void);
+
+/*
+ IsReserved - returns TRUE if the name is a reserved word.
+*/
+
+extern "C" unsigned int bnflex_IsReserved (NameKey_Name name);
+
+/*
+ PushBackToken - pushes a token back onto input.
+*/
+
+extern "C" void bnflex_PushBackToken (NameKey_Name t);
+
+/*
+ SetDebugging - sets the debugging flag.
+*/
+
+extern "C" void bnflex_SetDebugging (unsigned int flag);
+
+/*
+ EatChar - consumes the next character in the input.
+*/
+
+static void EatChar (void);
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch);
+
+/*
+ SkipComments - consumes comments.
+*/
+
+static void SkipComments (void);
+
+/*
+ WriteToken -
+*/
+
+static void WriteToken (void);
+
+/*
+ Init - initialize the modules global variables.
+*/
+
+static void Init (void);
+
+
+/*
+ EatChar - consumes the next character in the input.
+*/
+
+static void EatChar (void)
+{
+ if ((PushBackInput_GetCh (f)) == ASCII_nul)
+ {} /* empty. */
+}
+
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch)
+{
+ return ((ch == ' ') || (ch == ASCII_tab)) || (ch == ASCII_lf);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SkipComments - consumes comments.
+*/
+
+static void SkipComments (void)
+{
+ bnflex_SkipWhite ();
+ while ((bnflex_PutChar (bnflex_GetChar ())) == '-')
+ {
+ if (((bnflex_GetChar ()) == '-') && ((bnflex_PutChar (bnflex_GetChar ())) == '-'))
+ {
+ /* found comment, skip it */
+ bnflex_SkipUntilEoln ();
+ bnflex_SkipWhite ();
+ }
+ else
+ {
+ /* no second '-' found thus restore first '-' */
+ if ((bnflex_PutChar ('-')) == '-')
+ {} /* empty. */
+ return ;
+ }
+ }
+}
+
+
+/*
+ WriteToken -
+*/
+
+static void WriteToken (void)
+{
+ NameKey_WriteKey (CurrentToken);
+ StdIO_Write (' ');
+}
+
+
+/*
+ Init - initialize the modules global variables.
+*/
+
+static void Init (void)
+{
+ typedef struct Init__T1_a Init__T1;
+
+ struct Init__T1_a { char array[1+1]; };
+ Init__T1 a;
+
+ SymbolKey_InitTree (&ReservedWords);
+ Debugging = FALSE;
+ a.array[0] = ASCII_nul;
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) &a.array[0], 1), ((unsigned int) (bnflex_eoftok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "%", 1), ((unsigned int) (bnflex_codetok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) ":=", 2), ((unsigned int) (bnflex_lbecomestok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "=:", 2), ((unsigned int) (bnflex_rbecomestok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "|", 1), ((unsigned int) (bnflex_bartok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "[", 1), ((unsigned int) (bnflex_lsparatok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "]", 1), ((unsigned int) (bnflex_rsparatok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "{", 1), ((unsigned int) (bnflex_lcparatok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "}", 1), ((unsigned int) (bnflex_rcparatok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "(", 1), ((unsigned int) (bnflex_lparatok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) ")", 1), ((unsigned int) (bnflex_rparatok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "<", 1), ((unsigned int) (bnflex_lesstok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) ">", 1), ((unsigned int) (bnflex_gretok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "error", 5), ((unsigned int) (bnflex_errortok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "tokenfunc", 9), ((unsigned int) (bnflex_tfunctok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "symfunc", 7), ((unsigned int) (bnflex_symfunctok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "'", 1), ((unsigned int) (bnflex_squotetok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "\"", 1), ((unsigned int) (bnflex_dquotetok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "module", 6), ((unsigned int) (bnflex_moduletok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "begin", 5), ((unsigned int) (bnflex_begintok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "rules", 5), ((unsigned int) (bnflex_rulestok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "end", 3), ((unsigned int) (bnflex_endtok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "declaration", 11), ((unsigned int) (bnflex_declarationtok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "token", 5), ((unsigned int) (bnflex_tokentok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "special", 7), ((unsigned int) (bnflex_specialtok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "first", 5), ((unsigned int) (bnflex_firsttok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "follow", 6), ((unsigned int) (bnflex_followtok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "epsilon", 7), ((unsigned int) (bnflex_epsilontok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "BNF", 3), ((unsigned int) (bnflex_BNFtok)));
+ SymbolKey_PutSymKey (ReservedWords, NameKey_MakeKey ((const char *) "FNB", 3), ((unsigned int) (bnflex_FNBtok)));
+ CurrentToken = NameKey_NulName;
+ CurrentType = bnflex_identtok;
+ InQuote = FALSE;
+}
+
+
+/*
+ OpenSource - Attempts to open the source file, a.
+ The success of the operation is returned.
+*/
+
+extern "C" unsigned int bnflex_OpenSource (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ f = PushBackInput_Open ((const char *) a, _a_high);
+ return FIO_IsNoError (f);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CloseSource - Closes the current open file.
+*/
+
+extern "C" void bnflex_CloseSource (void)
+{
+ PushBackInput_Close (f);
+}
+
+
+/*
+ GetChar - returns the current character on the input stream.
+*/
+
+extern "C" char bnflex_GetChar (void)
+{
+ return PushBackInput_GetCh (f);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutChar - pushes a character onto the push back stack, it also
+ returns the character which has been pushed.
+*/
+
+extern "C" char bnflex_PutChar (char ch)
+{
+ return PushBackInput_PutCh (ch);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SymIs - if t is equal to the current token the next token is read
+ and true is returned, otherwise false is returned.
+*/
+
+extern "C" unsigned int bnflex_SymIs (bnflex_TokenType t)
+{
+ if (CurrentType == t)
+ {
+ bnflex_AdvanceToken ();
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsSym - returns the result of the comparison between the current token
+ type and t.
+*/
+
+extern "C" unsigned int bnflex_IsSym (bnflex_TokenType t)
+{
+ return t == CurrentType;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetCurrentTokenType - returns the type of current token.
+*/
+
+extern "C" bnflex_TokenType bnflex_GetCurrentTokenType (void)
+{
+ return CurrentType;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetCurrentToken - returns the NameKey of the current token.
+*/
+
+extern "C" NameKey_Name bnflex_GetCurrentToken (void)
+{
+ return CurrentToken;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SkipUntilWhite - skips all characters until white space is seen.
+*/
+
+extern "C" void bnflex_SkipUntilWhite (void)
+{
+ while (((! (IsWhite (bnflex_PutChar (bnflex_GetChar ())))) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul)) || ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_lf))
+ {
+ EatChar ();
+ }
+}
+
+
+/*
+ SkipWhite - skips all white space.
+*/
+
+extern "C" void bnflex_SkipWhite (void)
+{
+ while (IsWhite (bnflex_PutChar (bnflex_GetChar ())))
+ {
+ EatChar ();
+ }
+}
+
+
+/*
+ SkipUntilEoln - skips until a lf is seen. It consumes the lf.
+*/
+
+extern "C" void bnflex_SkipUntilEoln (void)
+{
+ while (((bnflex_PutChar (bnflex_GetChar ())) != ASCII_lf) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul))
+ {
+ EatChar ();
+ }
+ if ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_lf)
+ {
+ EatChar ();
+ }
+}
+
+
+/*
+ AdvanceToken - advances to the next token.
+*/
+
+extern "C" void bnflex_AdvanceToken (void)
+{
+ typedef struct AdvanceToken__T2_a AdvanceToken__T2;
+
+ struct AdvanceToken__T2_a { char array[MaxNameLength+1]; };
+ AdvanceToken__T2 a;
+ unsigned int i;
+
+ i = 0;
+ if (InQuote)
+ {
+ if (CurrentType == bnflex_literaltok)
+ {
+ if ((bnflex_PutChar (bnflex_GetChar ())) == QuoteChar)
+ {
+ a.array[i] = bnflex_GetChar ();
+ InQuote = FALSE;
+ i += 1;
+ a.array[i] = ASCII_nul;
+ CurrentToken = NameKey_MakeKey ((const char *) &a.array[0], MaxNameLength);
+ CurrentType = (bnflex_TokenType) (SymbolKey_GetSymKey (ReservedWords, CurrentToken));
+ }
+ else
+ {
+ if (QuoteChar == '"')
+ {
+ PushBackInput_WarnError ((const char *) "missing \" at the end of a literal", 33);
+ }
+ else
+ {
+ PushBackInput_WarnError ((const char *) "missing ' at the end of a literal", 33);
+ }
+ InQuote = FALSE; /* to avoid a contineous list of the same error message */
+ }
+ }
+ else
+ {
+ while ((((i < MaxNameLength) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul)) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_lf)) && ((bnflex_PutChar (bnflex_GetChar ())) != QuoteChar))
+ {
+ a.array[i] = bnflex_GetChar ();
+ i += 1;
+ }
+ if ((bnflex_PutChar (bnflex_GetChar ())) == QuoteChar)
+ {
+ CurrentType = bnflex_literaltok;
+ a.array[i] = ASCII_nul;
+ CurrentToken = NameKey_MakeKey ((const char *) &a.array[0], MaxNameLength);
+ }
+ else
+ {
+ if (QuoteChar == '"')
+ {
+ PushBackInput_WarnError ((const char *) "missing \" at the end of a literal", 33);
+ }
+ else
+ {
+ PushBackInput_WarnError ((const char *) "missing ' at the end of a literal", 33);
+ }
+ InQuote = FALSE; /* to avoid a contineous list of the same error message */
+ }
+ }
+ }
+ else
+ {
+ SkipComments ();
+ if (((bnflex_PutChar (bnflex_GetChar ())) == '"') || ((bnflex_PutChar (bnflex_GetChar ())) == '\''))
+ {
+ a.array[i] = bnflex_GetChar ();
+ QuoteChar = a.array[i];
+ i += 1;
+ InQuote = TRUE;
+ a.array[i] = ASCII_nul;
+ CurrentToken = NameKey_MakeKey ((const char *) &a.array[0], MaxNameLength);
+ CurrentType = (bnflex_TokenType) (SymbolKey_GetSymKey (ReservedWords, CurrentToken));
+ }
+ else
+ {
+ while (((((i < MaxNameLength) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul)) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_lf)) && ((bnflex_PutChar (bnflex_GetChar ())) != QuoteChar)) && (! (IsWhite (bnflex_PutChar (bnflex_GetChar ())))))
+ {
+ a.array[i] = bnflex_GetChar ();
+ i += 1;
+ }
+ a.array[i] = ASCII_nul;
+ CurrentToken = NameKey_MakeKey ((const char *) &a.array[0], MaxNameLength);
+ if ((SymbolKey_GetSymKey (ReservedWords, CurrentToken)) == 0)
+ {
+ CurrentType = bnflex_identtok;
+ }
+ else
+ {
+ CurrentType = (bnflex_TokenType) (SymbolKey_GetSymKey (ReservedWords, CurrentToken));
+ }
+ }
+ }
+ if (Debugging)
+ {
+ WriteToken ();
+ }
+}
+
+
+/*
+ IsReserved - returns TRUE if the name is a reserved word.
+*/
+
+extern "C" unsigned int bnflex_IsReserved (NameKey_Name name)
+{
+ return (SymbolKey_GetSymKey (ReservedWords, name)) != 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PushBackToken - pushes a token back onto input.
+*/
+
+extern "C" void bnflex_PushBackToken (NameKey_Name t)
+{
+ typedef struct PushBackToken__T3_a PushBackToken__T3;
+
+ struct PushBackToken__T3_a { char array[MaxNameLength+1]; };
+ PushBackToken__T3 a;
+
+ NameKey_GetKey (t, (char *) &a.array[0], MaxNameLength);
+ PushBackInput_PutString ((const char *) &a.array[0], MaxNameLength);
+}
+
+
+/*
+ SetDebugging - sets the debugging flag.
+*/
+
+extern "C" void bnflex_SetDebugging (unsigned int flag)
+{
+ Debugging = flag;
+}
+
+extern "C" void _M2_bnflex_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_bnflex_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* Gcbuiltin.c provides access to some math intrinsic functions.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "Gcbuiltin.h"
+
+#include "config.h"
+#include "system.h"
+
+#define exp1 2.7182818284590452353602874713526624977572f
+
+double
+cbuiltin_sqrt (double x)
+{
+ return sqrt (x);
+}
+
+long double
+cbuiltin_sqrtl (long double x)
+{
+ return sqrtl (x);
+}
+
+float
+cbuiltin_sqrtf (float x)
+{
+ return sqrtf (x);
+}
+
+double
+cbuiltin_exp (double x)
+{
+ return exp (x);
+}
+
+float
+cbuiltin_expf (float x)
+{
+ return expf (x);
+}
+
+long double
+cbuiltin_expl (long double x)
+{
+ return expl (x);
+}
+
+/* calculcate ln from log. */
+
+double
+cbuiltin_ln (double x)
+{
+ return log (x) / log (exp1);
+}
+
+float
+cbuiltin_lnf (float x)
+{
+ return logf (x) / logf (exp1);
+}
+
+long double
+cbuiltin_lnl (long double x)
+{
+ return logl (x) / logl (exp1);
+}
+
+double
+cbuiltin_sin (double x)
+{
+ return sin (x);
+}
+
+long double
+cbuiltin_sinl (long double x)
+{
+ return sinl (x);
+}
+
+float
+cbuiltin_sinf (float x)
+{
+ return sinf (x);
+}
+
+double
+cbuiltin_cos (double x)
+{
+ return cos (x);
+}
+
+float
+cbuiltin_cosf (float x)
+{
+ return cosf (x);
+}
+
+long double
+cbuiltin_cosl (long double x)
+{
+ return cosl (x);
+}
+
+double
+cbuiltin_tan (double x)
+{
+ return tan (x);
+}
+
+long double
+cbuiltin_tanl (long double x)
+{
+ return tanl (x);
+}
+
+float
+cbuiltin_tanf (float x)
+{
+ return tanf (x);
+}
+
+double
+cbuiltin_arctan (double x)
+{
+ return atan (x);
+}
+
+float
+cbuiltin_arctanf (float x)
+{
+ return atanf (x);
+}
+
+long double
+arctanl (long double x)
+{
+ return atanl (x);
+}
+
+int
+cbuiltin_entier (double x)
+{
+ return (int)floor (x);
+}
+
+int
+cbuiltin_entierf (float x)
+{
+ return (int)floorf (x);
+}
+
+int
+cbuiltin_entierl (long double x)
+{
+ return (int)floorl (x);
+}
--- /dev/null
+/* Gdtoa.c provides access to double string conversion.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#define GM2
+
+#include "config.h"
+#include "system.h"
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define MAX_FP_DIGITS 500
+
+typedef enum Mode { maxsignicant, decimaldigits } Mode;
+
+/* maxsignicant: return a string containing max(1,ndigits)
+ significant digits. The return string contains the string
+ produced by ecvt. decimaldigits: return a string produced by
+ fcvt. The string will contain ndigits past the decimal point
+ (ndigits may be negative). */
+
+double
+dtoa_strtod (const char *s, int *error)
+{
+ char *endp;
+ double d;
+
+ errno = 0;
+ d = strtod (s, &endp);
+ if (endp != NULL && (*endp == '\0'))
+ *error = (errno != 0);
+ else
+ *error = TRUE;
+ return d;
+}
+
+/* dtoa_calcmaxsig - calculates the position of the decimal point it
+ also removes the decimal point and exponent from string, p. */
+
+int
+dtoa_calcmaxsig (char *p, int ndigits)
+{
+ char *e;
+ char *o;
+ int x;
+
+ e = index (p, 'E');
+ if (e == NULL)
+ x = 0;
+ else
+ {
+ *e = (char)0;
+ x = atoi (e + 1);
+ }
+
+ o = index (p, '.');
+ if (o == NULL)
+ return strlen (p) + x;
+ else
+ {
+ memmove (o, o + 1, ndigits - (o - p));
+ return o - p + x;
+ }
+}
+
+/* dtoa_calcdecimal - calculates the position of the decimal point it
+ also removes the decimal point and exponent from string, p. It
+ truncates the digits in p accordingly to ndigits. Ie ndigits is
+ the number of digits after the '.' */
+
+int
+dtoa_calcdecimal (char *p, int str_size, int ndigits)
+{
+ char *e;
+ char *o;
+ int x;
+ int l;
+
+ e = index (p, 'E');
+ if (e == NULL)
+ x = 0;
+ else
+ {
+ *e = (char)0;
+ x = atoi (e + 1);
+ }
+
+ l = strlen (p);
+ o = index (p, '.');
+ if (o == NULL)
+ x += strlen (p);
+ else
+ {
+ int m = strlen (o);
+ memmove (o, o + 1, l - (o - p));
+ if (m > 0)
+ o[m - 1] = '0';
+ x += o - p;
+ }
+ if ((x + ndigits >= 0) && (x + ndigits < str_size))
+ p[x + ndigits] = (char)0;
+ return x;
+}
+
+
+int
+dtoa_calcsign (char *p, int str_size)
+{
+ if (p[0] == '-')
+ {
+ memmove (p, p + 1, str_size - 1);
+ return TRUE;
+ }
+ else
+ return FALSE;
+}
+
+
+char *
+dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign)
+{
+ char format[50];
+ char *p;
+ int r;
+ switch (mode)
+ {
+
+ case maxsignicant:
+ ndigits += 20; /* enough for exponent. */
+ p = (char *) malloc (ndigits);
+ snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "E");
+ snprintf (p, ndigits, format, d);
+ *sign = dtoa_calcsign (p, ndigits);
+ *decpt = dtoa_calcmaxsig (p, ndigits);
+ return p;
+ case decimaldigits:
+ p = (char *) malloc (MAX_FP_DIGITS + 20);
+ snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "E");
+ snprintf (p, MAX_FP_DIGITS + 20, format, d);
+ *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
+ *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ return p;
+ default:
+ abort ();
+ }
+}
+
+#if defined(GM2)
+/* GNU Modula-2 hooks */
+
+void
+_M2_dtoa_init (void)
+{
+}
+
+void
+_M2_dtoa_finish (void)
+{
+}
+#endif
+
+#ifdef __cplusplus
+}
+#endif
--- /dev/null
+/* Gerrno.c provides access to errno for Modula-2.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+#include "ansidecl.h"
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+/* geterrno returns errno. */
+
+int
+errno_geterrno (void)
+{
+ return errno;
+}
+
+/* init constructor for the module. */
+
+void
+_M2_errno_init (int argc, char *p)
+{
+}
+
+/* finish deconstructor for the module. */
+
+void
+_M2_errno_fini (int argc, char *p)
+{
+}
+
+# ifdef __cplusplus
+}
+# endif
--- /dev/null
+/* Gldtoa.c provides access to long double string conversion.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+
+#include "gm2-libs-host.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define MAX_FP_DIGITS 500
+
+typedef enum Mode { maxsignicant, decimaldigits } Mode;
+
+extern int dtoa_calcmaxsig (char *p, int ndigits);
+extern int dtoa_calcdecimal (char *p, int str_size, int ndigits);
+extern int dtoa_calcsign (char *p, int str_size);
+
+/* maxsignicant: return a string containing max(1,ndigits)
+ significant digits. The return string contains the string
+ produced by snprintf. decimaldigits: return a string produced by
+ fcvt. The string will contain ndigits past the decimal point
+ (ndigits may be negative). */
+
+long double
+ldtoa_strtold (const char *s, int *error)
+{
+ char *endp;
+ long double d;
+
+ errno = 0;
+#if defined(HAVE_STRTOLD)
+ d = strtold (s, &endp);
+#else
+ /* fall back to using strtod. */
+ d = (long double)strtod (s, &endp);
+#endif
+ if (endp != NULL && (*endp == '\0'))
+ *error = (errno != 0);
+ else
+ *error = TRUE;
+ return d;
+}
+
+char *
+ldtoa_ldtoa (long double d, int mode, int ndigits, int *decpt, int *sign)
+{
+ char format[50];
+ char *p;
+ int r;
+ switch (mode)
+ {
+
+ case maxsignicant:
+ ndigits += 20; /* enough for exponent. */
+ p = (char *)malloc (ndigits);
+ snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "LE");
+ snprintf (p, ndigits, format, d);
+ *sign = dtoa_calcsign (p, ndigits);
+ *decpt = dtoa_calcmaxsig (p, ndigits);
+ return p;
+ case decimaldigits:
+ p = (char *)malloc (MAX_FP_DIGITS + 20);
+ snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "LE");
+ snprintf (p, MAX_FP_DIGITS + 20, format, d);
+ *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
+ *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ return p;
+ default:
+ abort ();
+ }
+}
+
+/* GNU Modula-2 hooks */
+
+void
+_M2_ldtoa_init (void)
+{
+}
+
+void
+_M2_ldtoa_finish (void)
+{
+}
+# ifdef __cplusplus
+}
+# endif
--- /dev/null
+/* Glibc.c provides access to some libc functions.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+
+#if defined(__cplusplus)
+#define EXTERN extern "C"
+#else
+#define EXTERN
+#endif
+
+EXTERN
+int
+libc_read (int fd, void *a, int nbytes)
+{
+ return read (fd, a, nbytes);
+}
+
+EXTERN
+int
+libc_write (int fd, void *a, int nbytes)
+{
+ return write (fd, a, nbytes);
+}
+
+EXTERN
+int
+libc_close (int fd)
+{
+ return close (fd);
+}
+
+EXTERN
+int
+libc_exit (int code)
+{
+ exit (code);
+}
+
+EXTERN
+void
+libc_perror (char *s)
+{
+ perror (s);
+}
+
+EXTERN
+int
+libc_abort ()
+{
+ abort ();
+}
+
+EXTERN
+int
+libc_strlen (char *s)
+{
+ return strlen (s);
+}
+
+EXTERN
+int
+libc_printf (char *_format, unsigned int _format_high, ...)
+{
+ va_list arg;
+ int done;
+ char format[_format_high + 1];
+ unsigned int i = 0;
+ unsigned int j = 0;
+ char *c;
+
+ do
+ {
+ c = index (&_format[i], '\\');
+ if (c == NULL)
+ strcpy (&format[j], &_format[i]);
+ else
+ {
+ memcpy (&format[j], &_format[i], (c - _format) - i);
+ i = c - _format;
+ j += c - _format;
+ if (_format[i + 1] == 'n')
+ format[j] = '\n';
+ else
+ format[j] = _format[i + 1];
+ j++;
+ i += 2;
+ }
+ }
+ while (c != NULL);
+
+ va_start (arg, _format_high);
+ done = vfprintf (stdout, format, arg);
+ va_end (arg);
+
+ return done;
+}
+
+EXTERN
+int
+libc_snprintf (char *dest, size_t length, char *_format, unsigned int _format_high, ...)
+{
+ va_list arg;
+ int done;
+ char format[_format_high + 1];
+ unsigned int i = 0;
+ unsigned int j = 0;
+ char *c;
+
+ do
+ {
+ c = index (&_format[i], '\\');
+ if (c == NULL)
+ strcpy (&format[j], &_format[i]);
+ else
+ {
+ memcpy (&format[j], &_format[i], (c - _format) - i);
+ i = c - _format;
+ j += c - _format;
+ if (_format[i + 1] == 'n')
+ format[j] = '\n';
+ else
+ format[j] = _format[i + 1];
+ j++;
+ i += 2;
+ }
+ }
+ while (c != NULL);
+
+ va_start (arg, _format_high);
+ done = vsnprintf (dest, length, format, arg);
+ va_end (arg);
+ return done;
+}
+
+EXTERN
+void *
+libc_malloc (unsigned int size)
+{
+ return malloc (size);
+}
+
+EXTERN
+void
+libc_free (void *p)
+{
+ free (p);
+}
+
+EXTERN
+char *
+libc_strcpy (char *dest, char *src)
+{
+ return strcpy (dest, src);
+}
+
+EXTERN
+char *
+libc_strncpy (char *dest, char *src, int n)
+{
+ return strncpy (dest, src, n);
+}
+
+EXTERN
+int
+libc_unlink (char *p)
+{
+ return unlink (p);
+}
+
+EXTERN
+int
+libc_system (char *command)
+{
+ return system (command);
+}
+
+EXTERN
+void *
+libc_memcpy (void *dest, void *src, int n)
+{
+ return memcpy (dest, src, n);
+}
+
+EXTERN
+char *
+libc_getenv (char *name)
+{
+ return getenv (name);
+}
+
+EXTERN
+int
+libc_putenv (char *name)
+{
+ return putenv (name);
+}
+
+EXTERN
+int
+libc_creat (char *p, mode_t mode)
+{
+ return creat (p, mode);
+}
+
+EXTERN
+int
+libc_open (char *p, int flags, mode_t mode)
+{
+ return open (p, flags, mode);
+}
+
+EXTERN
+off_t
+libc_lseek (int fd, off_t offset, int whence)
+{
+ return lseek (fd, offset, whence);
+}
+
+EXTERN
+void *
+libc_realloc (void *ptr, size_t size)
+{
+ return realloc (ptr, size);
+}
+
+EXTERN
+void *
+libc_memset (void *s, int c, size_t n)
+{
+ return memset (s, c, n);
+}
+
+EXTERN
+void *
+libc_memmove (void *dest, void *src, size_t n)
+{
+ return memmove (dest, src, n);
+}
+
+EXTERN
+int
+libc_getpid (void)
+{
+ return getpid ();
+}
+
+EXTERN
+unsigned int
+libc_sleep (unsigned int s)
+{
+ return sleep (s);
+}
+
+EXTERN
+int
+libc_atexit (void (*function) (void))
+{
+ return atexit (function);
+}
--- /dev/null
+/* Glibm.c provides access to some libm functions.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#define _libm_C
+#include "config.h"
+#include "system.h"
+
+#include "Glibm.h"
+
+double
+libm_pow (double x, double y)
+{
+ return pow (x, y);
+}
+
+float
+libm_powf (float x, float y)
+{
+ return powf (x, y);
+}
+
+long double
+libm_powl (long double x, long double y)
+{
+ return powl (x, y);
+}
+
+double
+libm_sqrt (double x)
+{
+ return sqrt (x);
+}
+
+float
+libm_sqrtf (float x)
+{
+ return sqrtf (x);
+}
+
+long double
+libm_sqrtl (long double x)
+{
+ return sqrtl (x);
+}
+
+double
+libm_asin (double x)
+{
+ return asin (x);
+}
+
+float
+libm_asinf (float x)
+{
+ return asinf (x);
+}
+
+long double
+libm_asinl (long double x)
+{
+ return asinl (x);
+}
+
+double
+libm_atan (double x)
+{
+ return atan (x);
+}
+
+float
+libm_atanf (float x)
+{
+ return atanf (x);
+}
+
+long double
+libm_atanl (long double x)
+{
+ return atanl (x);
+}
+
+double
+libm_atan2 (double x, double y)
+{
+ return atan2 (x, y);
+}
+
+float
+libm_atan2f (float x, float y)
+{
+ return atan2f (x, y);
+}
+
+long double
+libm_atan2l (long double x, long double y)
+{
+ return atan2l (x, y);
+}
+
+double
+libm_sin (double x)
+{
+ return sin (x);
+}
+
+float
+libm_sinf (float x)
+{
+ return sinf (x);
+}
+
+long double
+libm_sinl (long double x)
+{
+ return sinl (x);
+}
+
+double
+libm_cos (double x)
+{
+ return cos (x);
+}
+
+float
+libm_cosf (float x)
+{
+ return cosf (x);
+}
+
+long double
+libm_cosl (long double x)
+{
+ return cosl (x);
+}
+
+double
+libm_tan (double x)
+{
+ return tan (x);
+}
+
+float
+libm_tanf (float x)
+{
+ return tanf (x);
+}
+
+long double
+libm_tanl (long double x)
+{
+ return tanl (x);
+}
+
+float
+libm_floorf (float x)
+{
+ return floorf (x);
+}
+
+double
+libm_floor (double x)
+{
+ return floor (x);
+}
+
+long double
+libm_floorl (long double x)
+{
+ return floorl (x);
+}
+
+float
+libm_expf (float x)
+{
+ return expf (x);
+}
+
+double
+libm_exp (double x)
+{
+ return exp (x);
+}
+
+long double
+libm_expl (long double x)
+{
+ return expl (x);
+}
+
+float
+libm_logf (float x)
+{
+ return logf (x);
+}
+
+double
+libm_log (double x)
+{
+ return log (x);
+}
+
+long double
+libm_logl (long double x)
+{
+ return logl (x);
+}
--- /dev/null
+/* Gmcrts.c implements case and return exceptions.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+void
+CaseException (const char *s, unsigned int high, unsigned int lineno)
+{
+ fprintf (stderr, "%s:%d:case statement has no matching selection\n", s,
+ lineno);
+ _exit (1);
+}
+
+void
+ReturnException (const char *s, unsigned int high, unsigned int lineno)
+{
+ fprintf (stderr, "%s:%d:procedure function is about to finish and no return "
+ "statement has been executed\n",
+ s, lineno);
+ _exit (1);
+}
+
+void _throw (int n)
+{
+ fprintf (stderr, "throw called (%d)\n", n);
+ _exit (1);
+}
+
+# ifdef __cplusplus
+}
+# endif
--- /dev/null
+/* do not edit automatically generated by mc from pge. */
+/* pge.mod master source file of the ebnf parser generator.
+
+Copyright (C) 2003-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#include <stddef.h>
+#include <string.h>
+#include <limits.h>
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+# include "GPushBackInput.h"
+# include "Gbnflex.h"
+# include "GStrLib.h"
+# include "GStorage.h"
+# include "GNameKey.h"
+# include "GNumberIO.h"
+# include "GSymbolKey.h"
+# include "GLists.h"
+# include "GDynamicStrings.h"
+# include "GASCII.h"
+# include "GStrIO.h"
+# include "GStdIO.h"
+# include "GDebug.h"
+# include "GArgs.h"
+# include "GSYSTEM.h"
+# include "Glibc.h"
+# include "GOutput.h"
+# include "GM2RTS.h"
+
+# define MaxCodeHunkLength 8192
+# define MaxFileName 8192
+# define MaxString 8192
+# define DefaultRecovery TRUE
+# define MaxElementsInSet 32
+# define BaseRightLimit 75
+# define BaseRightMargin 50
+# define BaseNewLine 3
+typedef struct pge_termdesc_r pge_termdesc;
+
+typedef pge_termdesc *pge_TermDesc;
+
+typedef struct pge_DoProcedure_p pge_DoProcedure;
+
+typedef unsigned int pge_SetOfStop;
+
+typedef struct pge__T1_r pge__T1;
+
+typedef pge__T1 *pge_IdentDesc;
+
+typedef struct pge__T2_r pge__T2;
+
+typedef pge__T2 *pge_ProductionDesc;
+
+typedef struct pge__T3_r pge__T3;
+
+typedef pge__T3 *pge_StatementDesc;
+
+typedef struct pge__T4_r pge__T4;
+
+typedef pge__T4 *pge_ExpressionDesc;
+
+typedef struct pge__T5_r pge__T5;
+
+typedef struct pge__T6_r pge__T6;
+
+typedef pge__T6 *pge_FollowDesc;
+
+typedef struct pge__T7_r pge__T7;
+
+typedef pge__T7 *pge_SetDesc;
+
+typedef struct pge__T8_r pge__T8;
+
+typedef pge__T8 *pge_CodeDesc;
+
+typedef struct pge__T9_r pge__T9;
+
+typedef pge__T9 *pge_CodeHunk;
+
+typedef struct pge__T10_a pge__T10;
+
+typedef struct pge__T11_a pge__T11;
+
+typedef enum {pge_idel, pge_tokel, pge_litel} pge_ElementType;
+
+typedef enum {pge_m2none, pge_m2if, pge_m2elsif, pge_m2while} pge_m2condition;
+
+typedef enum {pge_unknown, pge_true, pge_false} pge_TraverseResult;
+
+typedef enum {pge_id, pge_lit, pge_sub, pge_opt, pge_mult, pge_m2} pge_FactorType;
+
+typedef pge__T5 *pge_FactorDesc;
+
+struct pge_termdesc_r {
+ pge_FactorDesc factor;
+ pge_TermDesc next;
+ pge_FollowDesc followinfo;
+ unsigned int line;
+ };
+
+typedef void (*pge_DoProcedure_t) (pge_ProductionDesc);
+struct pge_DoProcedure_p { pge_DoProcedure_t proc; };
+
+struct pge__T1_r {
+ pge_ProductionDesc definition;
+ NameKey_Name name;
+ unsigned int line;
+ };
+
+struct pge__T2_r {
+ pge_ProductionDesc next;
+ pge_StatementDesc statement;
+ pge_SetDesc first;
+ unsigned int firstsolved;
+ pge_FollowDesc followinfo;
+ unsigned int line;
+ NameKey_Name description;
+ };
+
+struct pge__T3_r {
+ pge_IdentDesc ident;
+ pge_ExpressionDesc expr;
+ pge_FollowDesc followinfo;
+ unsigned int line;
+ };
+
+struct pge__T4_r {
+ pge_TermDesc term;
+ pge_FollowDesc followinfo;
+ unsigned int line;
+ };
+
+struct pge__T5_r {
+ pge_FollowDesc followinfo;
+ pge_FactorDesc next;
+ unsigned int line;
+ pge_FactorDesc pushed;
+ pge_FactorType type; /* case tag */
+ union {
+ pge_IdentDesc ident;
+ NameKey_Name string;
+ pge_ExpressionDesc expr;
+ pge_CodeDesc code;
+ };
+ };
+
+struct pge__T6_r {
+ unsigned int calcfollow;
+ pge_SetDesc follow;
+ pge_TraverseResult reachend;
+ pge_TraverseResult epsilon;
+ unsigned int line;
+ };
+
+struct pge__T7_r {
+ pge_SetDesc next;
+ pge_ElementType type; /* case tag */
+ union {
+ pge_IdentDesc ident;
+ NameKey_Name string;
+ };
+ };
+
+struct pge__T8_r {
+ pge_CodeHunk code;
+ unsigned int indent;
+ unsigned int line;
+ };
+
+struct pge__T10_a { char array[MaxCodeHunkLength+1]; };
+struct pge__T11_a { char array[MaxFileName+1]; };
+struct pge__T9_r {
+ pge__T10 codetext;
+ pge_CodeHunk next;
+ };
+
+static unsigned int LastLineNo;
+static unsigned int Finished;
+static unsigned int SuppressFileLineTag;
+static unsigned int KeywordFormatting;
+static unsigned int PrettyPrint;
+static unsigned int EmitCode;
+static unsigned int Texinfo;
+static unsigned int Sphinx;
+static unsigned int FreeDocLicense;
+static unsigned int Debugging;
+static unsigned int WasNoError;
+static unsigned int LinePrologue;
+static unsigned int LineEpilogue;
+static unsigned int LineDeclaration;
+static pge_CodeHunk CodePrologue;
+static pge_CodeHunk CodeEpilogue;
+static pge_CodeHunk CodeDeclaration;
+static pge_ProductionDesc CurrentProduction;
+static pge_ProductionDesc TailProduction;
+static pge_ProductionDesc HeadProduction;
+static pge_ExpressionDesc CurrentExpression;
+static pge_TermDesc CurrentTerm;
+static pge_FactorDesc CurrentFactor;
+static pge_IdentDesc CurrentIdent;
+static pge_StatementDesc CurrentStatement;
+static pge_SetDesc CurrentSetDesc;
+static SymbolKey_SymbolTree ReverseValues;
+static SymbolKey_SymbolTree Values;
+static SymbolKey_SymbolTree ReverseAliases;
+static SymbolKey_SymbolTree Aliases;
+static NameKey_Name ModuleName;
+static NameKey_Name LastLiteral;
+static NameKey_Name LastIdent;
+static NameKey_Name SymIsProc;
+static NameKey_Name TokenTypeProc;
+static NameKey_Name ErrorProcArray;
+static NameKey_Name ErrorProcString;
+static pge__T11 ArgName;
+static pge__T11 FileName;
+static unsigned int OnLineStart;
+static unsigned int BeginningOfLine;
+static unsigned int Indent;
+static unsigned int EmittedVar;
+static unsigned int ErrorRecovery;
+static unsigned int LargestValue;
+static unsigned int InitialElement;
+static unsigned int ParametersUsed;
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (pge_SetOfStop stopset);
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void);
+
+/*
+ AddEntry - adds an entry into, t, containing [def:value].
+*/
+
+static void AddEntry (SymbolKey_SymbolTree *t, NameKey_Name def, NameKey_Name value);
+
+/*
+ Format1 - converts string, src, into, dest, together with encapsulated
+ entity, n. It only formats the first %s or %d with n.
+*/
+
+static void Format1 (const char *src_, unsigned int _src_high, unsigned int n, char *dest, unsigned int _dest_high);
+
+/*
+ WarnError1 -
+*/
+
+static void WarnError1 (const char *a_, unsigned int _a_high, unsigned int n);
+
+/*
+ PrettyFollow -
+*/
+
+static void PrettyFollow (const char *start_, unsigned int _start_high, const char *end_, unsigned int _end_high, pge_FollowDesc f);
+
+/*
+ NewFollow - creates a new follow descriptor and returns the data structure.
+*/
+
+static pge_FollowDesc NewFollow (void);
+
+/*
+ AssignEpsilon - assigns the epsilon value and sets the epsilon to value,
+ providing condition is TRUE.
+*/
+
+static void AssignEpsilon (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value);
+
+/*
+ GetEpsilon - returns the value of epsilon
+*/
+
+static pge_TraverseResult GetEpsilon (pge_FollowDesc f);
+
+/*
+ AssignReachEnd - assigns the reachend value providing that, condition, is TRUE.
+*/
+
+static void AssignReachEnd (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value);
+
+/*
+ GetReachEnd - returns the value of reachend
+*/
+
+static pge_TraverseResult GetReachEnd (pge_FollowDesc f);
+
+/*
+ AssignFollow - assigns the follow set and sets the calcfollow to TRUE.
+*/
+
+static void AssignFollow (pge_FollowDesc f, pge_SetDesc s);
+
+/*
+ GetFollow - returns the follow set.
+*/
+
+static pge_SetDesc GetFollow (pge_FollowDesc f);
+
+/*
+ NewProduction - creates a new production and returns the data structure.
+*/
+
+static pge_ProductionDesc NewProduction (void);
+
+/*
+ NewFactor -
+*/
+
+static pge_FactorDesc NewFactor (void);
+
+/*
+ NewTerm - returns a new term.
+*/
+
+static pge_TermDesc NewTerm (void);
+
+/*
+ NewExpression - returns a new expression.
+*/
+
+static pge_ExpressionDesc NewExpression (void);
+
+/*
+ NewStatement - returns a new statement.
+*/
+
+static pge_StatementDesc NewStatement (void);
+
+/*
+ NewSetDesc - creates a new set description and returns the data structure.
+*/
+
+static pge_SetDesc NewSetDesc (void);
+
+/*
+ NewCodeDesc - creates a new code descriptor and initializes all fields to zero.
+*/
+
+static pge_CodeDesc NewCodeDesc (void);
+
+/*
+ CodeFragmentPrologue - consumes code text up to a "%" after a newline.
+*/
+
+static void CodeFragmentPrologue (void);
+
+/*
+ CodeFragmentEpilogue - consumes code text up to a "%" after a newline.
+*/
+
+static void CodeFragmentEpilogue (void);
+
+/*
+ CodeFragmentDeclaration - consumes code text up to a "%" after a newline.
+*/
+
+static void CodeFragmentDeclaration (void);
+
+/*
+ GetCodeFragment - collects the code fragment up until ^ %
+*/
+
+static void GetCodeFragment (pge_CodeHunk *h);
+
+/*
+ WriteCodeHunkList - writes the CodeHunk list in the correct order.
+*/
+
+static void WriteCodeHunkList (pge_CodeHunk l);
+
+/*
+ WriteIndent - writes, n, spaces.
+*/
+
+static void WriteIndent (unsigned int n);
+
+/*
+ CheckWrite -
+*/
+
+static void CheckWrite (char ch, unsigned int *curpos, unsigned int left, unsigned int *seentext);
+
+/*
+ WriteStringIndent - writes a string but it will try and remove upto indent spaces
+ if they exist.
+*/
+
+static void WriteStringIndent (const char *a_, unsigned int _a_high, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext);
+
+/*
+ WriteCodeHunkListIndent - writes the CodeHunk list in the correct order
+ but it removes up to indent spaces if they exist.
+*/
+
+static void WriteCodeHunkListIndent (pge_CodeHunk l, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext);
+
+/*
+ Add - adds a character to a code hunk and creates another code hunk if necessary.
+*/
+
+static pge_CodeHunk Add (pge_CodeHunk *p, char ch, unsigned int *i);
+
+/*
+ ConsHunk - combine two possible code hunks.
+*/
+
+static void ConsHunk (pge_CodeHunk *p, pge_CodeHunk q);
+
+/*
+ GetName - returns the next symbol which is checked for a legal name.
+*/
+
+static NameKey_Name GetName (void);
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (pge_SetOfStop stop);
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (pge_SetOfStop stop);
+
+/*
+ Expect -
+*/
+
+static void Expect (bnflex_TokenType t, pge_SetOfStop stop);
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (pge_SetOfStop stop);
+
+/*
+ Modula2Code - error checking varient of Modula2Code
+*/
+
+static void Modula2Code (pge_SetOfStop stop);
+
+/*
+ StartModName := % ModuleName := GetName() ; ignore begintok CodeFragmentPrologue % =:
+*/
+
+static void StartModName (pge_SetOfStop stop);
+
+/*
+ EndModName :=
+*/
+
+static void EndModName (pge_SetOfStop stop);
+
+/*
+ DoDeclaration := % CodeFragmentDeclaration % =:
+*/
+
+static void DoDeclaration (pge_SetOfStop stop);
+
+/*
+ CollectLiteral :=
+ % LastLiteral := GetCurrentToken() ;
+ AdvanceToken ; %
+
+
+ first symbols:literaltok
+
+ cannot reachend
+*/
+
+static void CollectLiteral (pge_SetOfStop stopset);
+
+/*
+ CollectTok :=
+ % CurrentSetDesc := NewSetDesc() ;
+ WITH CurrentSetDesc^ DO
+ type := tokel ;
+ string := GetCurrentToken() ;
+ END ;
+ IF NOT ContainsSymKey(Values, GetCurrentToken())
+ THEN
+ AddEntry(Values, GetCurrentToken(), LargestValue) ;
+ AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ;
+ AddEntry(Aliases, GetCurrentToken(), GetCurrentToken()) ;
+ AddEntry(ReverseAliases, GetCurrentToken(), GetCurrentToken()) ;
+ INC(LargestValue)
+ END ;
+ AdvanceToken() ; %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void CollectTok (pge_SetOfStop stopset);
+
+/*
+ DefineToken :=
+ % AddEntry(Aliases, LastLiteral, GetCurrentToken()) ;
+ AddEntry(ReverseAliases, GetCurrentToken(), LastLiteral) ;
+ AddEntry(Values, GetCurrentToken(), LargestValue) ;
+ AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ;
+ INC(LargestValue) ;
+ AdvanceToken ; %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefineToken (pge_SetOfStop stopset);
+
+/*
+ Rules := '%' 'rules' { Defs } ExtBNF
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Rules (pge_SetOfStop stopset);
+
+/*
+ Special := Ident
+ % VAR p: ProductionDesc ; %
+
+ % p := NewProduction() ;
+ p^.statement := NewStatement() ;
+ p^.statement^.followinfo^.calcfollow := TRUE ;
+ p^.statement^.followinfo^.epsilon := false ;
+ p^.statement^.followinfo^.reachend := false ;
+ p^.statement^.ident := CurrentIdent ;
+ p^.statement^.expr := NIL ;
+ p^.firstsolved := TRUE ;
+ p^.followinfo^.calcfollow := TRUE ;
+ p^.followinfo^.epsilon := false ;
+ p^.followinfo^.reachend := false %
+ First Follow [ 'epsilon'
+ % p^.statement^.followinfo^.epsilon := true ; these are not used - but they are displayed when debugging
+ p^.statement^.followinfo^.reachend := true ;
+ p^.followinfo^.epsilon := true ;
+ p^.followinfo^.reachend := true
+ %
+ ] [ Literal
+ % p^.description := LastLiteral %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Special (pge_SetOfStop stopset);
+
+/*
+ Factor := '%' Modula2Code '%' |
+ Ident
+ % WITH CurrentFactor^ DO
+ type := id ;
+ ident := CurrentIdent
+ END ; %
+ | Literal
+ % WITH CurrentFactor^ DO
+ type := lit ;
+ string := LastLiteral ;
+ IF GetSymKey(Aliases, LastLiteral)=NulName
+ THEN
+ WarnError1('no token defined for literal %s', LastLiteral)
+ END
+ END ; %
+ | '{'
+ % WITH CurrentFactor^ DO
+ type := mult ;
+ expr := NewExpression() ;
+ CurrentExpression := expr ;
+ END ; %
+ Expression '}' | '['
+ % WITH CurrentFactor^ DO
+ type := opt ;
+ expr := NewExpression() ;
+ CurrentExpression := expr ;
+ END ; %
+ Expression ']' | '('
+ % WITH CurrentFactor^ DO
+ type := sub ;
+ expr := NewExpression() ;
+ CurrentExpression := expr ;
+ END ; %
+ Expression ')'
+
+ first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok
+
+ cannot reachend
+*/
+
+static void Factor (pge_SetOfStop stopset);
+
+/*
+ Statement :=
+ % VAR i: IdentDesc ; %
+ Ident
+ % VAR p: ProductionDesc ; %
+
+ % p := FindDefinition(CurrentIdent^.name) ;
+ IF p=NIL
+ THEN
+ p := NewProduction()
+ ELSE
+ IF NOT ((p^.statement=NIL) OR (p^.statement^.expr=NIL))
+ THEN
+ WarnError1('already declared rule %s', CurrentIdent^.name)
+ END
+ END ;
+ i := CurrentIdent ; %
+ ':='
+ % VAR e: ExpressionDesc ; %
+
+ % e := NewExpression() ;
+ CurrentExpression := e ; %
+
+ % VAR s: StatementDesc ; %
+
+ % s := NewStatement() ;
+ WITH s^ DO
+ ident := i ;
+ expr := e
+ END ; %
+ Expression
+ % p^.statement := s ; %
+ '=:'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Statement (pge_SetOfStop stopset);
+
+/*
+ Defs := 'special' Special | 'token' Token |
+ 'error' ErrorProcedures |
+ 'tokenfunc' TokenProcedure |
+ 'symfunc' SymProcedure
+
+ first symbols:symfunctok, tfunctok, errortok, tokentok, specialtok
+
+ cannot reachend
+*/
+
+static void Defs (pge_SetOfStop stopset);
+
+/*
+ ExtBNF := 'BNF' { Production } 'FNB'
+
+ first symbols:BNFtok
+
+ cannot reachend
+*/
+
+static void ExtBNF (pge_SetOfStop stopset);
+
+/*
+ Main := Header Decls Footer Rules
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Main (pge_SetOfStop stopset);
+
+/*
+ Header := '%' 'module' StartModName
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Header (pge_SetOfStop stopset);
+
+/*
+ Decls := '%' 'declaration' DoDeclaration
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Decls (pge_SetOfStop stopset);
+
+/*
+ Footer := '%' 'module' EndModName
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Footer (pge_SetOfStop stopset);
+
+/*
+ First := 'first' '{' { LitOrTokenOrIdent
+ % WITH CurrentSetDesc^ DO
+ next := TailProduction^.first ;
+ END ;
+ TailProduction^.first := CurrentSetDesc
+ %
+ } '}'
+
+ first symbols:firsttok
+
+ cannot reachend
+*/
+
+static void First (pge_SetOfStop stopset);
+
+/*
+ Follow := 'follow' '{' { LitOrTokenOrIdent
+ % WITH CurrentSetDesc^ DO
+ next := TailProduction^.followinfo^.follow ;
+ END ;
+ TailProduction^.followinfo^.follow := CurrentSetDesc
+ %
+ } '}'
+
+ first symbols:followtok
+
+ cannot reachend
+*/
+
+static void Follow (pge_SetOfStop stopset);
+
+/*
+ LitOrTokenOrIdent := Literal
+ % CurrentSetDesc := NewSetDesc() ;
+ WITH CurrentSetDesc^ DO
+ type := litel ;
+ string := LastLiteral ;
+ END ;
+ %
+ | '<' CollectTok '>' |
+ Ident
+ % CurrentSetDesc := NewSetDesc() ;
+ WITH CurrentSetDesc^ DO
+ type := idel ;
+ ident := CurrentIdent ;
+ END ;
+ %
+
+
+ first symbols:dquotetok, squotetok, identtok, lesstok
+
+ cannot reachend
+*/
+
+static void LitOrTokenOrIdent (pge_SetOfStop stopset);
+
+/*
+ Literal := '"' CollectLiteral '"' |
+ "'" CollectLiteral "'"
+
+ first symbols:squotetok, dquotetok
+
+ cannot reachend
+*/
+
+static void Literal (pge_SetOfStop stopset);
+
+/*
+ Token := Literal DefineToken
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void Token (pge_SetOfStop stopset);
+
+/*
+ ErrorProcedures := Literal
+ % ErrorProcArray := LastLiteral %
+ Literal
+ % ErrorProcString := LastLiteral %
+
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void ErrorProcedures (pge_SetOfStop stopset);
+
+/*
+ TokenProcedure := Literal
+ % TokenTypeProc := LastLiteral %
+
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void TokenProcedure (pge_SetOfStop stopset);
+
+/*
+ SymProcedure := Literal
+ % SymIsProc := LastLiteral %
+
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void SymProcedure (pge_SetOfStop stopset);
+
+/*
+ Production := Statement
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Production (pge_SetOfStop stopset);
+
+/*
+ Expression :=
+ % VAR t1, t2: TermDesc ;
+ e : ExpressionDesc ; %
+
+ % e := CurrentExpression ;
+ t1 := NewTerm() ;
+ CurrentTerm := t1 ; %
+ Term
+ % e^.term := t1 ; %
+ { '|'
+ % t2 := NewTerm() ;
+ CurrentTerm := t2 %
+ Term
+ % t1^.next := t2 ;
+ t1 := t2 %
+ }
+
+ first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok
+
+ cannot reachend
+*/
+
+static void Expression (pge_SetOfStop stopset);
+
+/*
+ Term :=
+ % VAR t1: TermDesc ; f1, f2: FactorDesc ; %
+
+ % CurrentFactor := NewFactor() ;
+ f1 := CurrentFactor ;
+ t1 := CurrentTerm ; %
+ Factor
+ % t1^.factor := f1 ;
+ f2 := NewFactor() ;
+ CurrentFactor := f2 %
+ { Factor
+ % f1^.next := f2 ;
+ f1 := f2 ;
+ f2 := NewFactor() ;
+ CurrentFactor := f2 ; %
+ }
+
+ first symbols:squotetok, dquotetok, codetok, identtok, lcparatok, lsparatok, lparatok
+
+ cannot reachend
+*/
+
+static void Term (pge_SetOfStop stopset);
+
+/*
+ GetDefinitionName - returns the name of the rule inside, p.
+*/
+
+static NameKey_Name GetDefinitionName (pge_ProductionDesc p);
+
+/*
+ FindDefinition - searches and returns the rule which defines, n.
+*/
+
+static pge_ProductionDesc FindDefinition (NameKey_Name n);
+
+/*
+ BackPatchIdent - found an ident, i, we must look for the corresponding rule and
+ set the definition accordingly.
+*/
+
+static void BackPatchIdent (pge_IdentDesc i);
+
+/*
+ BackPatchFactor - runs through the factor looking for an ident
+*/
+
+static void BackPatchFactor (pge_FactorDesc f);
+
+/*
+ BackPatchTerm - runs through all terms to find idents.
+*/
+
+static void BackPatchTerm (pge_TermDesc t);
+
+/*
+ BackPatchExpression - runs through the term to find any idents.
+*/
+
+static void BackPatchExpression (pge_ExpressionDesc e);
+
+/*
+ BackPatchSet -
+*/
+
+static void BackPatchSet (pge_SetDesc s);
+
+/*
+ BackPatchIdentToDefinitions - search through all the rules and add a link from any ident
+ to the definition.
+*/
+
+static void BackPatchIdentToDefinitions (pge_ProductionDesc d);
+
+/*
+ CalculateFirstAndFollow -
+*/
+
+static void CalculateFirstAndFollow (pge_ProductionDesc p);
+
+/*
+ ForeachRuleDo -
+*/
+
+static void ForeachRuleDo (pge_DoProcedure p);
+
+/*
+ WhileNotCompleteDo -
+*/
+
+static void WhileNotCompleteDo (pge_DoProcedure p);
+
+/*
+ NewLine - generate a newline and indent.
+*/
+
+static void NewLine (unsigned int Left);
+
+/*
+ CheckNewLine -
+*/
+
+static void CheckNewLine (unsigned int Left);
+
+/*
+ IndentString - writes out a string with a preceeding indent.
+*/
+
+static void IndentString (const char *a_, unsigned int _a_high);
+
+/*
+ KeyWord - writes out a keywork with optional formatting directives.
+*/
+
+static void KeyWord (NameKey_Name n);
+
+/*
+ PrettyPara -
+*/
+
+static void PrettyPara (const char *c1_, unsigned int _c1_high, const char *c2_, unsigned int _c2_high, pge_ExpressionDesc e, unsigned int Left);
+
+/*
+ WriteKeyTexinfo -
+*/
+
+static void WriteKeyTexinfo (NameKey_Name s);
+
+/*
+ PrettyCommentFactor -
+*/
+
+static void PrettyCommentFactor (pge_FactorDesc f, unsigned int Left);
+
+/*
+ PeepTerm - returns the length of characters in term.
+*/
+
+static unsigned int PeepTerm (pge_TermDesc t);
+
+/*
+ PeepExpression - returns the length of the expression.
+*/
+
+static unsigned int PeepExpression (pge_ExpressionDesc e);
+
+/*
+ PeepFactor - returns the length of character in the factor
+*/
+
+static unsigned int PeepFactor (pge_FactorDesc f);
+
+/*
+ PrettyCommentTerm -
+*/
+
+static void PrettyCommentTerm (pge_TermDesc t, unsigned int Left);
+
+/*
+ PrettyCommentExpression -
+*/
+
+static void PrettyCommentExpression (pge_ExpressionDesc e, unsigned int Left);
+
+/*
+ PrettyCommentStatement -
+*/
+
+static void PrettyCommentStatement (pge_StatementDesc s, unsigned int Left);
+
+/*
+ PrettyCommentProduction - generates the comment for rule, p.
+*/
+
+static void PrettyCommentProduction (pge_ProductionDesc p);
+
+/*
+ PrettyPrintProduction - pretty prints the ebnf rule, p.
+*/
+
+static void PrettyPrintProduction (pge_ProductionDesc p);
+
+/*
+ EmitFileLineTag - emits a line and file tag using the C preprocessor syntax.
+*/
+
+static void EmitFileLineTag (unsigned int line);
+
+/*
+ EmitRule - generates a comment and code for rule, p.
+*/
+
+static void EmitRule (pge_ProductionDesc p);
+
+/*
+ CodeCondition -
+*/
+
+static void CodeCondition (pge_m2condition m);
+
+/*
+ CodeThenDo - codes a "THEN" or "DO" depending upon, m.
+*/
+
+static void CodeThenDo (pge_m2condition m);
+
+/*
+ CodeElseEnd - builds an ELSE END statement using string, end.
+*/
+
+static void CodeElseEnd (const char *end_, unsigned int _end_high, unsigned int consumed, pge_FactorDesc f, unsigned int inopt);
+
+/*
+ CodeEnd - codes a "END" depending upon, m.
+*/
+
+static void CodeEnd (pge_m2condition m, pge_TermDesc t, unsigned int consumed, pge_FactorDesc f, unsigned int inopt);
+
+/*
+ EmitNonVarCode - writes out, code, providing it is not a variable declaration.
+*/
+
+static void EmitNonVarCode (pge_CodeDesc code, unsigned int curpos, unsigned int left);
+
+/*
+ ChainOn -
+*/
+
+static pge_FactorDesc ChainOn (pge_FactorDesc codeStack, pge_FactorDesc f);
+
+/*
+ FlushCode -
+*/
+
+static void FlushCode (pge_FactorDesc *codeStack);
+
+/*
+ CodeFactor -
+*/
+
+static void CodeFactor (pge_FactorDesc f, pge_TermDesc t, pge_m2condition l, pge_m2condition n, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack);
+
+/*
+ CodeTerm -
+*/
+
+static void CodeTerm (pge_TermDesc t, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack);
+
+/*
+ CodeExpression -
+*/
+
+static void CodeExpression (pge_ExpressionDesc e, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack);
+
+/*
+ CodeStatement -
+*/
+
+static void CodeStatement (pge_StatementDesc s, pge_m2condition m);
+
+/*
+ CodeProduction - only encode grammer rules which are not special.
+*/
+
+static void CodeProduction (pge_ProductionDesc p);
+
+/*
+ RecoverCondition -
+*/
+
+static void RecoverCondition (pge_m2condition m);
+
+/*
+ ConditionIndent - returns the number of spaces indentation created via, m.
+*/
+
+static unsigned int ConditionIndent (pge_m2condition m);
+
+/*
+ WriteGetTokenType - writes out the method of determining the token type.
+*/
+
+static void WriteGetTokenType (void);
+
+/*
+ NumberOfElements - returns the number of elements in set, to, which lie between low..high
+*/
+
+static unsigned int NumberOfElements (pge_SetDesc to, unsigned int low, unsigned int high);
+
+/*
+ WriteElement - writes the literal name for element, e.
+*/
+
+static void WriteElement (unsigned int e);
+
+/*
+ EmitIsInSet - writes out the equivalent of GetTokenType() IN { toset }
+*/
+
+static void EmitIsInSet (pge_SetDesc to, NameKey_Name low, NameKey_Name high);
+
+/*
+ EmitIsInSubSet - writes out a test to see whether GetTokenype() is in { subset }
+*/
+
+static void EmitIsInSubSet (pge_SetDesc to, unsigned int low, unsigned int high);
+
+/*
+ EmitIsInFirst -
+*/
+
+static void EmitIsInFirst (pge_SetDesc to, pge_m2condition m);
+static void FlushRecoverCode (pge_FactorDesc *codeStack);
+
+/*
+ RecoverFactor -
+*/
+
+static void RecoverFactor (pge_FactorDesc f, pge_m2condition m, pge_FactorDesc codeStack);
+
+/*
+ OptExpSeen - returns TRUE if we can see an optional expression in the factor.
+ This is not the same as epsilon. Example { '+' } matches epsilon as
+ well as { '+' | '-' } but OptExpSeen returns TRUE in the second case
+ and FALSE in the first.
+*/
+
+static unsigned int OptExpSeen (pge_FactorDesc f);
+
+/*
+ RecoverTerm -
+*/
+
+static void RecoverTerm (pge_TermDesc t, pge_m2condition new_, pge_m2condition old);
+
+/*
+ RecoverExpression -
+*/
+
+static void RecoverExpression (pge_ExpressionDesc e, pge_m2condition new_, pge_m2condition old);
+
+/*
+ RecoverStatement -
+*/
+
+static void RecoverStatement (pge_StatementDesc s, pge_m2condition m);
+
+/*
+ EmitFirstFactor - generate a list of all first tokens between the range: low..high.
+*/
+
+static void EmitFirstFactor (pge_FactorDesc f, unsigned int low, unsigned int high);
+
+/*
+ EmitUsed -
+*/
+
+static void EmitUsed (unsigned int wordno);
+
+/*
+ EmitStopParameters - generate the stop set.
+*/
+
+static void EmitStopParameters (unsigned int FormalParameters);
+
+/*
+ IsBetween - returns TRUE if the value of the token, string, is
+ in the range: low..high
+*/
+
+static unsigned int IsBetween (NameKey_Name string, unsigned int low, unsigned int high);
+
+/*
+ IsEmptySet - returns TRUE if no elements exist in set, to, with values, low..high.
+*/
+
+static unsigned int IsEmptySet (pge_SetDesc to, unsigned int low, unsigned int high);
+
+/*
+ EmitSet - emits the tokens in the set, to, which have values low..high
+*/
+
+static void EmitSet (pge_SetDesc to, unsigned int low, unsigned int high);
+
+/*
+ EmitSetName - emits the tokens in the set, to, which have values low..high, using
+ their names.
+*/
+
+static void EmitSetName (pge_SetDesc to, unsigned int low, unsigned int high);
+
+/*
+ EmitStopParametersAndSet - generates the stop parameters together with a set
+ inclusion of all the symbols in set, to.
+*/
+
+static void EmitStopParametersAndSet (pge_SetDesc to);
+
+/*
+ EmitSetAsParameters - generates the first symbols as parameters to a set function.
+*/
+
+static void EmitSetAsParameters (pge_SetDesc to);
+
+/*
+ EmitStopParametersAndFollow - generates the stop parameters together with a set
+ inclusion of all the follow symbols for subsequent
+ sentances.
+*/
+
+static void EmitStopParametersAndFollow (pge_FactorDesc f, pge_m2condition m);
+
+/*
+ EmitFirstAsParameters -
+*/
+
+static void EmitFirstAsParameters (pge_FactorDesc f);
+
+/*
+ RecoverProduction - only encode grammer rules which are not special.
+ Generate error recovery code.
+*/
+
+static void RecoverProduction (pge_ProductionDesc p);
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch);
+
+/*
+ FindStr - returns TRUE if, str, was seen inside the code hunk
+*/
+
+static unsigned int FindStr (pge_CodeHunk *code, unsigned int *i, const char *str_, unsigned int _str_high);
+
+/*
+ WriteUpto -
+*/
+
+static void WriteUpto (pge_CodeHunk code, pge_CodeHunk upto, unsigned int limit);
+
+/*
+ CheckForVar - checks for any local variables which need to be emitted during
+ this production.
+*/
+
+static void CheckForVar (pge_CodeHunk code);
+
+/*
+ VarFactor -
+*/
+
+static void VarFactor (pge_FactorDesc f);
+
+/*
+ VarTerm -
+*/
+
+static void VarTerm (pge_TermDesc t);
+
+/*
+ VarExpression -
+*/
+
+static void VarExpression (pge_ExpressionDesc e);
+
+/*
+ VarStatement -
+*/
+
+static void VarStatement (pge_StatementDesc s);
+
+/*
+ VarProduction - writes out all variable declarations.
+*/
+
+static void VarProduction (pge_ProductionDesc p);
+
+/*
+ In - returns TRUE if token, s, is already in the set, to.
+*/
+
+static unsigned int In (pge_SetDesc to, NameKey_Name s);
+
+/*
+ IntersectionIsNil - given two set lists, s1, s2, return TRUE if the
+ s1 * s2 = {}
+*/
+
+static unsigned int IntersectionIsNil (pge_SetDesc s1, pge_SetDesc s2);
+
+/*
+ AddSet - adds a first symbol to a production.
+*/
+
+static void AddSet (pge_SetDesc *to, NameKey_Name s);
+
+/*
+ OrSet -
+*/
+
+static void OrSet (pge_SetDesc *to, pge_SetDesc from);
+
+/*
+ CalcFirstFactor -
+*/
+
+static void CalcFirstFactor (pge_FactorDesc f, pge_ProductionDesc from, pge_SetDesc *to);
+
+/*
+ CalcFirstTerm -
+*/
+
+static void CalcFirstTerm (pge_TermDesc t, pge_ProductionDesc from, pge_SetDesc *to);
+
+/*
+ CalcFirstExpression -
+*/
+
+static void CalcFirstExpression (pge_ExpressionDesc e, pge_ProductionDesc from, pge_SetDesc *to);
+
+/*
+ CalcFirstStatement -
+*/
+
+static void CalcFirstStatement (pge_StatementDesc s, pge_ProductionDesc from, pge_SetDesc *to);
+
+/*
+ CalcFirstProduction - calculates all of the first symbols for the grammer
+*/
+
+static void CalcFirstProduction (pge_ProductionDesc p, pge_ProductionDesc from, pge_SetDesc *to);
+static void WorkOutFollowFactor (pge_FactorDesc f, pge_SetDesc *followset, pge_SetDesc after);
+
+/*
+ WorkOutFollowTerm -
+*/
+
+static void WorkOutFollowTerm (pge_TermDesc t, pge_SetDesc *followset, pge_SetDesc after);
+
+/*
+ WorkOutFollowExpression -
+*/
+
+static void WorkOutFollowExpression (pge_ExpressionDesc e, pge_SetDesc *followset, pge_SetDesc after);
+
+/*
+ CollectFollow - collects the follow set from, f, into, to.
+*/
+
+static void CollectFollow (pge_SetDesc *to, pge_FollowDesc f);
+
+/*
+ CalcFollowFactor -
+*/
+
+static void CalcFollowFactor (pge_FactorDesc f, pge_SetDesc after);
+
+/*
+ CalcFollowTerm -
+*/
+
+static void CalcFollowTerm (pge_TermDesc t, pge_SetDesc after);
+
+/*
+ CalcFollowExpression -
+*/
+
+static void CalcFollowExpression (pge_ExpressionDesc e, pge_SetDesc after);
+
+/*
+ CalcFollowStatement - given a bnf statement generate the follow set.
+*/
+
+static void CalcFollowStatement (pge_StatementDesc s);
+
+/*
+ CalcFollowProduction -
+*/
+
+static void CalcFollowProduction (pge_ProductionDesc p);
+
+/*
+ CalcEpsilonFactor -
+*/
+
+static void CalcEpsilonFactor (pge_FactorDesc f);
+
+/*
+ CalcEpsilonTerm -
+*/
+
+static void CalcEpsilonTerm (pge_TermDesc t);
+
+/*
+ CalcEpsilonExpression -
+*/
+
+static void CalcEpsilonExpression (pge_ExpressionDesc e);
+
+/*
+ CalcEpsilonStatement - given a bnf statement generate the follow set.
+*/
+
+static void CalcEpsilonStatement (pge_StatementDesc s);
+
+/*
+ CalcEpsilonProduction -
+*/
+
+static void CalcEpsilonProduction (pge_ProductionDesc p);
+
+/*
+ CalcReachEndFactor -
+*/
+
+static pge_TraverseResult CalcReachEndFactor (pge_FactorDesc f);
+
+/*
+ CalcReachEndTerm -
+*/
+
+static pge_TraverseResult CalcReachEndTerm (pge_TermDesc t);
+
+/*
+ CalcReachEndExpression -
+*/
+
+static void CalcReachEndExpression (pge_ExpressionDesc e);
+
+/*
+ CalcReachEndStatement -
+*/
+
+static void CalcReachEndStatement (pge_StatementDesc s);
+
+/*
+ CalcReachEndStatement -
+*/
+
+static void stop (void);
+
+/*
+ CalcReachEndProduction -
+*/
+
+static void CalcReachEndProduction (pge_ProductionDesc p);
+
+/*
+ EmptyFactor -
+*/
+
+static unsigned int EmptyFactor (pge_FactorDesc f);
+
+/*
+ EmptyTerm - returns TRUE if the term maybe empty.
+*/
+
+static unsigned int EmptyTerm (pge_TermDesc t);
+
+/*
+ EmptyExpression -
+*/
+
+static unsigned int EmptyExpression (pge_ExpressionDesc e);
+
+/*
+ EmptyStatement - returns TRUE if statement, s, is empty.
+*/
+
+static unsigned int EmptyStatement (pge_StatementDesc s);
+
+/*
+ EmptyProduction - returns if production, p, maybe empty.
+*/
+
+static unsigned int EmptyProduction (pge_ProductionDesc p);
+
+/*
+ EmitFDLNotice -
+*/
+
+static void EmitFDLNotice (void);
+
+/*
+ EmitRules - generates the BNF rules.
+*/
+
+static void EmitRules (void);
+
+/*
+ DescribeElement -
+*/
+
+static void DescribeElement (unsigned int name);
+
+/*
+ EmitInTestStop - construct a test for stop element, name.
+*/
+
+static void EmitInTestStop (NameKey_Name name);
+
+/*
+ DescribeStopElement -
+*/
+
+static void DescribeStopElement (unsigned int name);
+
+/*
+ EmitDescribeStop -
+*/
+
+static void EmitDescribeStop (void);
+
+/*
+ EmitDescribeError -
+*/
+
+static void EmitDescribeError (void);
+
+/*
+ EmitSetTypes - write out the set types used during error recovery
+*/
+
+static void EmitSetTypes (void);
+
+/*
+ EmitSupport - generates the support routines.
+*/
+
+static void EmitSupport (void);
+
+/*
+ DisposeSetDesc - dispose of the set list, s.
+*/
+
+static void DisposeSetDesc (pge_SetDesc *s);
+
+/*
+ OptionalFactor -
+*/
+
+static unsigned int OptionalFactor (pge_FactorDesc f);
+
+/*
+ OptionalTerm - returns TRUE if the term maybe empty.
+*/
+
+static unsigned int OptionalTerm (pge_TermDesc t);
+
+/*
+ OptionalExpression -
+*/
+
+static unsigned int OptionalExpression (pge_ExpressionDesc e);
+
+/*
+ OptionalStatement - returns FALSE if statement, s, does not have a optional ambiguity.
+*/
+
+static unsigned int OptionalStatement (pge_StatementDesc s);
+
+/*
+ OptionalProduction -
+*/
+
+static unsigned int OptionalProduction (pge_ProductionDesc p);
+
+/*
+ CheckFirstFollow -
+*/
+
+static unsigned int CheckFirstFollow (pge_FactorDesc f, pge_FactorDesc after);
+
+/*
+ ConstrainedEmptyFactor -
+*/
+
+static unsigned int ConstrainedEmptyFactor (pge_FactorDesc f);
+
+/*
+ ConstrainedEmptyTerm - returns TRUE if the term maybe empty.
+*/
+
+static unsigned int ConstrainedEmptyTerm (pge_TermDesc t);
+
+/*
+ ConstrainedEmptyExpression -
+*/
+
+static unsigned int ConstrainedEmptyExpression (pge_ExpressionDesc e);
+
+/*
+ ConstrainedEmptyStatement - returns FALSE if statement, s, does not have a optional ambiguity.
+*/
+
+static unsigned int ConstrainedEmptyStatement (pge_StatementDesc s);
+
+/*
+ ConstrainedEmptyProduction - returns TRUE if a problem exists with, p.
+*/
+
+static unsigned int ConstrainedEmptyProduction (pge_ProductionDesc p);
+
+/*
+ TestForLALR1 -
+*/
+
+static void TestForLALR1 (pge_ProductionDesc p);
+
+/*
+ DoEpsilon - runs the epsilon interrelated rules
+*/
+
+static void DoEpsilon (pge_ProductionDesc p);
+
+/*
+ CheckComplete - checks that production, p, is complete.
+*/
+
+static void CheckComplete (pge_ProductionDesc p);
+
+/*
+ PostProcessRules - backpatch the ident to rule definitions and emit comments and code.
+*/
+
+static void PostProcessRules (void);
+
+/*
+ DisplayHelp - display a summary help and then exit (0).
+*/
+
+static void DisplayHelp (void);
+
+/*
+ ParseArgs -
+*/
+
+static void ParseArgs (void);
+
+/*
+ Init - initialize the modules data structures
+*/
+
+static void Init (void);
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (pge_SetOfStop stopset);
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void);
+
+/*
+ AddEntry - adds an entry into, t, containing [def:value].
+*/
+
+static void AddEntry (SymbolKey_SymbolTree *t, NameKey_Name def, NameKey_Name value);
+
+/*
+ Format1 - converts string, src, into, dest, together with encapsulated
+ entity, n. It only formats the first %s or %d with n.
+*/
+
+static void Format1 (const char *src_, unsigned int _src_high, unsigned int n, char *dest, unsigned int _dest_high);
+
+/*
+ WarnError1 -
+*/
+
+static void WarnError1 (const char *a_, unsigned int _a_high, unsigned int n);
+
+/*
+ PrettyFollow -
+*/
+
+static void PrettyFollow (const char *start_, unsigned int _start_high, const char *end_, unsigned int _end_high, pge_FollowDesc f);
+
+/*
+ NewFollow - creates a new follow descriptor and returns the data structure.
+*/
+
+static pge_FollowDesc NewFollow (void);
+
+/*
+ AssignEpsilon - assigns the epsilon value and sets the epsilon to value,
+ providing condition is TRUE.
+*/
+
+static void AssignEpsilon (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value);
+
+/*
+ GetEpsilon - returns the value of epsilon
+*/
+
+static pge_TraverseResult GetEpsilon (pge_FollowDesc f);
+
+/*
+ AssignReachEnd - assigns the reachend value providing that, condition, is TRUE.
+*/
+
+static void AssignReachEnd (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value);
+
+/*
+ GetReachEnd - returns the value of reachend
+*/
+
+static pge_TraverseResult GetReachEnd (pge_FollowDesc f);
+
+/*
+ AssignFollow - assigns the follow set and sets the calcfollow to TRUE.
+*/
+
+static void AssignFollow (pge_FollowDesc f, pge_SetDesc s);
+
+/*
+ GetFollow - returns the follow set.
+*/
+
+static pge_SetDesc GetFollow (pge_FollowDesc f);
+
+/*
+ NewProduction - creates a new production and returns the data structure.
+*/
+
+static pge_ProductionDesc NewProduction (void);
+
+/*
+ NewFactor -
+*/
+
+static pge_FactorDesc NewFactor (void);
+
+/*
+ NewTerm - returns a new term.
+*/
+
+static pge_TermDesc NewTerm (void);
+
+/*
+ NewExpression - returns a new expression.
+*/
+
+static pge_ExpressionDesc NewExpression (void);
+
+/*
+ NewStatement - returns a new statement.
+*/
+
+static pge_StatementDesc NewStatement (void);
+
+/*
+ NewSetDesc - creates a new set description and returns the data structure.
+*/
+
+static pge_SetDesc NewSetDesc (void);
+
+/*
+ NewCodeDesc - creates a new code descriptor and initializes all fields to zero.
+*/
+
+static pge_CodeDesc NewCodeDesc (void);
+
+/*
+ CodeFragmentPrologue - consumes code text up to a "%" after a newline.
+*/
+
+static void CodeFragmentPrologue (void);
+
+/*
+ CodeFragmentEpilogue - consumes code text up to a "%" after a newline.
+*/
+
+static void CodeFragmentEpilogue (void);
+
+/*
+ CodeFragmentDeclaration - consumes code text up to a "%" after a newline.
+*/
+
+static void CodeFragmentDeclaration (void);
+
+/*
+ GetCodeFragment - collects the code fragment up until ^ %
+*/
+
+static void GetCodeFragment (pge_CodeHunk *h);
+
+/*
+ WriteCodeHunkList - writes the CodeHunk list in the correct order.
+*/
+
+static void WriteCodeHunkList (pge_CodeHunk l);
+
+/*
+ WriteIndent - writes, n, spaces.
+*/
+
+static void WriteIndent (unsigned int n);
+
+/*
+ CheckWrite -
+*/
+
+static void CheckWrite (char ch, unsigned int *curpos, unsigned int left, unsigned int *seentext);
+
+/*
+ WriteStringIndent - writes a string but it will try and remove upto indent spaces
+ if they exist.
+*/
+
+static void WriteStringIndent (const char *a_, unsigned int _a_high, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext);
+
+/*
+ WriteCodeHunkListIndent - writes the CodeHunk list in the correct order
+ but it removes up to indent spaces if they exist.
+*/
+
+static void WriteCodeHunkListIndent (pge_CodeHunk l, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext);
+
+/*
+ Add - adds a character to a code hunk and creates another code hunk if necessary.
+*/
+
+static pge_CodeHunk Add (pge_CodeHunk *p, char ch, unsigned int *i);
+
+/*
+ ConsHunk - combine two possible code hunks.
+*/
+
+static void ConsHunk (pge_CodeHunk *p, pge_CodeHunk q);
+
+/*
+ GetName - returns the next symbol which is checked for a legal name.
+*/
+
+static NameKey_Name GetName (void);
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (pge_SetOfStop stop);
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (pge_SetOfStop stop);
+
+/*
+ Expect -
+*/
+
+static void Expect (bnflex_TokenType t, pge_SetOfStop stop);
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (pge_SetOfStop stop);
+
+/*
+ Modula2Code - error checking varient of Modula2Code
+*/
+
+static void Modula2Code (pge_SetOfStop stop);
+
+/*
+ StartModName := % ModuleName := GetName() ; ignore begintok CodeFragmentPrologue % =:
+*/
+
+static void StartModName (pge_SetOfStop stop);
+
+/*
+ EndModName :=
+*/
+
+static void EndModName (pge_SetOfStop stop);
+
+/*
+ DoDeclaration := % CodeFragmentDeclaration % =:
+*/
+
+static void DoDeclaration (pge_SetOfStop stop);
+
+/*
+ CollectLiteral :=
+ % LastLiteral := GetCurrentToken() ;
+ AdvanceToken ; %
+
+
+ first symbols:literaltok
+
+ cannot reachend
+*/
+
+static void CollectLiteral (pge_SetOfStop stopset);
+
+/*
+ CollectTok :=
+ % CurrentSetDesc := NewSetDesc() ;
+ WITH CurrentSetDesc^ DO
+ type := tokel ;
+ string := GetCurrentToken() ;
+ END ;
+ IF NOT ContainsSymKey(Values, GetCurrentToken())
+ THEN
+ AddEntry(Values, GetCurrentToken(), LargestValue) ;
+ AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ;
+ AddEntry(Aliases, GetCurrentToken(), GetCurrentToken()) ;
+ AddEntry(ReverseAliases, GetCurrentToken(), GetCurrentToken()) ;
+ INC(LargestValue)
+ END ;
+ AdvanceToken() ; %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void CollectTok (pge_SetOfStop stopset);
+
+/*
+ DefineToken :=
+ % AddEntry(Aliases, LastLiteral, GetCurrentToken()) ;
+ AddEntry(ReverseAliases, GetCurrentToken(), LastLiteral) ;
+ AddEntry(Values, GetCurrentToken(), LargestValue) ;
+ AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ;
+ INC(LargestValue) ;
+ AdvanceToken ; %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefineToken (pge_SetOfStop stopset);
+
+/*
+ Rules := '%' 'rules' { Defs } ExtBNF
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Rules (pge_SetOfStop stopset);
+
+/*
+ Special := Ident
+ % VAR p: ProductionDesc ; %
+
+ % p := NewProduction() ;
+ p^.statement := NewStatement() ;
+ p^.statement^.followinfo^.calcfollow := TRUE ;
+ p^.statement^.followinfo^.epsilon := false ;
+ p^.statement^.followinfo^.reachend := false ;
+ p^.statement^.ident := CurrentIdent ;
+ p^.statement^.expr := NIL ;
+ p^.firstsolved := TRUE ;
+ p^.followinfo^.calcfollow := TRUE ;
+ p^.followinfo^.epsilon := false ;
+ p^.followinfo^.reachend := false %
+ First Follow [ 'epsilon'
+ % p^.statement^.followinfo^.epsilon := true ; these are not used - but they are displayed when debugging
+ p^.statement^.followinfo^.reachend := true ;
+ p^.followinfo^.epsilon := true ;
+ p^.followinfo^.reachend := true
+ %
+ ] [ Literal
+ % p^.description := LastLiteral %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Special (pge_SetOfStop stopset);
+
+/*
+ Factor := '%' Modula2Code '%' |
+ Ident
+ % WITH CurrentFactor^ DO
+ type := id ;
+ ident := CurrentIdent
+ END ; %
+ | Literal
+ % WITH CurrentFactor^ DO
+ type := lit ;
+ string := LastLiteral ;
+ IF GetSymKey(Aliases, LastLiteral)=NulName
+ THEN
+ WarnError1('no token defined for literal %s', LastLiteral)
+ END
+ END ; %
+ | '{'
+ % WITH CurrentFactor^ DO
+ type := mult ;
+ expr := NewExpression() ;
+ CurrentExpression := expr ;
+ END ; %
+ Expression '}' | '['
+ % WITH CurrentFactor^ DO
+ type := opt ;
+ expr := NewExpression() ;
+ CurrentExpression := expr ;
+ END ; %
+ Expression ']' | '('
+ % WITH CurrentFactor^ DO
+ type := sub ;
+ expr := NewExpression() ;
+ CurrentExpression := expr ;
+ END ; %
+ Expression ')'
+
+ first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok
+
+ cannot reachend
+*/
+
+static void Factor (pge_SetOfStop stopset);
+
+/*
+ Statement :=
+ % VAR i: IdentDesc ; %
+ Ident
+ % VAR p: ProductionDesc ; %
+
+ % p := FindDefinition(CurrentIdent^.name) ;
+ IF p=NIL
+ THEN
+ p := NewProduction()
+ ELSE
+ IF NOT ((p^.statement=NIL) OR (p^.statement^.expr=NIL))
+ THEN
+ WarnError1('already declared rule %s', CurrentIdent^.name)
+ END
+ END ;
+ i := CurrentIdent ; %
+ ':='
+ % VAR e: ExpressionDesc ; %
+
+ % e := NewExpression() ;
+ CurrentExpression := e ; %
+
+ % VAR s: StatementDesc ; %
+
+ % s := NewStatement() ;
+ WITH s^ DO
+ ident := i ;
+ expr := e
+ END ; %
+ Expression
+ % p^.statement := s ; %
+ '=:'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Statement (pge_SetOfStop stopset);
+
+/*
+ Defs := 'special' Special | 'token' Token |
+ 'error' ErrorProcedures |
+ 'tokenfunc' TokenProcedure |
+ 'symfunc' SymProcedure
+
+ first symbols:symfunctok, tfunctok, errortok, tokentok, specialtok
+
+ cannot reachend
+*/
+
+static void Defs (pge_SetOfStop stopset);
+
+/*
+ ExtBNF := 'BNF' { Production } 'FNB'
+
+ first symbols:BNFtok
+
+ cannot reachend
+*/
+
+static void ExtBNF (pge_SetOfStop stopset);
+
+/*
+ Main := Header Decls Footer Rules
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Main (pge_SetOfStop stopset);
+
+/*
+ Header := '%' 'module' StartModName
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Header (pge_SetOfStop stopset);
+
+/*
+ Decls := '%' 'declaration' DoDeclaration
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Decls (pge_SetOfStop stopset);
+
+/*
+ Footer := '%' 'module' EndModName
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Footer (pge_SetOfStop stopset);
+
+/*
+ First := 'first' '{' { LitOrTokenOrIdent
+ % WITH CurrentSetDesc^ DO
+ next := TailProduction^.first ;
+ END ;
+ TailProduction^.first := CurrentSetDesc
+ %
+ } '}'
+
+ first symbols:firsttok
+
+ cannot reachend
+*/
+
+static void First (pge_SetOfStop stopset);
+
+/*
+ Follow := 'follow' '{' { LitOrTokenOrIdent
+ % WITH CurrentSetDesc^ DO
+ next := TailProduction^.followinfo^.follow ;
+ END ;
+ TailProduction^.followinfo^.follow := CurrentSetDesc
+ %
+ } '}'
+
+ first symbols:followtok
+
+ cannot reachend
+*/
+
+static void Follow (pge_SetOfStop stopset);
+
+/*
+ LitOrTokenOrIdent := Literal
+ % CurrentSetDesc := NewSetDesc() ;
+ WITH CurrentSetDesc^ DO
+ type := litel ;
+ string := LastLiteral ;
+ END ;
+ %
+ | '<' CollectTok '>' |
+ Ident
+ % CurrentSetDesc := NewSetDesc() ;
+ WITH CurrentSetDesc^ DO
+ type := idel ;
+ ident := CurrentIdent ;
+ END ;
+ %
+
+
+ first symbols:dquotetok, squotetok, identtok, lesstok
+
+ cannot reachend
+*/
+
+static void LitOrTokenOrIdent (pge_SetOfStop stopset);
+
+/*
+ Literal := '"' CollectLiteral '"' |
+ "'" CollectLiteral "'"
+
+ first symbols:squotetok, dquotetok
+
+ cannot reachend
+*/
+
+static void Literal (pge_SetOfStop stopset);
+
+/*
+ Token := Literal DefineToken
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void Token (pge_SetOfStop stopset);
+
+/*
+ ErrorProcedures := Literal
+ % ErrorProcArray := LastLiteral %
+ Literal
+ % ErrorProcString := LastLiteral %
+
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void ErrorProcedures (pge_SetOfStop stopset);
+
+/*
+ TokenProcedure := Literal
+ % TokenTypeProc := LastLiteral %
+
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void TokenProcedure (pge_SetOfStop stopset);
+
+/*
+ SymProcedure := Literal
+ % SymIsProc := LastLiteral %
+
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void SymProcedure (pge_SetOfStop stopset);
+
+/*
+ Production := Statement
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Production (pge_SetOfStop stopset);
+
+/*
+ Expression :=
+ % VAR t1, t2: TermDesc ;
+ e : ExpressionDesc ; %
+
+ % e := CurrentExpression ;
+ t1 := NewTerm() ;
+ CurrentTerm := t1 ; %
+ Term
+ % e^.term := t1 ; %
+ { '|'
+ % t2 := NewTerm() ;
+ CurrentTerm := t2 %
+ Term
+ % t1^.next := t2 ;
+ t1 := t2 %
+ }
+
+ first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok
+
+ cannot reachend
+*/
+
+static void Expression (pge_SetOfStop stopset);
+
+/*
+ Term :=
+ % VAR t1: TermDesc ; f1, f2: FactorDesc ; %
+
+ % CurrentFactor := NewFactor() ;
+ f1 := CurrentFactor ;
+ t1 := CurrentTerm ; %
+ Factor
+ % t1^.factor := f1 ;
+ f2 := NewFactor() ;
+ CurrentFactor := f2 %
+ { Factor
+ % f1^.next := f2 ;
+ f1 := f2 ;
+ f2 := NewFactor() ;
+ CurrentFactor := f2 ; %
+ }
+
+ first symbols:squotetok, dquotetok, codetok, identtok, lcparatok, lsparatok, lparatok
+
+ cannot reachend
+*/
+
+static void Term (pge_SetOfStop stopset);
+
+/*
+ GetDefinitionName - returns the name of the rule inside, p.
+*/
+
+static NameKey_Name GetDefinitionName (pge_ProductionDesc p);
+
+/*
+ FindDefinition - searches and returns the rule which defines, n.
+*/
+
+static pge_ProductionDesc FindDefinition (NameKey_Name n);
+
+/*
+ BackPatchIdent - found an ident, i, we must look for the corresponding rule and
+ set the definition accordingly.
+*/
+
+static void BackPatchIdent (pge_IdentDesc i);
+
+/*
+ BackPatchFactor - runs through the factor looking for an ident
+*/
+
+static void BackPatchFactor (pge_FactorDesc f);
+
+/*
+ BackPatchTerm - runs through all terms to find idents.
+*/
+
+static void BackPatchTerm (pge_TermDesc t);
+
+/*
+ BackPatchExpression - runs through the term to find any idents.
+*/
+
+static void BackPatchExpression (pge_ExpressionDesc e);
+
+/*
+ BackPatchSet -
+*/
+
+static void BackPatchSet (pge_SetDesc s);
+
+/*
+ BackPatchIdentToDefinitions - search through all the rules and add a link from any ident
+ to the definition.
+*/
+
+static void BackPatchIdentToDefinitions (pge_ProductionDesc d);
+
+/*
+ CalculateFirstAndFollow -
+*/
+
+static void CalculateFirstAndFollow (pge_ProductionDesc p);
+
+/*
+ ForeachRuleDo -
+*/
+
+static void ForeachRuleDo (pge_DoProcedure p);
+
+/*
+ WhileNotCompleteDo -
+*/
+
+static void WhileNotCompleteDo (pge_DoProcedure p);
+
+/*
+ NewLine - generate a newline and indent.
+*/
+
+static void NewLine (unsigned int Left);
+
+/*
+ CheckNewLine -
+*/
+
+static void CheckNewLine (unsigned int Left);
+
+/*
+ IndentString - writes out a string with a preceeding indent.
+*/
+
+static void IndentString (const char *a_, unsigned int _a_high);
+
+/*
+ KeyWord - writes out a keywork with optional formatting directives.
+*/
+
+static void KeyWord (NameKey_Name n);
+
+/*
+ PrettyPara -
+*/
+
+static void PrettyPara (const char *c1_, unsigned int _c1_high, const char *c2_, unsigned int _c2_high, pge_ExpressionDesc e, unsigned int Left);
+
+/*
+ WriteKeyTexinfo -
+*/
+
+static void WriteKeyTexinfo (NameKey_Name s);
+
+/*
+ PrettyCommentFactor -
+*/
+
+static void PrettyCommentFactor (pge_FactorDesc f, unsigned int Left);
+
+/*
+ PeepTerm - returns the length of characters in term.
+*/
+
+static unsigned int PeepTerm (pge_TermDesc t);
+
+/*
+ PeepExpression - returns the length of the expression.
+*/
+
+static unsigned int PeepExpression (pge_ExpressionDesc e);
+
+/*
+ PeepFactor - returns the length of character in the factor
+*/
+
+static unsigned int PeepFactor (pge_FactorDesc f);
+
+/*
+ PrettyCommentTerm -
+*/
+
+static void PrettyCommentTerm (pge_TermDesc t, unsigned int Left);
+
+/*
+ PrettyCommentExpression -
+*/
+
+static void PrettyCommentExpression (pge_ExpressionDesc e, unsigned int Left);
+
+/*
+ PrettyCommentStatement -
+*/
+
+static void PrettyCommentStatement (pge_StatementDesc s, unsigned int Left);
+
+/*
+ PrettyCommentProduction - generates the comment for rule, p.
+*/
+
+static void PrettyCommentProduction (pge_ProductionDesc p);
+
+/*
+ PrettyPrintProduction - pretty prints the ebnf rule, p.
+*/
+
+static void PrettyPrintProduction (pge_ProductionDesc p);
+
+/*
+ EmitFileLineTag - emits a line and file tag using the C preprocessor syntax.
+*/
+
+static void EmitFileLineTag (unsigned int line);
+
+/*
+ EmitRule - generates a comment and code for rule, p.
+*/
+
+static void EmitRule (pge_ProductionDesc p);
+
+/*
+ CodeCondition -
+*/
+
+static void CodeCondition (pge_m2condition m);
+
+/*
+ CodeThenDo - codes a "THEN" or "DO" depending upon, m.
+*/
+
+static void CodeThenDo (pge_m2condition m);
+
+/*
+ CodeElseEnd - builds an ELSE END statement using string, end.
+*/
+
+static void CodeElseEnd (const char *end_, unsigned int _end_high, unsigned int consumed, pge_FactorDesc f, unsigned int inopt);
+
+/*
+ CodeEnd - codes a "END" depending upon, m.
+*/
+
+static void CodeEnd (pge_m2condition m, pge_TermDesc t, unsigned int consumed, pge_FactorDesc f, unsigned int inopt);
+
+/*
+ EmitNonVarCode - writes out, code, providing it is not a variable declaration.
+*/
+
+static void EmitNonVarCode (pge_CodeDesc code, unsigned int curpos, unsigned int left);
+
+/*
+ ChainOn -
+*/
+
+static pge_FactorDesc ChainOn (pge_FactorDesc codeStack, pge_FactorDesc f);
+
+/*
+ FlushCode -
+*/
+
+static void FlushCode (pge_FactorDesc *codeStack);
+
+/*
+ CodeFactor -
+*/
+
+static void CodeFactor (pge_FactorDesc f, pge_TermDesc t, pge_m2condition l, pge_m2condition n, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack);
+
+/*
+ CodeTerm -
+*/
+
+static void CodeTerm (pge_TermDesc t, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack);
+
+/*
+ CodeExpression -
+*/
+
+static void CodeExpression (pge_ExpressionDesc e, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack);
+
+/*
+ CodeStatement -
+*/
+
+static void CodeStatement (pge_StatementDesc s, pge_m2condition m);
+
+/*
+ CodeProduction - only encode grammer rules which are not special.
+*/
+
+static void CodeProduction (pge_ProductionDesc p);
+
+/*
+ RecoverCondition -
+*/
+
+static void RecoverCondition (pge_m2condition m);
+
+/*
+ ConditionIndent - returns the number of spaces indentation created via, m.
+*/
+
+static unsigned int ConditionIndent (pge_m2condition m);
+
+/*
+ WriteGetTokenType - writes out the method of determining the token type.
+*/
+
+static void WriteGetTokenType (void);
+
+/*
+ NumberOfElements - returns the number of elements in set, to, which lie between low..high
+*/
+
+static unsigned int NumberOfElements (pge_SetDesc to, unsigned int low, unsigned int high);
+
+/*
+ WriteElement - writes the literal name for element, e.
+*/
+
+static void WriteElement (unsigned int e);
+
+/*
+ EmitIsInSet - writes out the equivalent of GetTokenType() IN { toset }
+*/
+
+static void EmitIsInSet (pge_SetDesc to, NameKey_Name low, NameKey_Name high);
+
+/*
+ EmitIsInSubSet - writes out a test to see whether GetTokenype() is in { subset }
+*/
+
+static void EmitIsInSubSet (pge_SetDesc to, unsigned int low, unsigned int high);
+
+/*
+ EmitIsInFirst -
+*/
+
+static void EmitIsInFirst (pge_SetDesc to, pge_m2condition m);
+static void FlushRecoverCode (pge_FactorDesc *codeStack);
+
+/*
+ RecoverFactor -
+*/
+
+static void RecoverFactor (pge_FactorDesc f, pge_m2condition m, pge_FactorDesc codeStack);
+
+/*
+ OptExpSeen - returns TRUE if we can see an optional expression in the factor.
+ This is not the same as epsilon. Example { '+' } matches epsilon as
+ well as { '+' | '-' } but OptExpSeen returns TRUE in the second case
+ and FALSE in the first.
+*/
+
+static unsigned int OptExpSeen (pge_FactorDesc f);
+
+/*
+ RecoverTerm -
+*/
+
+static void RecoverTerm (pge_TermDesc t, pge_m2condition new_, pge_m2condition old);
+
+/*
+ RecoverExpression -
+*/
+
+static void RecoverExpression (pge_ExpressionDesc e, pge_m2condition new_, pge_m2condition old);
+
+/*
+ RecoverStatement -
+*/
+
+static void RecoverStatement (pge_StatementDesc s, pge_m2condition m);
+
+/*
+ EmitFirstFactor - generate a list of all first tokens between the range: low..high.
+*/
+
+static void EmitFirstFactor (pge_FactorDesc f, unsigned int low, unsigned int high);
+
+/*
+ EmitUsed -
+*/
+
+static void EmitUsed (unsigned int wordno);
+
+/*
+ EmitStopParameters - generate the stop set.
+*/
+
+static void EmitStopParameters (unsigned int FormalParameters);
+
+/*
+ IsBetween - returns TRUE if the value of the token, string, is
+ in the range: low..high
+*/
+
+static unsigned int IsBetween (NameKey_Name string, unsigned int low, unsigned int high);
+
+/*
+ IsEmptySet - returns TRUE if no elements exist in set, to, with values, low..high.
+*/
+
+static unsigned int IsEmptySet (pge_SetDesc to, unsigned int low, unsigned int high);
+
+/*
+ EmitSet - emits the tokens in the set, to, which have values low..high
+*/
+
+static void EmitSet (pge_SetDesc to, unsigned int low, unsigned int high);
+
+/*
+ EmitSetName - emits the tokens in the set, to, which have values low..high, using
+ their names.
+*/
+
+static void EmitSetName (pge_SetDesc to, unsigned int low, unsigned int high);
+
+/*
+ EmitStopParametersAndSet - generates the stop parameters together with a set
+ inclusion of all the symbols in set, to.
+*/
+
+static void EmitStopParametersAndSet (pge_SetDesc to);
+
+/*
+ EmitSetAsParameters - generates the first symbols as parameters to a set function.
+*/
+
+static void EmitSetAsParameters (pge_SetDesc to);
+
+/*
+ EmitStopParametersAndFollow - generates the stop parameters together with a set
+ inclusion of all the follow symbols for subsequent
+ sentances.
+*/
+
+static void EmitStopParametersAndFollow (pge_FactorDesc f, pge_m2condition m);
+
+/*
+ EmitFirstAsParameters -
+*/
+
+static void EmitFirstAsParameters (pge_FactorDesc f);
+
+/*
+ RecoverProduction - only encode grammer rules which are not special.
+ Generate error recovery code.
+*/
+
+static void RecoverProduction (pge_ProductionDesc p);
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch);
+
+/*
+ FindStr - returns TRUE if, str, was seen inside the code hunk
+*/
+
+static unsigned int FindStr (pge_CodeHunk *code, unsigned int *i, const char *str_, unsigned int _str_high);
+
+/*
+ WriteUpto -
+*/
+
+static void WriteUpto (pge_CodeHunk code, pge_CodeHunk upto, unsigned int limit);
+
+/*
+ CheckForVar - checks for any local variables which need to be emitted during
+ this production.
+*/
+
+static void CheckForVar (pge_CodeHunk code);
+
+/*
+ VarFactor -
+*/
+
+static void VarFactor (pge_FactorDesc f);
+
+/*
+ VarTerm -
+*/
+
+static void VarTerm (pge_TermDesc t);
+
+/*
+ VarExpression -
+*/
+
+static void VarExpression (pge_ExpressionDesc e);
+
+/*
+ VarStatement -
+*/
+
+static void VarStatement (pge_StatementDesc s);
+
+/*
+ VarProduction - writes out all variable declarations.
+*/
+
+static void VarProduction (pge_ProductionDesc p);
+
+/*
+ In - returns TRUE if token, s, is already in the set, to.
+*/
+
+static unsigned int In (pge_SetDesc to, NameKey_Name s);
+
+/*
+ IntersectionIsNil - given two set lists, s1, s2, return TRUE if the
+ s1 * s2 = {}
+*/
+
+static unsigned int IntersectionIsNil (pge_SetDesc s1, pge_SetDesc s2);
+
+/*
+ AddSet - adds a first symbol to a production.
+*/
+
+static void AddSet (pge_SetDesc *to, NameKey_Name s);
+
+/*
+ OrSet -
+*/
+
+static void OrSet (pge_SetDesc *to, pge_SetDesc from);
+
+/*
+ CalcFirstFactor -
+*/
+
+static void CalcFirstFactor (pge_FactorDesc f, pge_ProductionDesc from, pge_SetDesc *to);
+
+/*
+ CalcFirstTerm -
+*/
+
+static void CalcFirstTerm (pge_TermDesc t, pge_ProductionDesc from, pge_SetDesc *to);
+
+/*
+ CalcFirstExpression -
+*/
+
+static void CalcFirstExpression (pge_ExpressionDesc e, pge_ProductionDesc from, pge_SetDesc *to);
+
+/*
+ CalcFirstStatement -
+*/
+
+static void CalcFirstStatement (pge_StatementDesc s, pge_ProductionDesc from, pge_SetDesc *to);
+
+/*
+ CalcFirstProduction - calculates all of the first symbols for the grammer
+*/
+
+static void CalcFirstProduction (pge_ProductionDesc p, pge_ProductionDesc from, pge_SetDesc *to);
+static void WorkOutFollowFactor (pge_FactorDesc f, pge_SetDesc *followset, pge_SetDesc after);
+
+/*
+ WorkOutFollowTerm -
+*/
+
+static void WorkOutFollowTerm (pge_TermDesc t, pge_SetDesc *followset, pge_SetDesc after);
+
+/*
+ WorkOutFollowExpression -
+*/
+
+static void WorkOutFollowExpression (pge_ExpressionDesc e, pge_SetDesc *followset, pge_SetDesc after);
+
+/*
+ CollectFollow - collects the follow set from, f, into, to.
+*/
+
+static void CollectFollow (pge_SetDesc *to, pge_FollowDesc f);
+
+/*
+ CalcFollowFactor -
+*/
+
+static void CalcFollowFactor (pge_FactorDesc f, pge_SetDesc after);
+
+/*
+ CalcFollowTerm -
+*/
+
+static void CalcFollowTerm (pge_TermDesc t, pge_SetDesc after);
+
+/*
+ CalcFollowExpression -
+*/
+
+static void CalcFollowExpression (pge_ExpressionDesc e, pge_SetDesc after);
+
+/*
+ CalcFollowStatement - given a bnf statement generate the follow set.
+*/
+
+static void CalcFollowStatement (pge_StatementDesc s);
+
+/*
+ CalcFollowProduction -
+*/
+
+static void CalcFollowProduction (pge_ProductionDesc p);
+
+/*
+ CalcEpsilonFactor -
+*/
+
+static void CalcEpsilonFactor (pge_FactorDesc f);
+
+/*
+ CalcEpsilonTerm -
+*/
+
+static void CalcEpsilonTerm (pge_TermDesc t);
+
+/*
+ CalcEpsilonExpression -
+*/
+
+static void CalcEpsilonExpression (pge_ExpressionDesc e);
+
+/*
+ CalcEpsilonStatement - given a bnf statement generate the follow set.
+*/
+
+static void CalcEpsilonStatement (pge_StatementDesc s);
+
+/*
+ CalcEpsilonProduction -
+*/
+
+static void CalcEpsilonProduction (pge_ProductionDesc p);
+
+/*
+ CalcReachEndFactor -
+*/
+
+static pge_TraverseResult CalcReachEndFactor (pge_FactorDesc f);
+
+/*
+ CalcReachEndTerm -
+*/
+
+static pge_TraverseResult CalcReachEndTerm (pge_TermDesc t);
+
+/*
+ CalcReachEndExpression -
+*/
+
+static void CalcReachEndExpression (pge_ExpressionDesc e);
+
+/*
+ CalcReachEndStatement -
+*/
+
+static void CalcReachEndStatement (pge_StatementDesc s);
+
+/*
+ CalcReachEndStatement -
+*/
+
+static void stop (void);
+
+/*
+ CalcReachEndProduction -
+*/
+
+static void CalcReachEndProduction (pge_ProductionDesc p);
+
+/*
+ EmptyFactor -
+*/
+
+static unsigned int EmptyFactor (pge_FactorDesc f);
+
+/*
+ EmptyTerm - returns TRUE if the term maybe empty.
+*/
+
+static unsigned int EmptyTerm (pge_TermDesc t);
+
+/*
+ EmptyExpression -
+*/
+
+static unsigned int EmptyExpression (pge_ExpressionDesc e);
+
+/*
+ EmptyStatement - returns TRUE if statement, s, is empty.
+*/
+
+static unsigned int EmptyStatement (pge_StatementDesc s);
+
+/*
+ EmptyProduction - returns if production, p, maybe empty.
+*/
+
+static unsigned int EmptyProduction (pge_ProductionDesc p);
+
+/*
+ EmitFDLNotice -
+*/
+
+static void EmitFDLNotice (void);
+
+/*
+ EmitRules - generates the BNF rules.
+*/
+
+static void EmitRules (void);
+
+/*
+ DescribeElement -
+*/
+
+static void DescribeElement (unsigned int name);
+
+/*
+ EmitInTestStop - construct a test for stop element, name.
+*/
+
+static void EmitInTestStop (NameKey_Name name);
+
+/*
+ DescribeStopElement -
+*/
+
+static void DescribeStopElement (unsigned int name);
+
+/*
+ EmitDescribeStop -
+*/
+
+static void EmitDescribeStop (void);
+
+/*
+ EmitDescribeError -
+*/
+
+static void EmitDescribeError (void);
+
+/*
+ EmitSetTypes - write out the set types used during error recovery
+*/
+
+static void EmitSetTypes (void);
+
+/*
+ EmitSupport - generates the support routines.
+*/
+
+static void EmitSupport (void);
+
+/*
+ DisposeSetDesc - dispose of the set list, s.
+*/
+
+static void DisposeSetDesc (pge_SetDesc *s);
+
+/*
+ OptionalFactor -
+*/
+
+static unsigned int OptionalFactor (pge_FactorDesc f);
+
+/*
+ OptionalTerm - returns TRUE if the term maybe empty.
+*/
+
+static unsigned int OptionalTerm (pge_TermDesc t);
+
+/*
+ OptionalExpression -
+*/
+
+static unsigned int OptionalExpression (pge_ExpressionDesc e);
+
+/*
+ OptionalStatement - returns FALSE if statement, s, does not have a optional ambiguity.
+*/
+
+static unsigned int OptionalStatement (pge_StatementDesc s);
+
+/*
+ OptionalProduction -
+*/
+
+static unsigned int OptionalProduction (pge_ProductionDesc p);
+
+/*
+ CheckFirstFollow -
+*/
+
+static unsigned int CheckFirstFollow (pge_FactorDesc f, pge_FactorDesc after);
+
+/*
+ ConstrainedEmptyFactor -
+*/
+
+static unsigned int ConstrainedEmptyFactor (pge_FactorDesc f);
+
+/*
+ ConstrainedEmptyTerm - returns TRUE if the term maybe empty.
+*/
+
+static unsigned int ConstrainedEmptyTerm (pge_TermDesc t);
+
+/*
+ ConstrainedEmptyExpression -
+*/
+
+static unsigned int ConstrainedEmptyExpression (pge_ExpressionDesc e);
+
+/*
+ ConstrainedEmptyStatement - returns FALSE if statement, s, does not have a optional ambiguity.
+*/
+
+static unsigned int ConstrainedEmptyStatement (pge_StatementDesc s);
+
+/*
+ ConstrainedEmptyProduction - returns TRUE if a problem exists with, p.
+*/
+
+static unsigned int ConstrainedEmptyProduction (pge_ProductionDesc p);
+
+/*
+ TestForLALR1 -
+*/
+
+static void TestForLALR1 (pge_ProductionDesc p);
+
+/*
+ DoEpsilon - runs the epsilon interrelated rules
+*/
+
+static void DoEpsilon (pge_ProductionDesc p);
+
+/*
+ CheckComplete - checks that production, p, is complete.
+*/
+
+static void CheckComplete (pge_ProductionDesc p);
+
+/*
+ PostProcessRules - backpatch the ident to rule definitions and emit comments and code.
+*/
+
+static void PostProcessRules (void);
+
+/*
+ DisplayHelp - display a summary help and then exit (0).
+*/
+
+static void DisplayHelp (void);
+
+/*
+ ParseArgs -
+*/
+
+static void ParseArgs (void);
+
+/*
+ Init - initialize the modules data structures
+*/
+
+static void Init (void);
+
+
+/*
+ DescribeStop - issues a message explaining what tokens were expected
+*/
+
+static DynamicStrings_String DescribeStop (pge_SetOfStop stopset)
+{
+ unsigned int n;
+ DynamicStrings_String str;
+ DynamicStrings_String message;
+
+ n = 0;
+ message = DynamicStrings_InitString ((const char *) "", 0);
+ if ((((1 << (bnflex_literaltok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "literal", 7)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_identtok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "identifier", 10)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_FNBtok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "FNB", 3)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_BNFtok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "BNF", 3)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_epsilontok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "epsilon", 7)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_followtok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "follow", 6)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_firsttok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "first", 5)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_specialtok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "special", 7)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_tokentok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "token", 5)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_declarationtok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "declaration", 11)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_endtok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "end", 3)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_rulestok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "rules", 5)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_begintok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "begin", 5)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_moduletok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "module", 6)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_dquotetok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '`'), '"'), '\''), ',');
+ n += 1;
+ }
+ if ((((1 << (bnflex_squotetok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (message, ' '), '"'), '\''), '"'), ',');
+ n += 1;
+ }
+ if ((((1 << (bnflex_symfunctok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "symfunc", 7)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_tfunctok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "tokenfunc", 9)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_errortok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "error", 5)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_gretok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ">", 1)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_lesstok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "<", 1)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_rparatok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ")", 1)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_lparatok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "(", 1)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_rcparatok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "}", 1)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_lcparatok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "{", 1)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_rsparatok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "]", 1)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_lsparatok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "[", 1)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_bartok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "|", 1)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_rbecomestok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "=:", 2)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_lbecomestok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ":=", 2)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_codetok-bnflex_identtok)) & (stopset)) != 0))
+ {
+ message = DynamicStrings_ConCat (DynamicStrings_ConCatChar (message, ' '), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "%", 1)));
+ n += 1;
+ }
+ if ((((1 << (bnflex_eoftok-bnflex_identtok)) & (stopset)) != 0))
+ {} /* empty. */
+ /* eoftok has no token name (needed to generate error messages) */
+ if (n == 0)
+ {
+ str = DynamicStrings_InitString ((const char *) " syntax error", 13);
+ message = DynamicStrings_KillString (message);
+ }
+ else if (n == 1)
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (message, DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " missing ", 9)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) " expecting one of", 17), message);
+ message = DynamicStrings_KillString (message);
+ }
+ return str;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DescribeError - issues a message explaining what tokens were expected
+*/
+
+static void DescribeError (void)
+{
+ DynamicStrings_String str;
+
+ str = DynamicStrings_InitString ((const char *) "", 0);
+ switch (bnflex_GetCurrentTokenType ())
+ {
+ case bnflex_literaltok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found literal", 27), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_identtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found identifier", 30), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_FNBtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found FNB", 23), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_BNFtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found BNF", 23), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_epsilontok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found epsilon", 27), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_followtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found follow", 26), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_firsttok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found first", 25), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_specialtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found special", 27), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_tokentok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found token", 25), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_declarationtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found declaration", 31), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_endtok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found end", 23), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_rulestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found rules", 25), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_begintok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found begin", 25), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_moduletok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found module", 26), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_dquotetok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found '", 21), '"'), '\''), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_squotetok:
+ str = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "syntax error, found \"", 21), '\''), '"'), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_symfunctok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found symfunc", 27), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_tfunctok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found tokenfunc", 29), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_errortok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found error", 25), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_gretok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found >", 21), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_lesstok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found <", 21), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_rparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found )", 21), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_lparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found (", 21), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_rcparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found }", 21), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_lcparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found {", 21), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_rsparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ]", 21), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_lsparatok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found [", 21), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_bartok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found |", 21), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_rbecomestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found =:", 22), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_lbecomestok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found :=", 22), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_codetok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found %", 21), DynamicStrings_Mark (str));
+ break;
+
+ case bnflex_eoftok:
+ str = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "syntax error, found ", 20), DynamicStrings_Mark (str));
+ break;
+
+
+ default:
+ break;
+ }
+ PushBackInput_WarnString (str);
+}
+
+
+/*
+ AddEntry - adds an entry into, t, containing [def:value].
+*/
+
+static void AddEntry (SymbolKey_SymbolTree *t, NameKey_Name def, NameKey_Name value)
+{
+ if (SymbolKey_ContainsSymKey ((*t), def))
+ {
+ WarnError1 ((const char *) "already seen a definition for token '%s'", 40, def);
+ }
+ else
+ {
+ SymbolKey_PutSymKey ((*t), def, value);
+ }
+}
+
+
+/*
+ Format1 - converts string, src, into, dest, together with encapsulated
+ entity, n. It only formats the first %s or %d with n.
+*/
+
+static void Format1 (const char *src_, unsigned int _src_high, unsigned int n, char *dest, unsigned int _dest_high)
+{
+ typedef struct Format1__T12_a Format1__T12;
+
+ struct Format1__T12_a { char array[MaxString+1]; };
+ unsigned int HighSrc;
+ unsigned int HighDest;
+ unsigned int i;
+ unsigned int j;
+ Format1__T12 str;
+ char src[_src_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (src, src_, _src_high+1);
+
+ HighSrc = StrLib_StrLen ((const char *) src, _src_high);
+ HighDest = _dest_high;
+ i = 0;
+ j = 0;
+ while ((((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest)) && (src[i] != '%'))
+ {
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ if ((((i+1) < HighSrc) && (src[i] == '%')) && (j < HighDest))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (src[i+1] == 's')
+ {
+ dest[j] = ASCII_nul;
+ NameKey_GetKey (n, (char *) &str.array[0], MaxString);
+ StrLib_StrConCat ((const char *) dest, _dest_high, (const char *) &str.array[0], MaxString, (char *) dest, _dest_high);
+ j = StrLib_StrLen ((const char *) dest, _dest_high);
+ i += 2;
+ }
+ else if (src[i+1] == 'd')
+ {
+ /* avoid dangling else. */
+ dest[j] = ASCII_nul;
+ NumberIO_CardToStr (n, 0, (char *) &str.array[0], MaxString);
+ StrLib_StrConCat ((const char *) dest, _dest_high, (const char *) &str.array[0], MaxString, (char *) dest, _dest_high);
+ j = StrLib_StrLen ((const char *) dest, _dest_high);
+ i += 2;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ }
+ /* and finish off copying src into dest */
+ while (((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest))
+ {
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ if (j < HighDest)
+ {
+ dest[j] = ASCII_nul;
+ }
+}
+
+
+/*
+ WarnError1 -
+*/
+
+static void WarnError1 (const char *a_, unsigned int _a_high, unsigned int n)
+{
+ typedef struct WarnError1__T13_a WarnError1__T13;
+
+ struct WarnError1__T13_a { char array[MaxString+1]; };
+ WarnError1__T13 line;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ Format1 ((const char *) a, _a_high, n, (char *) &line.array[0], MaxString);
+ PushBackInput_WarnError ((const char *) &line.array[0], MaxString);
+}
+
+
+/*
+ PrettyFollow -
+*/
+
+static void PrettyFollow (const char *start_, unsigned int _start_high, const char *end_, unsigned int _end_high, pge_FollowDesc f)
+{
+ char start[_start_high+1];
+ char end[_end_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (start, start_, _start_high+1);
+ memcpy (end, end_, _end_high+1);
+
+ if (Debugging)
+ {
+ Output_WriteString ((const char *) start, _start_high);
+ if (f != NULL)
+ {
+ if (f->calcfollow)
+ {
+ Output_WriteString ((const char *) "followset defined as:", 21);
+ EmitSet (f->follow, static_cast<unsigned int> (0), static_cast<unsigned int> (0));
+ }
+ switch (f->reachend)
+ {
+ case pge_true:
+ Output_WriteString ((const char *) " [E]", 4);
+ break;
+
+ case pge_false:
+ Output_WriteString ((const char *) " [C]", 4);
+ break;
+
+ case pge_unknown:
+ Output_WriteString ((const char *) " [U]", 4);
+ break;
+
+
+ default:
+ break;
+ }
+ switch (f->epsilon)
+ {
+ case pge_true:
+ Output_WriteString ((const char *) " [e]", 4);
+ break;
+
+ case pge_false:
+ break;
+
+ case pge_unknown:
+ Output_WriteString ((const char *) " [u]", 4);
+ break;
+
+
+ default:
+ break;
+ }
+ }
+ Output_WriteString ((const char *) end, _end_high);
+ }
+}
+
+
+/*
+ NewFollow - creates a new follow descriptor and returns the data structure.
+*/
+
+static pge_FollowDesc NewFollow (void)
+{
+ pge_FollowDesc f;
+
+ Storage_ALLOCATE ((void **) &f, sizeof (pge__T6));
+ f->follow = NULL;
+ f->reachend = pge_unknown;
+ f->epsilon = pge_unknown;
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AssignEpsilon - assigns the epsilon value and sets the epsilon to value,
+ providing condition is TRUE.
+*/
+
+static void AssignEpsilon (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value)
+{
+ if ((condition && (value != pge_unknown)) && (f->epsilon == pge_unknown))
+ {
+ f->epsilon = value;
+ Finished = FALSE;
+ }
+}
+
+
+/*
+ GetEpsilon - returns the value of epsilon
+*/
+
+static pge_TraverseResult GetEpsilon (pge_FollowDesc f)
+{
+ if (f == NULL)
+ {
+ Debug_Halt ((const char *) "why is the follow info NIL?", 27, 596, (const char *) "m2/gm2-auto/pge.mod", 19);
+ }
+ else
+ {
+ return f->epsilon;
+ }
+ ReturnException ("m2/gm2-auto/pge.mod", 1, 7);
+ __builtin_unreachable ();
+}
+
+
+/*
+ AssignReachEnd - assigns the reachend value providing that, condition, is TRUE.
+*/
+
+static void AssignReachEnd (unsigned int condition, pge_FollowDesc f, pge_TraverseResult value)
+{
+ if (condition)
+ {
+ if ((f->reachend == pge_unknown) && (value != pge_unknown))
+ {
+ f->reachend = value;
+ Finished = FALSE;
+ }
+ }
+}
+
+
+/*
+ GetReachEnd - returns the value of reachend
+*/
+
+static pge_TraverseResult GetReachEnd (pge_FollowDesc f)
+{
+ if (f == NULL)
+ {
+ Debug_Halt ((const char *) "why is the follow info NIL?", 27, 630, (const char *) "m2/gm2-auto/pge.mod", 19);
+ }
+ else
+ {
+ return f->reachend;
+ }
+ ReturnException ("m2/gm2-auto/pge.mod", 1, 7);
+ __builtin_unreachable ();
+}
+
+
+/*
+ AssignFollow - assigns the follow set and sets the calcfollow to TRUE.
+*/
+
+static void AssignFollow (pge_FollowDesc f, pge_SetDesc s)
+{
+ if (f->calcfollow)
+ {
+ Debug_Halt ((const char *) "why are we reassigning this follow set?", 39, 646, (const char *) "m2/gm2-auto/pge.mod", 19);
+ }
+ f->follow = s;
+ f->calcfollow = TRUE;
+}
+
+
+/*
+ GetFollow - returns the follow set.
+*/
+
+static pge_SetDesc GetFollow (pge_FollowDesc f)
+{
+ if (f == NULL)
+ {
+ Debug_Halt ((const char *) "why is the follow info NIL?", 27, 662, (const char *) "m2/gm2-auto/pge.mod", 19);
+ }
+ else
+ {
+ if (f->calcfollow)
+ {
+ return f->follow;
+ }
+ else
+ {
+ Debug_Halt ((const char *) "not calculated the follow set yet..", 35, 669, (const char *) "m2/gm2-auto/pge.mod", 19);
+ }
+ }
+ ReturnException ("m2/gm2-auto/pge.mod", 1, 7);
+ __builtin_unreachable ();
+}
+
+
+/*
+ NewProduction - creates a new production and returns the data structure.
+*/
+
+static pge_ProductionDesc NewProduction (void)
+{
+ pge_ProductionDesc p;
+
+ Storage_ALLOCATE ((void **) &p, sizeof (pge__T2));
+ if (TailProduction != NULL)
+ {
+ TailProduction->next = p;
+ }
+ TailProduction = p;
+ if (HeadProduction == NULL)
+ {
+ HeadProduction = p;
+ }
+ p->next = NULL;
+ p->statement = NULL;
+ p->first = NULL;
+ p->firstsolved = FALSE;
+ p->followinfo = NewFollow ();
+ p->line = PushBackInput_GetCurrentLine ();
+ p->description = NameKey_NulName;
+ return p;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ NewFactor -
+*/
+
+static pge_FactorDesc NewFactor (void)
+{
+ pge_FactorDesc f;
+
+ Storage_ALLOCATE ((void **) &f, sizeof (pge__T5));
+ f->next = NULL;
+ f->followinfo = NewFollow ();
+ f->line = PushBackInput_GetCurrentLine ();
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ NewTerm - returns a new term.
+*/
+
+static pge_TermDesc NewTerm (void)
+{
+ pge_TermDesc t;
+
+ Storage_ALLOCATE ((void **) &t, sizeof (pge_termdesc));
+ t->factor = NULL;
+ t->followinfo = NewFollow ();
+ t->next = NULL;
+ t->line = PushBackInput_GetCurrentLine ();
+ return t;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ NewExpression - returns a new expression.
+*/
+
+static pge_ExpressionDesc NewExpression (void)
+{
+ pge_ExpressionDesc e;
+
+ Storage_ALLOCATE ((void **) &e, sizeof (pge__T4));
+ e->term = NULL;
+ e->followinfo = NewFollow ();
+ e->line = PushBackInput_GetCurrentLine ();
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ NewStatement - returns a new statement.
+*/
+
+static pge_StatementDesc NewStatement (void)
+{
+ pge_StatementDesc s;
+
+ Storage_ALLOCATE ((void **) &s, sizeof (pge__T3));
+ s->ident = NULL;
+ s->expr = NULL;
+ s->followinfo = NewFollow ();
+ s->line = PushBackInput_GetCurrentLine ();
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ NewSetDesc - creates a new set description and returns the data structure.
+*/
+
+static pge_SetDesc NewSetDesc (void)
+{
+ pge_SetDesc s;
+
+ Storage_ALLOCATE ((void **) &s, sizeof (pge__T7));
+ s->next = NULL;
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ NewCodeDesc - creates a new code descriptor and initializes all fields to zero.
+*/
+
+static pge_CodeDesc NewCodeDesc (void)
+{
+ pge_CodeDesc c;
+
+ Storage_ALLOCATE ((void **) &c, sizeof (pge__T8));
+ c->code = NULL;
+ c->indent = 0;
+ c->line = PushBackInput_GetCurrentLine ();
+ return c;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CodeFragmentPrologue - consumes code text up to a "%" after a newline.
+*/
+
+static void CodeFragmentPrologue (void)
+{
+ LinePrologue = PushBackInput_GetCurrentLine ();
+ GetCodeFragment (&CodePrologue);
+}
+
+
+/*
+ CodeFragmentEpilogue - consumes code text up to a "%" after a newline.
+*/
+
+static void CodeFragmentEpilogue (void)
+{
+ LineEpilogue = PushBackInput_GetCurrentLine ();
+ GetCodeFragment (&CodeEpilogue);
+}
+
+
+/*
+ CodeFragmentDeclaration - consumes code text up to a "%" after a newline.
+*/
+
+static void CodeFragmentDeclaration (void)
+{
+ LineDeclaration = PushBackInput_GetCurrentLine ();
+ GetCodeFragment (&CodeDeclaration);
+}
+
+
+/*
+ GetCodeFragment - collects the code fragment up until ^ %
+*/
+
+static void GetCodeFragment (pge_CodeHunk *h)
+{
+ unsigned int i;
+ char ch;
+
+ (*h) = NULL;
+ i = 0;
+ while (((bnflex_PutChar (bnflex_GetChar ())) != '%') && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul))
+ {
+ do {
+ while (((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul) && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_lf))
+ {
+ (*h) = Add (h, bnflex_GetChar (), &i);
+ }
+ if ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_lf)
+ {
+ /* consume line feed */
+ (*h) = Add (h, bnflex_GetChar (), &i);
+ ch = bnflex_PutChar (ASCII_lf);
+ }
+ else if ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_nul)
+ {
+ /* avoid dangling else. */
+ ch = bnflex_PutChar (ASCII_nul);
+ ch = bnflex_PutChar (ASCII_lf);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ch = bnflex_PutChar (bnflex_PutChar (bnflex_GetChar ()));
+ }
+ } while (! ((bnflex_GetChar ()) == ASCII_lf));
+ }
+ if ((bnflex_PutChar (bnflex_GetChar ())) == '%')
+ {
+ (*h) = Add (h, ASCII_nul, &i);
+ ch = bnflex_PutChar (' '); /* to give the following token % a delimiter infront of it */
+ bnflex_AdvanceToken (); /* to give the following token % a delimiter infront of it */
+ }
+ else
+ {
+ PushBackInput_WarnError ((const char *) "expecting % to terminate code fragment, found end of file", 57);
+ }
+}
+
+
+/*
+ WriteCodeHunkList - writes the CodeHunk list in the correct order.
+*/
+
+static void WriteCodeHunkList (pge_CodeHunk l)
+{
+ if (l != NULL)
+ {
+ OnLineStart = FALSE;
+ /* recursion */
+ WriteCodeHunkList (l->next);
+ Output_WriteString ((const char *) &l->codetext.array[0], MaxCodeHunkLength);
+ }
+}
+
+
+/*
+ WriteIndent - writes, n, spaces.
+*/
+
+static void WriteIndent (unsigned int n)
+{
+ while (n > 0)
+ {
+ Output_Write (' ');
+ n -= 1;
+ }
+ OnLineStart = FALSE;
+}
+
+
+/*
+ CheckWrite -
+*/
+
+static void CheckWrite (char ch, unsigned int *curpos, unsigned int left, unsigned int *seentext)
+{
+ if (ch == ASCII_lf)
+ {
+ NewLine (left);
+ (*curpos) = 0;
+ (*seentext) = FALSE;
+ }
+ else
+ {
+ Output_Write (ch);
+ (*curpos) += 1;
+ }
+}
+
+
+/*
+ WriteStringIndent - writes a string but it will try and remove upto indent spaces
+ if they exist.
+*/
+
+static void WriteStringIndent (const char *a_, unsigned int _a_high, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext)
+{
+ unsigned int l;
+ unsigned int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = 0;
+ l = StrLib_StrLen ((const char *) a, _a_high);
+ while (i < l)
+ {
+ if ((*seentext))
+ {
+ CheckWrite (a[i], curpos, left, seentext);
+ }
+ else
+ {
+ if (a[i] == ' ')
+ {
+ /* ignore space for now */
+ (*curpos) += 1;
+ }
+ else
+ {
+ if ((*curpos) >= indent)
+ {
+ WriteIndent ((*curpos)-indent);
+ }
+ (*seentext) = TRUE;
+ CheckWrite (a[i], curpos, left, seentext);
+ }
+ }
+ i += 1;
+ }
+}
+
+
+/*
+ WriteCodeHunkListIndent - writes the CodeHunk list in the correct order
+ but it removes up to indent spaces if they exist.
+*/
+
+static void WriteCodeHunkListIndent (pge_CodeHunk l, unsigned int indent, unsigned int *curpos, unsigned int left, unsigned int *seentext)
+{
+ if (l != NULL)
+ {
+ /* recursion */
+ WriteCodeHunkListIndent (l->next, indent, curpos, left, seentext);
+ WriteStringIndent ((const char *) &l->codetext.array[0], MaxCodeHunkLength, indent, curpos, left, seentext);
+ }
+}
+
+
+/*
+ Add - adds a character to a code hunk and creates another code hunk if necessary.
+*/
+
+static pge_CodeHunk Add (pge_CodeHunk *p, char ch, unsigned int *i)
+{
+ pge_CodeHunk q;
+
+ if (((*p) == NULL) || ((*i) > MaxCodeHunkLength))
+ {
+ Storage_ALLOCATE ((void **) &q, sizeof (pge__T9));
+ q->next = (*p);
+ q->codetext.array[0] = ch;
+ (*i) = 1;
+ return q;
+ }
+ else
+ {
+ (*p)->codetext.array[(*i)] = ch;
+ (*i) += 1;
+ return (*p);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConsHunk - combine two possible code hunks.
+*/
+
+static void ConsHunk (pge_CodeHunk *p, pge_CodeHunk q)
+{
+ pge_CodeHunk r;
+
+ if ((*p) != NULL)
+ {
+ r = q;
+ while (r->next != NULL)
+ {
+ r = r->next;
+ }
+ r->next = (*p);
+ }
+ (*p) = q;
+}
+
+
+/*
+ GetName - returns the next symbol which is checked for a legal name.
+*/
+
+static NameKey_Name GetName (void)
+{
+ NameKey_Name name;
+
+ if (bnflex_IsReserved (bnflex_GetCurrentToken ()))
+ {
+ PushBackInput_WarnError ((const char *) "expecting a name and found a reserved word", 42);
+ bnflex_AdvanceToken (); /* move on to another token */
+ return NameKey_NulName; /* move on to another token */
+ }
+ else
+ {
+ name = bnflex_GetCurrentToken ();
+ bnflex_AdvanceToken ();
+ return name;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*/
+
+static void SyntaxError (pge_SetOfStop stop)
+{
+ DescribeError ();
+ if (Debugging)
+ {
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) "skipping token *** ", 19);
+ }
+ while (! ((((1 << (bnflex_GetCurrentTokenType ()-bnflex_identtok)) & (stop)) != 0)))
+ {
+ bnflex_AdvanceToken ();
+ }
+ if (Debugging)
+ {
+ StrIO_WriteString ((const char *) " ***", 4);
+ StrIO_WriteLn ();
+ }
+ WasNoError = FALSE;
+}
+
+
+/*
+ SyntaxCheck -
+*/
+
+static void SyntaxCheck (pge_SetOfStop stop)
+{
+ if (! ((((1 << (bnflex_GetCurrentTokenType ()-bnflex_identtok)) & (stop)) != 0)))
+ {
+ SyntaxError (stop);
+ }
+}
+
+
+/*
+ Expect -
+*/
+
+static void Expect (bnflex_TokenType t, pge_SetOfStop stop)
+{
+ if ((bnflex_GetCurrentTokenType ()) == t)
+ {
+ bnflex_AdvanceToken ();
+ }
+ else
+ {
+ SyntaxError (stop);
+ }
+ SyntaxCheck (stop);
+}
+
+
+/*
+ Ident - error checking varient of Ident
+*/
+
+static void Ident (pge_SetOfStop stop)
+{
+ if ((bnflex_GetCurrentTokenType ()) == bnflex_identtok)
+ {
+ Storage_ALLOCATE ((void **) &CurrentIdent, sizeof (pge__T1));
+ CurrentIdent->definition = NULL;
+ CurrentIdent->name = GetName ();
+ CurrentIdent->line = PushBackInput_GetCurrentLine ();
+ }
+}
+
+
+/*
+ Modula2Code - error checking varient of Modula2Code
+*/
+
+static void Modula2Code (pge_SetOfStop stop)
+{
+ pge_CodeHunk p;
+ unsigned int i;
+ unsigned int quote;
+ unsigned int line;
+ unsigned int position;
+
+ line = PushBackInput_GetCurrentLine ();
+ bnflex_PushBackToken (bnflex_GetCurrentToken ());
+ position = PushBackInput_GetColumnPosition ();
+ p = NULL;
+ bnflex_SkipWhite ();
+ while (((bnflex_PutChar (bnflex_GetChar ())) != '%') && ((bnflex_PutChar (bnflex_GetChar ())) != ASCII_nul))
+ {
+ if ((bnflex_PutChar (bnflex_GetChar ())) == '"')
+ {
+ /* avoid dangling else. */
+ do {
+ p = Add (&p, bnflex_GetChar (), &i);
+ } while (! (((bnflex_PutChar (bnflex_GetChar ())) == '"') || ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_nul)));
+ p = Add (&p, '"', &i);
+ if (((bnflex_PutChar (bnflex_GetChar ())) == '"') && ((bnflex_GetChar ()) == '"'))
+ {} /* empty. */
+ }
+ else if ((bnflex_PutChar (bnflex_GetChar ())) == '\'')
+ {
+ /* avoid dangling else. */
+ do {
+ p = Add (&p, bnflex_GetChar (), &i);
+ } while (! (((bnflex_PutChar (bnflex_GetChar ())) == '\'') || ((bnflex_PutChar (bnflex_GetChar ())) == ASCII_nul)));
+ p = Add (&p, '\'', &i);
+ if (((bnflex_PutChar (bnflex_GetChar ())) == '\'') && ((bnflex_GetChar ()) == '\''))
+ {} /* empty. */
+ }
+ else if (((bnflex_PutChar (bnflex_GetChar ())) == '\\') && ((bnflex_GetChar ()) == '\\'))
+ {
+ /* avoid dangling else. */
+ p = Add (&p, bnflex_GetChar (), &i);
+ }
+ else if ((bnflex_PutChar (bnflex_GetChar ())) != '%')
+ {
+ /* avoid dangling else. */
+ p = Add (&p, bnflex_GetChar (), &i);
+ }
+ }
+ p = Add (&p, ASCII_nul, &i);
+ CurrentFactor->type = pge_m2;
+ CurrentFactor->code = NewCodeDesc ();
+ CurrentFactor->code->code = p;
+ CurrentFactor->code->indent = position;
+ if ((bnflex_PutChar (' ')) == ' ')
+ {} /* empty. */
+ bnflex_AdvanceToken (); /* read the next token ready for the parser */
+ if (! WasNoError) /* read the next token ready for the parser */
+ {
+ WarnError1 ((const char *) "error probably occurred before the start of inline code on line %d", 66, line);
+ }
+}
+
+
+/*
+ StartModName := % ModuleName := GetName() ; ignore begintok CodeFragmentPrologue % =:
+*/
+
+static void StartModName (pge_SetOfStop stop)
+{
+ ModuleName = GetName ();
+ CodeFragmentPrologue ();
+}
+
+
+/*
+ EndModName :=
+*/
+
+static void EndModName (pge_SetOfStop stop)
+{
+ if (ModuleName != (GetName ()))
+ {
+ PushBackInput_WarnError ((const char *) "expecting same module name at end as beginning", 46);
+ }
+ /* ignore endtok as it consumes the token afterwards */
+ CodeFragmentEpilogue ();
+}
+
+
+/*
+ DoDeclaration := % CodeFragmentDeclaration % =:
+*/
+
+static void DoDeclaration (pge_SetOfStop stop)
+{
+ if (ModuleName != (GetName ()))
+ {
+ PushBackInput_WarnError ((const char *) "expecting same module name in declaration as in the beginning", 61);
+ }
+ /* ignore begintok as it consumes the token afterwards */
+ CodeFragmentDeclaration ();
+}
+
+
+/*
+ CollectLiteral :=
+ % LastLiteral := GetCurrentToken() ;
+ AdvanceToken ; %
+
+
+ first symbols:literaltok
+
+ cannot reachend
+*/
+
+static void CollectLiteral (pge_SetOfStop stopset)
+{
+ LastLiteral = bnflex_GetCurrentToken (); /* */
+ bnflex_AdvanceToken ();
+}
+
+
+/*
+ CollectTok :=
+ % CurrentSetDesc := NewSetDesc() ;
+ WITH CurrentSetDesc^ DO
+ type := tokel ;
+ string := GetCurrentToken() ;
+ END ;
+ IF NOT ContainsSymKey(Values, GetCurrentToken())
+ THEN
+ AddEntry(Values, GetCurrentToken(), LargestValue) ;
+ AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ;
+ AddEntry(Aliases, GetCurrentToken(), GetCurrentToken()) ;
+ AddEntry(ReverseAliases, GetCurrentToken(), GetCurrentToken()) ;
+ INC(LargestValue)
+ END ;
+ AdvanceToken() ; %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void CollectTok (pge_SetOfStop stopset)
+{
+ CurrentSetDesc = NewSetDesc (); /* */
+ CurrentSetDesc->type = pge_tokel;
+ CurrentSetDesc->string = bnflex_GetCurrentToken ();
+ if (! (SymbolKey_ContainsSymKey (Values, bnflex_GetCurrentToken ())))
+ {
+ AddEntry (&Values, bnflex_GetCurrentToken (), LargestValue);
+ AddEntry (&ReverseValues, (NameKey_Name) (LargestValue), bnflex_GetCurrentToken ());
+ AddEntry (&Aliases, bnflex_GetCurrentToken (), bnflex_GetCurrentToken ());
+ AddEntry (&ReverseAliases, bnflex_GetCurrentToken (), bnflex_GetCurrentToken ());
+ LargestValue += 1;
+ }
+ bnflex_AdvanceToken ();
+}
+
+
+/*
+ DefineToken :=
+ % AddEntry(Aliases, LastLiteral, GetCurrentToken()) ;
+ AddEntry(ReverseAliases, GetCurrentToken(), LastLiteral) ;
+ AddEntry(Values, GetCurrentToken(), LargestValue) ;
+ AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ;
+ INC(LargestValue) ;
+ AdvanceToken ; %
+
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void DefineToken (pge_SetOfStop stopset)
+{
+ AddEntry (&Aliases, LastLiteral, bnflex_GetCurrentToken ()); /* */
+ AddEntry (&ReverseAliases, bnflex_GetCurrentToken (), LastLiteral);
+ AddEntry (&Values, bnflex_GetCurrentToken (), LargestValue);
+ AddEntry (&ReverseValues, (NameKey_Name) (LargestValue), bnflex_GetCurrentToken ());
+ LargestValue += 1;
+ bnflex_AdvanceToken ();
+}
+
+
+/*
+ Rules := '%' 'rules' { Defs } ExtBNF
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Rules (pge_SetOfStop stopset)
+{
+ Expect (bnflex_codetok, stopset|(pge_SetOfStop) ((1 << (bnflex_rulestok-bnflex_identtok))));
+ Expect (bnflex_rulestok, stopset|(pge_SetOfStop) ((1 << (bnflex_symfunctok-bnflex_identtok)) | (1 << (bnflex_tfunctok-bnflex_identtok)) | (1 << (bnflex_errortok-bnflex_identtok)) | (1 << (bnflex_tokentok-bnflex_identtok)) | (1 << (bnflex_specialtok-bnflex_identtok)) | (1 << (bnflex_BNFtok-bnflex_identtok))));
+ while ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_specialtok)) | (1 << (bnflex_tokentok)) | (1 << (bnflex_errortok)) | (1 << (bnflex_tfunctok)) | (1 << (bnflex_symfunctok))))) != 0))
+ {
+ Defs (stopset|(pge_SetOfStop) ((1 << (bnflex_BNFtok-bnflex_identtok)) | (1 << (bnflex_specialtok-bnflex_identtok)) | (1 << (bnflex_tokentok-bnflex_identtok)) | (1 << (bnflex_errortok-bnflex_identtok)) | (1 << (bnflex_tfunctok-bnflex_identtok)) | (1 << (bnflex_symfunctok-bnflex_identtok))));
+ }
+ /* while */
+ ExtBNF (stopset);
+}
+
+
+/*
+ Special := Ident
+ % VAR p: ProductionDesc ; %
+
+ % p := NewProduction() ;
+ p^.statement := NewStatement() ;
+ p^.statement^.followinfo^.calcfollow := TRUE ;
+ p^.statement^.followinfo^.epsilon := false ;
+ p^.statement^.followinfo^.reachend := false ;
+ p^.statement^.ident := CurrentIdent ;
+ p^.statement^.expr := NIL ;
+ p^.firstsolved := TRUE ;
+ p^.followinfo^.calcfollow := TRUE ;
+ p^.followinfo^.epsilon := false ;
+ p^.followinfo^.reachend := false %
+ First Follow [ 'epsilon'
+ % p^.statement^.followinfo^.epsilon := true ; these are not used - but they are displayed when debugging
+ p^.statement^.followinfo^.reachend := true ;
+ p^.followinfo^.epsilon := true ;
+ p^.followinfo^.reachend := true
+ %
+ ] [ Literal
+ % p^.description := LastLiteral %
+ ]
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Special (pge_SetOfStop stopset)
+{
+ pge_ProductionDesc p;
+
+ Ident (stopset|(pge_SetOfStop) ((1 << (bnflex_firsttok-bnflex_identtok))));
+ p = NewProduction ();
+ p->statement = NewStatement ();
+ p->statement->followinfo->calcfollow = TRUE;
+ p->statement->followinfo->epsilon = pge_false;
+ p->statement->followinfo->reachend = pge_false;
+ p->statement->ident = CurrentIdent;
+ p->statement->expr = NULL;
+ p->firstsolved = TRUE;
+ p->followinfo->calcfollow = TRUE;
+ p->followinfo->epsilon = pge_false;
+ p->followinfo->reachend = pge_false;
+ First (stopset|(pge_SetOfStop) ((1 << (bnflex_followtok-bnflex_identtok))));
+ Follow (stopset|(pge_SetOfStop) ((1 << (bnflex_epsilontok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok))));
+ if ((bnflex_GetCurrentTokenType ()) == bnflex_epsilontok)
+ {
+ Expect (bnflex_epsilontok, stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ p->statement->followinfo->epsilon = pge_true; /* these are not used - but they are displayed when debugging */
+ p->statement->followinfo->reachend = pge_true; /* these are not used - but they are displayed when debugging */
+ p->followinfo->epsilon = pge_true;
+ p->followinfo->reachend = pge_true;
+ }
+ if ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_dquotetok)) | (1 << (bnflex_squotetok))))) != 0))
+ {
+ Literal (stopset);
+ p->description = LastLiteral;
+ }
+}
+
+
+/*
+ Factor := '%' Modula2Code '%' |
+ Ident
+ % WITH CurrentFactor^ DO
+ type := id ;
+ ident := CurrentIdent
+ END ; %
+ | Literal
+ % WITH CurrentFactor^ DO
+ type := lit ;
+ string := LastLiteral ;
+ IF GetSymKey(Aliases, LastLiteral)=NulName
+ THEN
+ WarnError1('no token defined for literal %s', LastLiteral)
+ END
+ END ; %
+ | '{'
+ % WITH CurrentFactor^ DO
+ type := mult ;
+ expr := NewExpression() ;
+ CurrentExpression := expr ;
+ END ; %
+ Expression '}' | '['
+ % WITH CurrentFactor^ DO
+ type := opt ;
+ expr := NewExpression() ;
+ CurrentExpression := expr ;
+ END ; %
+ Expression ']' | '('
+ % WITH CurrentFactor^ DO
+ type := sub ;
+ expr := NewExpression() ;
+ CurrentExpression := expr ;
+ END ; %
+ Expression ')'
+
+ first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok
+
+ cannot reachend
+*/
+
+static void Factor (pge_SetOfStop stopset)
+{
+ if ((bnflex_GetCurrentTokenType ()) == bnflex_codetok)
+ {
+ Expect (bnflex_codetok, stopset);
+ Modula2Code (stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok))));
+ Expect (bnflex_codetok, stopset);
+ }
+ else if ((bnflex_GetCurrentTokenType ()) == bnflex_identtok)
+ {
+ /* avoid dangling else. */
+ Ident (stopset);
+ CurrentFactor->type = pge_id;
+ CurrentFactor->ident = CurrentIdent;
+ }
+ else if ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_dquotetok)) | (1 << (bnflex_squotetok))))) != 0))
+ {
+ /* avoid dangling else. */
+ Literal (stopset);
+ CurrentFactor->type = pge_lit;
+ CurrentFactor->string = LastLiteral;
+ if ((SymbolKey_GetSymKey (Aliases, LastLiteral)) == NameKey_NulName)
+ {
+ WarnError1 ((const char *) "no token defined for literal %s", 31, LastLiteral);
+ }
+ }
+ else if ((bnflex_GetCurrentTokenType ()) == bnflex_lcparatok)
+ {
+ /* avoid dangling else. */
+ Expect (bnflex_lcparatok, stopset|(pge_SetOfStop) ((1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ CurrentFactor->type = pge_mult;
+ CurrentFactor->expr = NewExpression ();
+ CurrentExpression = CurrentFactor->expr;
+ Expression (stopset|(pge_SetOfStop) ((1 << (bnflex_rcparatok-bnflex_identtok))));
+ Expect (bnflex_rcparatok, stopset);
+ }
+ else if ((bnflex_GetCurrentTokenType ()) == bnflex_lsparatok)
+ {
+ /* avoid dangling else. */
+ Expect (bnflex_lsparatok, stopset|(pge_SetOfStop) ((1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ CurrentFactor->type = pge_opt;
+ CurrentFactor->expr = NewExpression ();
+ CurrentExpression = CurrentFactor->expr;
+ Expression (stopset|(pge_SetOfStop) ((1 << (bnflex_rsparatok-bnflex_identtok))));
+ Expect (bnflex_rsparatok, stopset);
+ }
+ else if ((bnflex_GetCurrentTokenType ()) == bnflex_lparatok)
+ {
+ /* avoid dangling else. */
+ Expect (bnflex_lparatok, stopset|(pge_SetOfStop) ((1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ CurrentFactor->type = pge_sub;
+ CurrentFactor->expr = NewExpression ();
+ CurrentExpression = CurrentFactor->expr;
+ Expression (stopset|(pge_SetOfStop) ((1 << (bnflex_rparatok-bnflex_identtok))));
+ Expect (bnflex_rparatok, stopset);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ PushBackInput_WarnError ((const char *) "expecting one of: ( [ { \" single quote identifier %", 51);
+ }
+}
+
+
+/*
+ Statement :=
+ % VAR i: IdentDesc ; %
+ Ident
+ % VAR p: ProductionDesc ; %
+
+ % p := FindDefinition(CurrentIdent^.name) ;
+ IF p=NIL
+ THEN
+ p := NewProduction()
+ ELSE
+ IF NOT ((p^.statement=NIL) OR (p^.statement^.expr=NIL))
+ THEN
+ WarnError1('already declared rule %s', CurrentIdent^.name)
+ END
+ END ;
+ i := CurrentIdent ; %
+ ':='
+ % VAR e: ExpressionDesc ; %
+
+ % e := NewExpression() ;
+ CurrentExpression := e ; %
+
+ % VAR s: StatementDesc ; %
+
+ % s := NewStatement() ;
+ WITH s^ DO
+ ident := i ;
+ expr := e
+ END ; %
+ Expression
+ % p^.statement := s ; %
+ '=:'
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Statement (pge_SetOfStop stopset)
+{
+ pge_IdentDesc i;
+ pge_ProductionDesc p;
+ pge_ExpressionDesc e;
+ pge_StatementDesc s;
+
+ Ident (stopset|(pge_SetOfStop) ((1 << (bnflex_lbecomestok-bnflex_identtok))));
+ p = FindDefinition (CurrentIdent->name);
+ if (p == NULL)
+ {
+ p = NewProduction ();
+ }
+ else
+ {
+ if (! ((p->statement == NULL) || (p->statement->expr == NULL)))
+ {
+ WarnError1 ((const char *) "already declared rule %s", 24, CurrentIdent->name);
+ }
+ }
+ i = CurrentIdent;
+ Expect (bnflex_lbecomestok, stopset|(pge_SetOfStop) ((1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ e = NewExpression ();
+ CurrentExpression = e;
+ s = NewStatement ();
+ s->ident = i;
+ s->expr = e;
+ Expression (stopset|(pge_SetOfStop) ((1 << (bnflex_rbecomestok-bnflex_identtok))));
+ p->statement = s;
+ Expect (bnflex_rbecomestok, stopset);
+}
+
+
+/*
+ Defs := 'special' Special | 'token' Token |
+ 'error' ErrorProcedures |
+ 'tokenfunc' TokenProcedure |
+ 'symfunc' SymProcedure
+
+ first symbols:symfunctok, tfunctok, errortok, tokentok, specialtok
+
+ cannot reachend
+*/
+
+static void Defs (pge_SetOfStop stopset)
+{
+ if ((bnflex_GetCurrentTokenType ()) == bnflex_specialtok)
+ {
+ Expect (bnflex_specialtok, stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok))));
+ Special (stopset);
+ }
+ else if ((bnflex_GetCurrentTokenType ()) == bnflex_tokentok)
+ {
+ /* avoid dangling else. */
+ Expect (bnflex_tokentok, stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ Token (stopset);
+ }
+ else if ((bnflex_GetCurrentTokenType ()) == bnflex_errortok)
+ {
+ /* avoid dangling else. */
+ Expect (bnflex_errortok, stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ ErrorProcedures (stopset);
+ }
+ else if ((bnflex_GetCurrentTokenType ()) == bnflex_tfunctok)
+ {
+ /* avoid dangling else. */
+ Expect (bnflex_tfunctok, stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ TokenProcedure (stopset);
+ }
+ else if ((bnflex_GetCurrentTokenType ()) == bnflex_symfunctok)
+ {
+ /* avoid dangling else. */
+ Expect (bnflex_symfunctok, stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ SymProcedure (stopset);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ PushBackInput_WarnError ((const char *) "expecting one of: symfunc tokenfunc error token special", 55);
+ }
+}
+
+
+/*
+ ExtBNF := 'BNF' { Production } 'FNB'
+
+ first symbols:BNFtok
+
+ cannot reachend
+*/
+
+static void ExtBNF (pge_SetOfStop stopset)
+{
+ Expect (bnflex_BNFtok, stopset|(pge_SetOfStop) ((1 << (bnflex_FNBtok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok))));
+ while ((bnflex_GetCurrentTokenType ()) == bnflex_identtok)
+ {
+ Production (stopset|(pge_SetOfStop) ((1 << (bnflex_FNBtok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok))));
+ }
+ /* while */
+ Expect (bnflex_FNBtok, stopset);
+}
+
+
+/*
+ Main := Header Decls Footer Rules
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Main (pge_SetOfStop stopset)
+{
+ Header (stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok))));
+ Decls (stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok))));
+ Footer (stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok))));
+ Rules (stopset);
+}
+
+
+/*
+ Header := '%' 'module' StartModName
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Header (pge_SetOfStop stopset)
+{
+ Expect (bnflex_codetok, stopset|(pge_SetOfStop) ((1 << (bnflex_moduletok-bnflex_identtok))));
+ Expect (bnflex_moduletok, stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok))));
+ StartModName (stopset);
+}
+
+
+/*
+ Decls := '%' 'declaration' DoDeclaration
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Decls (pge_SetOfStop stopset)
+{
+ Expect (bnflex_codetok, stopset|(pge_SetOfStop) ((1 << (bnflex_declarationtok-bnflex_identtok))));
+ Expect (bnflex_declarationtok, stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok))));
+ DoDeclaration (stopset);
+}
+
+
+/*
+ Footer := '%' 'module' EndModName
+
+ first symbols:codetok
+
+ cannot reachend
+*/
+
+static void Footer (pge_SetOfStop stopset)
+{
+ Expect (bnflex_codetok, stopset|(pge_SetOfStop) ((1 << (bnflex_moduletok-bnflex_identtok))));
+ Expect (bnflex_moduletok, stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok))));
+ EndModName (stopset);
+}
+
+
+/*
+ First := 'first' '{' { LitOrTokenOrIdent
+ % WITH CurrentSetDesc^ DO
+ next := TailProduction^.first ;
+ END ;
+ TailProduction^.first := CurrentSetDesc
+ %
+ } '}'
+
+ first symbols:firsttok
+
+ cannot reachend
+*/
+
+static void First (pge_SetOfStop stopset)
+{
+ Expect (bnflex_firsttok, stopset|(pge_SetOfStop) ((1 << (bnflex_lcparatok-bnflex_identtok))));
+ Expect (bnflex_lcparatok, stopset|(pge_SetOfStop) ((1 << (bnflex_rcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_lesstok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ while ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_lesstok)) | (1 << (bnflex_identtok)) | (1 << (bnflex_squotetok)) | (1 << (bnflex_dquotetok))))) != 0))
+ {
+ LitOrTokenOrIdent (stopset|(pge_SetOfStop) ((1 << (bnflex_rcparatok-bnflex_identtok)) | (1 << (bnflex_lesstok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok))));
+ CurrentSetDesc->next = TailProduction->first;
+ TailProduction->first = CurrentSetDesc;
+ }
+ /* while */
+ Expect (bnflex_rcparatok, stopset);
+}
+
+
+/*
+ Follow := 'follow' '{' { LitOrTokenOrIdent
+ % WITH CurrentSetDesc^ DO
+ next := TailProduction^.followinfo^.follow ;
+ END ;
+ TailProduction^.followinfo^.follow := CurrentSetDesc
+ %
+ } '}'
+
+ first symbols:followtok
+
+ cannot reachend
+*/
+
+static void Follow (pge_SetOfStop stopset)
+{
+ Expect (bnflex_followtok, stopset|(pge_SetOfStop) ((1 << (bnflex_lcparatok-bnflex_identtok))));
+ Expect (bnflex_lcparatok, stopset|(pge_SetOfStop) ((1 << (bnflex_rcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_lesstok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ while ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_lesstok)) | (1 << (bnflex_identtok)) | (1 << (bnflex_squotetok)) | (1 << (bnflex_dquotetok))))) != 0))
+ {
+ LitOrTokenOrIdent (stopset|(pge_SetOfStop) ((1 << (bnflex_rcparatok-bnflex_identtok)) | (1 << (bnflex_lesstok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok))));
+ CurrentSetDesc->next = TailProduction->followinfo->follow;
+ TailProduction->followinfo->follow = CurrentSetDesc;
+ }
+ /* while */
+ Expect (bnflex_rcparatok, stopset);
+}
+
+
+/*
+ LitOrTokenOrIdent := Literal
+ % CurrentSetDesc := NewSetDesc() ;
+ WITH CurrentSetDesc^ DO
+ type := litel ;
+ string := LastLiteral ;
+ END ;
+ %
+ | '<' CollectTok '>' |
+ Ident
+ % CurrentSetDesc := NewSetDesc() ;
+ WITH CurrentSetDesc^ DO
+ type := idel ;
+ ident := CurrentIdent ;
+ END ;
+ %
+
+
+ first symbols:dquotetok, squotetok, identtok, lesstok
+
+ cannot reachend
+*/
+
+static void LitOrTokenOrIdent (pge_SetOfStop stopset)
+{
+ if ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_dquotetok)) | (1 << (bnflex_squotetok))))) != 0))
+ {
+ Literal (stopset);
+ CurrentSetDesc = NewSetDesc ();
+ CurrentSetDesc->type = pge_litel;
+ CurrentSetDesc->string = LastLiteral;
+ }
+ else if ((bnflex_GetCurrentTokenType ()) == bnflex_lesstok)
+ {
+ /* avoid dangling else. */
+ Expect (bnflex_lesstok, stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok))));
+ CollectTok (stopset|(pge_SetOfStop) ((1 << (bnflex_gretok-bnflex_identtok))));
+ Expect (bnflex_gretok, stopset);
+ }
+ else if ((bnflex_GetCurrentTokenType ()) == bnflex_identtok)
+ {
+ /* avoid dangling else. */
+ Ident (stopset);
+ CurrentSetDesc = NewSetDesc ();
+ CurrentSetDesc->type = pge_idel;
+ CurrentSetDesc->ident = CurrentIdent;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ PushBackInput_WarnError ((const char *) "expecting one of: identifier < \" single quote", 45);
+ }
+}
+
+
+/*
+ Literal := '"' CollectLiteral '"' |
+ "'" CollectLiteral "'"
+
+ first symbols:squotetok, dquotetok
+
+ cannot reachend
+*/
+
+static void Literal (pge_SetOfStop stopset)
+{
+ if ((bnflex_GetCurrentTokenType ()) == bnflex_dquotetok)
+ {
+ Expect (bnflex_dquotetok, stopset|(pge_SetOfStop) ((1 << (bnflex_literaltok-bnflex_identtok))));
+ CollectLiteral (stopset|(pge_SetOfStop) ((1 << (bnflex_dquotetok-bnflex_identtok))));
+ Expect (bnflex_dquotetok, stopset);
+ }
+ else if ((bnflex_GetCurrentTokenType ()) == bnflex_squotetok)
+ {
+ /* avoid dangling else. */
+ Expect (bnflex_squotetok, stopset|(pge_SetOfStop) ((1 << (bnflex_literaltok-bnflex_identtok))));
+ CollectLiteral (stopset|(pge_SetOfStop) ((1 << (bnflex_squotetok-bnflex_identtok))));
+ Expect (bnflex_squotetok, stopset);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ PushBackInput_WarnError ((const char *) "expecting one of: single quote \"", 32);
+ }
+}
+
+
+/*
+ Token := Literal DefineToken
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void Token (pge_SetOfStop stopset)
+{
+ Literal (stopset|(pge_SetOfStop) ((1 << (bnflex_identtok-bnflex_identtok))));
+ DefineToken (stopset);
+}
+
+
+/*
+ ErrorProcedures := Literal
+ % ErrorProcArray := LastLiteral %
+ Literal
+ % ErrorProcString := LastLiteral %
+
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void ErrorProcedures (pge_SetOfStop stopset)
+{
+ Literal (stopset|(pge_SetOfStop) ((1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok))));
+ ErrorProcArray = LastLiteral;
+ Literal (stopset);
+ ErrorProcString = LastLiteral;
+}
+
+
+/*
+ TokenProcedure := Literal
+ % TokenTypeProc := LastLiteral %
+
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void TokenProcedure (pge_SetOfStop stopset)
+{
+ Literal (stopset);
+ TokenTypeProc = LastLiteral;
+}
+
+
+/*
+ SymProcedure := Literal
+ % SymIsProc := LastLiteral %
+
+
+ first symbols:dquotetok, squotetok
+
+ cannot reachend
+*/
+
+static void SymProcedure (pge_SetOfStop stopset)
+{
+ Literal (stopset);
+ SymIsProc = LastLiteral;
+}
+
+
+/*
+ Production := Statement
+
+ first symbols:identtok
+
+ cannot reachend
+*/
+
+static void Production (pge_SetOfStop stopset)
+{
+ Statement (stopset);
+}
+
+
+/*
+ Expression :=
+ % VAR t1, t2: TermDesc ;
+ e : ExpressionDesc ; %
+
+ % e := CurrentExpression ;
+ t1 := NewTerm() ;
+ CurrentTerm := t1 ; %
+ Term
+ % e^.term := t1 ; %
+ { '|'
+ % t2 := NewTerm() ;
+ CurrentTerm := t2 %
+ Term
+ % t1^.next := t2 ;
+ t1 := t2 %
+ }
+
+ first symbols:dquotetok, squotetok, lparatok, lsparatok, lcparatok, identtok, codetok
+
+ cannot reachend
+*/
+
+static void Expression (pge_SetOfStop stopset)
+{
+ pge_TermDesc t1;
+ pge_TermDesc t2;
+ pge_ExpressionDesc e;
+
+ e = CurrentExpression;
+ t1 = NewTerm ();
+ CurrentTerm = t1;
+ Term (stopset|(pge_SetOfStop) ((1 << (bnflex_bartok-bnflex_identtok))));
+ e->term = t1;
+ while ((bnflex_GetCurrentTokenType ()) == bnflex_bartok)
+ {
+ Expect (bnflex_bartok, stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok))));
+ t2 = NewTerm ();
+ CurrentTerm = t2;
+ Term (stopset|(pge_SetOfStop) ((1 << (bnflex_bartok-bnflex_identtok))));
+ t1->next = t2;
+ t1 = t2;
+ }
+ /* while */
+}
+
+
+/*
+ Term :=
+ % VAR t1: TermDesc ; f1, f2: FactorDesc ; %
+
+ % CurrentFactor := NewFactor() ;
+ f1 := CurrentFactor ;
+ t1 := CurrentTerm ; %
+ Factor
+ % t1^.factor := f1 ;
+ f2 := NewFactor() ;
+ CurrentFactor := f2 %
+ { Factor
+ % f1^.next := f2 ;
+ f1 := f2 ;
+ f2 := NewFactor() ;
+ CurrentFactor := f2 ; %
+ }
+
+ first symbols:squotetok, dquotetok, codetok, identtok, lcparatok, lsparatok, lparatok
+
+ cannot reachend
+*/
+
+static void Term (pge_SetOfStop stopset)
+{
+ pge_TermDesc t1;
+ pge_FactorDesc f1;
+ pge_FactorDesc f2;
+
+ CurrentFactor = NewFactor ();
+ f1 = CurrentFactor;
+ t1 = CurrentTerm;
+ Factor (stopset|(pge_SetOfStop) ((1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok))));
+ t1->factor = f1;
+ f2 = NewFactor ();
+ CurrentFactor = f2;
+ while ((((1 << (bnflex_GetCurrentTokenType ())) & ((unsigned int) ((1 << (bnflex_codetok)) | (1 << (bnflex_identtok)) | (1 << (bnflex_lcparatok)) | (1 << (bnflex_lsparatok)) | (1 << (bnflex_lparatok)) | (1 << (bnflex_squotetok)) | (1 << (bnflex_dquotetok))))) != 0))
+ {
+ Factor (stopset|(pge_SetOfStop) ((1 << (bnflex_codetok-bnflex_identtok)) | (1 << (bnflex_identtok-bnflex_identtok)) | (1 << (bnflex_lcparatok-bnflex_identtok)) | (1 << (bnflex_lsparatok-bnflex_identtok)) | (1 << (bnflex_lparatok-bnflex_identtok)) | (1 << (bnflex_squotetok-bnflex_identtok)) | (1 << (bnflex_dquotetok-bnflex_identtok))));
+ f1->next = f2;
+ f1 = f2;
+ f2 = NewFactor ();
+ CurrentFactor = f2;
+ }
+ /* while */
+}
+
+
+/*
+ GetDefinitionName - returns the name of the rule inside, p.
+*/
+
+static NameKey_Name GetDefinitionName (pge_ProductionDesc p)
+{
+ if (p != NULL)
+ {
+ if ((p->statement != NULL) && (p->statement->ident != NULL))
+ {
+ return p->statement->ident->name;
+ }
+ }
+ return NameKey_NulName;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FindDefinition - searches and returns the rule which defines, n.
+*/
+
+static pge_ProductionDesc FindDefinition (NameKey_Name n)
+{
+ pge_ProductionDesc p;
+ pge_ProductionDesc f;
+
+ p = HeadProduction;
+ f = NULL;
+ while (p != NULL)
+ {
+ if ((GetDefinitionName (p)) == n)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (f == NULL)
+ {
+ f = p;
+ }
+ else
+ {
+ StrIO_WriteString ((const char *) "multiple definition for rule: ", 30);
+ NameKey_WriteKey (n);
+ StrIO_WriteLn ();
+ }
+ }
+ p = p->next;
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ BackPatchIdent - found an ident, i, we must look for the corresponding rule and
+ set the definition accordingly.
+*/
+
+static void BackPatchIdent (pge_IdentDesc i)
+{
+ if (i != NULL)
+ {
+ i->definition = FindDefinition (i->name);
+ if (i->definition == NULL)
+ {
+ WarnError1 ((const char *) "unable to find production %s", 28, i->name);
+ WasNoError = FALSE;
+ }
+ }
+}
+
+
+/*
+ BackPatchFactor - runs through the factor looking for an ident
+*/
+
+static void BackPatchFactor (pge_FactorDesc f)
+{
+ while (f != NULL)
+ {
+ switch (f->type)
+ {
+ case pge_id:
+ BackPatchIdent (f->ident);
+ break;
+
+ case pge_sub:
+ case pge_opt:
+ case pge_mult:
+ BackPatchExpression (f->expr);
+ break;
+
+
+ default:
+ break;
+ }
+ f = f->next;
+ }
+}
+
+
+/*
+ BackPatchTerm - runs through all terms to find idents.
+*/
+
+static void BackPatchTerm (pge_TermDesc t)
+{
+ while (t != NULL)
+ {
+ BackPatchFactor (t->factor);
+ t = t->next;
+ }
+}
+
+
+/*
+ BackPatchExpression - runs through the term to find any idents.
+*/
+
+static void BackPatchExpression (pge_ExpressionDesc e)
+{
+ if (e != NULL)
+ {
+ BackPatchTerm (e->term);
+ }
+}
+
+
+/*
+ BackPatchSet -
+*/
+
+static void BackPatchSet (pge_SetDesc s)
+{
+ while (s != NULL)
+ {
+ switch (s->type)
+ {
+ case pge_idel:
+ BackPatchIdent (s->ident);
+ break;
+
+
+ default:
+ break;
+ }
+ s = s->next;
+ }
+}
+
+
+/*
+ BackPatchIdentToDefinitions - search through all the rules and add a link from any ident
+ to the definition.
+*/
+
+static void BackPatchIdentToDefinitions (pge_ProductionDesc d)
+{
+ if ((d != NULL) && (d->statement != NULL))
+ {
+ BackPatchExpression (d->statement->expr);
+ }
+}
+
+
+/*
+ CalculateFirstAndFollow -
+*/
+
+static void CalculateFirstAndFollow (pge_ProductionDesc p)
+{
+ if (Debugging)
+ {
+ StrIO_WriteLn ();
+ NameKey_WriteKey (p->statement->ident->name);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " calculating first", 19);
+ }
+ CalcFirstProduction (p, p, &p->first);
+ BackPatchSet (p->first);
+ if (Debugging)
+ {
+ StrIO_WriteString ((const char *) " calculating follow set", 24);
+ }
+ if (p->followinfo->follow == NULL)
+ {
+ CalcFollowProduction (p);
+ }
+ BackPatchSet (p->followinfo->follow);
+}
+
+
+/*
+ ForeachRuleDo -
+*/
+
+static void ForeachRuleDo (pge_DoProcedure p)
+{
+ CurrentProduction = HeadProduction;
+ while (CurrentProduction != NULL)
+ {
+ (*p.proc) (CurrentProduction);
+ CurrentProduction = CurrentProduction->next;
+ }
+}
+
+
+/*
+ WhileNotCompleteDo -
+*/
+
+static void WhileNotCompleteDo (pge_DoProcedure p)
+{
+ do {
+ Finished = TRUE;
+ ForeachRuleDo (p);
+ } while (! (Finished));
+}
+
+
+/*
+ NewLine - generate a newline and indent.
+*/
+
+static void NewLine (unsigned int Left)
+{
+ Output_WriteLn ();
+ BeginningOfLine = TRUE;
+ Indent = 0;
+ while (Indent < Left)
+ {
+ Output_Write (' ');
+ Indent += 1;
+ }
+}
+
+
+/*
+ CheckNewLine -
+*/
+
+static void CheckNewLine (unsigned int Left)
+{
+ if (Indent == Left)
+ {
+ Left = BaseNewLine;
+ }
+ if (Indent > BaseRightMargin)
+ {
+ NewLine (Left);
+ }
+}
+
+
+/*
+ IndentString - writes out a string with a preceeding indent.
+*/
+
+static void IndentString (const char *a_, unsigned int _a_high)
+{
+ unsigned int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = 0;
+ while (i < Indent)
+ {
+ Output_Write (' ');
+ i += 1;
+ }
+ Output_WriteString ((const char *) a, _a_high);
+ LastLineNo = 0;
+}
+
+
+/*
+ KeyWord - writes out a keywork with optional formatting directives.
+*/
+
+static void KeyWord (NameKey_Name n)
+{
+ if (KeywordFormatting)
+ {
+ Output_WriteString ((const char *) "{%K", 3);
+ if (((n == (NameKey_MakeKey ((const char *) "}", 1))) || (n == (NameKey_MakeKey ((const char *) "{", 1)))) || (n == (NameKey_MakeKey ((const char *) "%", 1))))
+ {
+ Output_Write ('%'); /* escape }, { or % */
+ }
+ Output_WriteKey (n);
+ Output_Write ('}');
+ }
+ else
+ {
+ Output_WriteKey (n);
+ }
+}
+
+
+/*
+ PrettyPara -
+*/
+
+static void PrettyPara (const char *c1_, unsigned int _c1_high, const char *c2_, unsigned int _c2_high, pge_ExpressionDesc e, unsigned int Left)
+{
+ char c1[_c1_high+1];
+ char c2[_c2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (c1, c1_, _c1_high+1);
+ memcpy (c2, c2_, _c2_high+1);
+
+ Output_WriteString ((const char *) c1, _c1_high);
+ Indent += StrLib_StrLen ((const char *) c1, _c1_high);
+ Left = Indent;
+ PrettyCommentExpression (e, Left);
+ Output_WriteString ((const char *) c2, _c2_high);
+ Indent += StrLib_StrLen ((const char *) c2, _c2_high);
+}
+
+
+/*
+ WriteKeyTexinfo -
+*/
+
+static void WriteKeyTexinfo (NameKey_Name s)
+{
+ DynamicStrings_String ds;
+ char ch;
+ unsigned int i;
+ unsigned int l;
+
+ if (Texinfo)
+ {
+ ds = DynamicStrings_InitStringCharStar (NameKey_KeyToCharStar (s));
+ l = DynamicStrings_Length (ds);
+ i = 0;
+ while (i < l)
+ {
+ ch = DynamicStrings_char (ds, static_cast<int> (i));
+ if ((ch == '{') || (ch == '}'))
+ {
+ Output_Write ('@');
+ }
+ Output_Write (ch);
+ i += 1;
+ }
+ }
+ else
+ {
+ Output_WriteKey (s);
+ }
+}
+
+
+/*
+ PrettyCommentFactor -
+*/
+
+static void PrettyCommentFactor (pge_FactorDesc f, unsigned int Left)
+{
+ unsigned int curpos;
+ unsigned int seentext;
+
+ while (f != NULL)
+ {
+ CheckNewLine (Left);
+ switch (f->type)
+ {
+ case pge_id:
+ Output_WriteKey (f->ident->name);
+ Output_WriteString ((const char *) " ", 1);
+ Indent += (NameKey_LengthKey (f->ident->name))+1;
+ break;
+
+ case pge_lit:
+ if ((NameKey_MakeKey ((const char *) "'", 1)) == f->string)
+ {
+ Output_Write ('"');
+ WriteKeyTexinfo (f->string);
+ Output_WriteString ((const char *) "\" ", 2);
+ }
+ else
+ {
+ Output_Write ('\'');
+ WriteKeyTexinfo (f->string);
+ Output_WriteString ((const char *) "' ", 2);
+ }
+ Indent += (NameKey_LengthKey (f->string))+3;
+ break;
+
+ case pge_sub:
+ PrettyPara ((const char *) "( ", 2, (const char *) " ) ", 3, f->expr, Left);
+ break;
+
+ case pge_opt:
+ PrettyPara ((const char *) "[ ", 2, (const char *) " ] ", 3, f->expr, Left);
+ break;
+
+ case pge_mult:
+ if (Texinfo)
+ {
+ PrettyPara ((const char *) "@{ ", 3, (const char *) " @} ", 4, f->expr, Left);
+ }
+ else
+ {
+ PrettyPara ((const char *) "{ ", 2, (const char *) " } ", 3, f->expr, Left);
+ }
+ break;
+
+ case pge_m2:
+ if (EmitCode)
+ {
+ NewLine (Left);
+ Output_WriteString ((const char *) "% ", 2);
+ seentext = FALSE;
+ curpos = 0;
+ WriteCodeHunkListIndent (f->code->code, f->code->indent, &curpos, Left+2, &seentext);
+ Output_WriteString ((const char *) " %", 2);
+ NewLine (Left);
+ }
+ break;
+
+
+ default:
+ break;
+ }
+ PrettyFollow ((const char *) "<f:", 3, (const char *) ":f>", 3, f->followinfo);
+ f = f->next;
+ }
+}
+
+
+/*
+ PeepTerm - returns the length of characters in term.
+*/
+
+static unsigned int PeepTerm (pge_TermDesc t)
+{
+ unsigned int l;
+
+ l = 0;
+ while (t != NULL)
+ {
+ l += PeepFactor (t->factor);
+ if (t->next != NULL)
+ {
+ l += 3;
+ }
+ t = t->next;
+ }
+ return l;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PeepExpression - returns the length of the expression.
+*/
+
+static unsigned int PeepExpression (pge_ExpressionDesc e)
+{
+ if (e == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ return PeepTerm (e->term);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PeepFactor - returns the length of character in the factor
+*/
+
+static unsigned int PeepFactor (pge_FactorDesc f)
+{
+ unsigned int l;
+
+ l = 0;
+ while (f != NULL)
+ {
+ switch (f->type)
+ {
+ case pge_id:
+ l += (NameKey_LengthKey (f->ident->name))+1;
+ break;
+
+ case pge_lit:
+ l += (NameKey_LengthKey (f->string))+3;
+ break;
+
+ case pge_opt:
+ case pge_mult:
+ case pge_sub:
+ l += PeepExpression (f->expr);
+ break;
+
+ case pge_m2:
+ break;
+
+
+ default:
+ break;
+ }
+ f = f->next; /* empty */
+ }
+ return l;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PrettyCommentTerm -
+*/
+
+static void PrettyCommentTerm (pge_TermDesc t, unsigned int Left)
+{
+ while (t != NULL)
+ {
+ CheckNewLine (Left);
+ PrettyCommentFactor (t->factor, Left);
+ if (t->next != NULL)
+ {
+ Output_WriteString ((const char *) " | ", 3);
+ Indent += 3;
+ if (((PeepFactor (t->factor))+Indent) > BaseRightMargin)
+ {
+ NewLine (Left);
+ }
+ }
+ PrettyFollow ((const char *) "<t:", 3, (const char *) ":t>", 3, t->followinfo);
+ t = t->next;
+ }
+}
+
+
+/*
+ PrettyCommentExpression -
+*/
+
+static void PrettyCommentExpression (pge_ExpressionDesc e, unsigned int Left)
+{
+ if (e != NULL)
+ {
+ PrettyCommentTerm (e->term, Left);
+ PrettyFollow ((const char *) "<e:", 3, (const char *) ":e>", 3, e->followinfo);
+ }
+}
+
+
+/*
+ PrettyCommentStatement -
+*/
+
+static void PrettyCommentStatement (pge_StatementDesc s, unsigned int Left)
+{
+ if (s != NULL)
+ {
+ PrettyCommentExpression (s->expr, Left);
+ PrettyFollow ((const char *) "<s:", 3, (const char *) ":s>", 3, s->followinfo);
+ }
+}
+
+
+/*
+ PrettyCommentProduction - generates the comment for rule, p.
+*/
+
+static void PrettyCommentProduction (pge_ProductionDesc p)
+{
+ pge_SetDesc to;
+
+ if (p != NULL)
+ {
+ BeginningOfLine = TRUE;
+ Indent = 0;
+ Output_WriteString ((const char *) "(*", 2);
+ NewLine (3);
+ Output_WriteKey (GetDefinitionName (p));
+ Output_WriteString ((const char *) " := ", 4);
+ Indent += (NameKey_LengthKey (GetDefinitionName (p)))+4;
+ PrettyCommentStatement (p->statement, Indent);
+ NewLine (0);
+ if (ErrorRecovery)
+ {
+ NewLine (3);
+ Output_WriteString ((const char *) "first symbols:", 15);
+ EmitSet (p->first, static_cast<unsigned int> (0), static_cast<unsigned int> (0));
+ NewLine (3);
+ PrettyFollow ((const char *) "<p:", 3, (const char *) ":p>", 3, p->followinfo);
+ NewLine (3);
+ switch (GetReachEnd (p->followinfo))
+ {
+ case pge_true:
+ Output_WriteString ((const char *) "reachend", 8);
+ break;
+
+ case pge_false:
+ Output_WriteString ((const char *) "cannot reachend", 15);
+ break;
+
+ case pge_unknown:
+ Output_WriteString ((const char *) "unknown...", 10);
+ break;
+
+
+ default:
+ break;
+ }
+ NewLine (0);
+ }
+ Output_WriteString ((const char *) "*)", 2);
+ NewLine (0);
+ }
+}
+
+
+/*
+ PrettyPrintProduction - pretty prints the ebnf rule, p.
+*/
+
+static void PrettyPrintProduction (pge_ProductionDesc p)
+{
+ pge_SetDesc to;
+
+ if (p != NULL)
+ {
+ BeginningOfLine = TRUE;
+ Indent = 0;
+ if (Texinfo)
+ {
+ Output_WriteString ((const char *) "@example", 8);
+ NewLine (0);
+ }
+ else if (Sphinx)
+ {
+ /* avoid dangling else. */
+ Output_WriteString ((const char *) ".. code-block:: ebnf", 20);
+ NewLine (0);
+ }
+ Output_WriteKey (GetDefinitionName (p));
+ Output_WriteString ((const char *) " := ", 4);
+ Indent += (NameKey_LengthKey (GetDefinitionName (p)))+4;
+ PrettyCommentStatement (p->statement, Indent);
+ if (p->description != NameKey_NulName)
+ {
+ Output_WriteKey (p->description);
+ }
+ NewLine (0);
+ WriteIndent ((NameKey_LengthKey (GetDefinitionName (p)))+1);
+ Output_WriteString ((const char *) " =: ", 4);
+ NewLine (0);
+ if (Texinfo)
+ {
+ Output_WriteString ((const char *) "@findex ", 8);
+ Output_WriteKey (GetDefinitionName (p));
+ Output_WriteString ((const char *) " (ebnf)", 7);
+ NewLine (0);
+ Output_WriteString ((const char *) "@end example", 12);
+ NewLine (0);
+ }
+ else if (Sphinx)
+ {
+ /* avoid dangling else. */
+ Output_WriteString ((const char *) ".. index::", 10);
+ NewLine (0);
+ Output_WriteString ((const char *) " pair: ", 8);
+ Output_WriteKey (GetDefinitionName (p));
+ Output_WriteString ((const char *) "; (ebnf)", 8);
+ NewLine (0);
+ }
+ NewLine (0);
+ }
+}
+
+
+/*
+ EmitFileLineTag - emits a line and file tag using the C preprocessor syntax.
+*/
+
+static void EmitFileLineTag (unsigned int line)
+{
+ if (! SuppressFileLineTag && (line != LastLineNo))
+ {
+ LastLineNo = line;
+ if (! OnLineStart)
+ {
+ Output_WriteLn ();
+ }
+ Output_WriteString ((const char *) "# ", 2);
+ Output_WriteCard (line, 0);
+ Output_WriteString ((const char *) " \"", 2);
+ Output_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ Output_Write ('"');
+ Output_WriteLn ();
+ OnLineStart = TRUE;
+ }
+}
+
+
+/*
+ EmitRule - generates a comment and code for rule, p.
+*/
+
+static void EmitRule (pge_ProductionDesc p)
+{
+ if (PrettyPrint)
+ {
+ PrettyPrintProduction (p);
+ }
+ else
+ {
+ PrettyCommentProduction (p);
+ if (ErrorRecovery)
+ {
+ RecoverProduction (p);
+ }
+ else
+ {
+ CodeProduction (p);
+ }
+ }
+}
+
+
+/*
+ CodeCondition -
+*/
+
+static void CodeCondition (pge_m2condition m)
+{
+ switch (m)
+ {
+ case pge_m2if:
+ case pge_m2none:
+ IndentString ((const char *) "IF ", 3);
+ break;
+
+ case pge_m2elsif:
+ IndentString ((const char *) "ELSIF ", 6);
+ break;
+
+ case pge_m2while:
+ IndentString ((const char *) "WHILE ", 6);
+ break;
+
+
+ default:
+ Debug_Halt ((const char *) "unrecognised m2condition", 24, 2680, (const char *) "m2/gm2-auto/pge.mod", 19);
+ break;
+ }
+}
+
+
+/*
+ CodeThenDo - codes a "THEN" or "DO" depending upon, m.
+*/
+
+static void CodeThenDo (pge_m2condition m)
+{
+ switch (m)
+ {
+ case pge_m2if:
+ case pge_m2none:
+ case pge_m2elsif:
+ if (LastLineNo == 0)
+ {
+ Output_WriteLn ();
+ }
+ IndentString ((const char *) "THEN", 4);
+ Output_WriteLn ();
+ break;
+
+ case pge_m2while:
+ Output_WriteString ((const char *) " DO", 3);
+ Output_WriteLn ();
+ break;
+
+
+ default:
+ Debug_Halt ((const char *) "unrecognised m2condition", 24, 2705, (const char *) "m2/gm2-auto/pge.mod", 19);
+ break;
+ }
+ OnLineStart = TRUE;
+}
+
+
+/*
+ CodeElseEnd - builds an ELSE END statement using string, end.
+*/
+
+static void CodeElseEnd (const char *end_, unsigned int _end_high, unsigned int consumed, pge_FactorDesc f, unsigned int inopt)
+{
+ char end[_end_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (end, end_, _end_high+1);
+
+ Output_WriteLn ();
+ OnLineStart = TRUE;
+ EmitFileLineTag (f->line);
+ if (! inopt)
+ {
+ IndentString ((const char *) "ELSE", 4);
+ StrIO_WriteLn ();
+ Indent += 3;
+ if (consumed)
+ {
+ IndentString ((const char *) "", 0);
+ Output_WriteKey (ErrorProcArray);
+ Output_Write ('(');
+ switch (f->type)
+ {
+ case pge_id:
+ Output_Write ('\'');
+ Output_WriteKey (f->ident->name);
+ Output_WriteString ((const char *) " - expected", 11);
+ Output_WriteString ((const char *) "') ;", 4);
+ break;
+
+ case pge_lit:
+ if ((NameKey_MakeKey ((const char *) "'", 1)) == f->string)
+ {
+ Output_Write ('"');
+ KeyWord (f->string);
+ Output_WriteString ((const char *) " - expected", 11);
+ Output_WriteString ((const char *) "\") ;", 4);
+ }
+ else if ((NameKey_MakeKey ((const char *) "\"", 1)) == f->string)
+ {
+ /* avoid dangling else. */
+ Output_Write ('\'');
+ KeyWord (f->string);
+ Output_WriteString ((const char *) " - expected", 11);
+ Output_WriteString ((const char *) "') ;", 4);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ Output_Write ('"');
+ Output_Write ('\'');
+ KeyWord (f->string);
+ Output_WriteString ((const char *) "' - expected", 12);
+ Output_WriteString ((const char *) "\") ;", 4);
+ }
+ break;
+
+
+ default:
+ break;
+ }
+ Output_WriteLn ();
+ }
+ IndentString ((const char *) "RETURN( FALSE )", 15);
+ Indent -= 3;
+ Output_WriteLn ();
+ }
+ IndentString ((const char *) end, _end_high);
+ Output_WriteLn ();
+ OnLineStart = TRUE;
+}
+
+
+/*
+ CodeEnd - codes a "END" depending upon, m.
+*/
+
+static void CodeEnd (pge_m2condition m, pge_TermDesc t, unsigned int consumed, pge_FactorDesc f, unsigned int inopt)
+{
+ Indent -= 3;
+ Output_WriteLn ();
+ OnLineStart = TRUE;
+ switch (m)
+ {
+ case pge_m2none:
+ if (t == NULL)
+ {
+ CodeElseEnd ((const char *) "END ;", 5, consumed, f, inopt);
+ }
+ break;
+
+ case pge_m2if:
+ if (t == NULL)
+ {
+ CodeElseEnd ((const char *) "END ; (* if *)", 15, consumed, f, inopt);
+ }
+ break;
+
+ case pge_m2elsif:
+ if (t == NULL)
+ {
+ CodeElseEnd ((const char *) "END ; (* elsif *)", 18, consumed, f, inopt);
+ }
+ break;
+
+ case pge_m2while:
+ IndentString ((const char *) "END ; (* while *)", 18);
+ break;
+
+
+ default:
+ Debug_Halt ((const char *) "unrecognised m2condition", 24, 2788, (const char *) "m2/gm2-auto/pge.mod", 19);
+ break;
+ }
+ OnLineStart = FALSE;
+}
+
+
+/*
+ EmitNonVarCode - writes out, code, providing it is not a variable declaration.
+*/
+
+static void EmitNonVarCode (pge_CodeDesc code, unsigned int curpos, unsigned int left)
+{
+ unsigned int i;
+ pge_CodeHunk t;
+ unsigned int seentext;
+
+ t = code->code;
+ if ((! (FindStr (&t, &i, (const char *) "VAR", 3))) && EmitCode)
+ {
+ seentext = FALSE;
+ curpos = 0;
+ EmitFileLineTag (code->line);
+ IndentString ((const char *) "", 0);
+ WriteCodeHunkListIndent (code->code, code->indent, &curpos, left, &seentext);
+ Output_WriteString ((const char *) " ;", 2);
+ Output_WriteLn ();
+ OnLineStart = TRUE;
+ }
+}
+
+
+/*
+ ChainOn -
+*/
+
+static pge_FactorDesc ChainOn (pge_FactorDesc codeStack, pge_FactorDesc f)
+{
+ pge_FactorDesc s;
+
+ f->pushed = NULL;
+ if (codeStack == NULL)
+ {
+ return f;
+ }
+ else
+ {
+ s = codeStack;
+ while (s->pushed != NULL)
+ {
+ s = s->pushed;
+ }
+ s->pushed = f;
+ return codeStack;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FlushCode -
+*/
+
+static void FlushCode (pge_FactorDesc *codeStack)
+{
+ if ((*codeStack) != NULL)
+ {
+ NewLine (Indent);
+ Output_WriteString ((const char *) "(* begin flushing code *)", 25);
+ OnLineStart = FALSE;
+ while ((*codeStack) != NULL)
+ {
+ NewLine (Indent);
+ EmitNonVarCode ((*codeStack)->code, 0, Indent);
+ NewLine (Indent);
+ (*codeStack) = (*codeStack)->pushed;
+ if ((*codeStack) != NULL)
+ {
+ Output_WriteString ((const char *) " (* again flushing code *)", 26);
+ Output_WriteLn ();
+ OnLineStart = TRUE;
+ }
+ }
+ NewLine (Indent);
+ Output_WriteString ((const char *) "(* end flushing code *)", 23);
+ OnLineStart = FALSE;
+ }
+}
+
+
+/*
+ CodeFactor -
+*/
+
+static void CodeFactor (pge_FactorDesc f, pge_TermDesc t, pge_m2condition l, pge_m2condition n, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack)
+{
+ if (f == NULL)
+ {
+ /* avoid dangling else. */
+ if (! inwhile && ! inopt) /* ((l=m2elsif) OR (l=m2if) OR (l=m2none)) AND */
+ {
+ Output_WriteLn ();
+ IndentString ((const char *) "RETURN( TRUE )", 14);
+ OnLineStart = FALSE;
+ }
+ }
+ else
+ {
+ EmitFileLineTag (f->line);
+ switch (f->type)
+ {
+ case pge_id:
+ FlushCode (&codeStack);
+ CodeCondition (n);
+ Output_WriteKey (f->ident->name);
+ Output_WriteString ((const char *) "()", 2);
+ CodeThenDo (n);
+ Indent += 3;
+ CodeFactor (f->next, NULL, n, pge_m2none, inopt, inwhile, TRUE, NULL);
+ CodeEnd (n, t, consumed, f, inopt);
+ break;
+
+ case pge_lit:
+ FlushCode (&codeStack);
+ CodeCondition (n);
+ Output_WriteKey (SymIsProc);
+ Output_Write ('(');
+ Output_WriteKey (SymbolKey_GetSymKey (Aliases, f->string));
+ Output_Write (')');
+ CodeThenDo (n);
+ Indent += 3;
+ CodeFactor (f->next, NULL, n, pge_m2none, inopt, inwhile, TRUE, NULL);
+ CodeEnd (n, t, consumed, f, inopt);
+ break;
+
+ case pge_sub:
+ FlushCode (&codeStack);
+ CodeExpression (f->expr, pge_m2none, inopt, inwhile, consumed, NULL);
+ if (f->next != NULL)
+ {
+ /*
+ * the test above makes sure that we don't emit a RETURN( TRUE )
+ * after a subexpression. Remember sub expressions are not conditional
+ */
+ CodeFactor (f->next, t, n, pge_m2none, inopt, inwhile, TRUE, NULL);
+ }
+ break;
+
+ case pge_opt:
+ FlushCode (&codeStack);
+ CodeExpression (f->expr, pge_m2if, TRUE, inwhile, FALSE, NULL);
+ CodeFactor (f->next, t, n, pge_m2none, inopt, inwhile, consumed, NULL);
+ break;
+
+ case pge_mult:
+ FlushCode (&codeStack);
+ CodeExpression (f->expr, pge_m2while, FALSE, TRUE, consumed, NULL);
+ CodeFactor (f->next, t, n, pge_m2none, inopt, inwhile, consumed, NULL);
+ break;
+
+ case pge_m2:
+ codeStack = ChainOn (codeStack, f);
+ if (consumed || (f->next == NULL))
+ {
+ FlushCode (&codeStack);
+ }
+ CodeFactor (f->next, t, n, pge_m2none, inopt, inwhile, consumed, codeStack);
+ break;
+
+
+ default:
+ break;
+ }
+ }
+}
+
+
+/*
+ CodeTerm -
+*/
+
+static void CodeTerm (pge_TermDesc t, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack)
+{
+ pge_m2condition l;
+
+ l = m;
+ while (t != NULL)
+ {
+ EmitFileLineTag (t->line);
+ if ((t->factor->type == pge_m2) && (m == pge_m2elsif))
+ {
+ m = pge_m2if;
+ IndentString ((const char *) "ELSE", 4);
+ Output_WriteLn ();
+ OnLineStart = TRUE;
+ Indent += 3;
+ CodeFactor (t->factor, t->next, pge_m2none, pge_m2none, inopt, inwhile, consumed, codeStack);
+ Indent -= 3;
+ IndentString ((const char *) "END ;", 5);
+ Output_WriteLn ();
+ OnLineStart = TRUE;
+ }
+ else
+ {
+ CodeFactor (t->factor, t->next, pge_m2none, m, inopt, inwhile, consumed, codeStack);
+ }
+ l = m;
+ if (t->next != NULL)
+ {
+ m = pge_m2elsif;
+ }
+ t = t->next;
+ }
+}
+
+
+/*
+ CodeExpression -
+*/
+
+static void CodeExpression (pge_ExpressionDesc e, pge_m2condition m, unsigned int inopt, unsigned int inwhile, unsigned int consumed, pge_FactorDesc codeStack)
+{
+ if (e != NULL)
+ {
+ EmitFileLineTag (e->line);
+ CodeTerm (e->term, m, inopt, inwhile, consumed, codeStack);
+ }
+}
+
+
+/*
+ CodeStatement -
+*/
+
+static void CodeStatement (pge_StatementDesc s, pge_m2condition m)
+{
+ if (s != NULL)
+ {
+ EmitFileLineTag (s->line);
+ CodeExpression (s->expr, m, FALSE, FALSE, FALSE, NULL);
+ }
+}
+
+
+/*
+ CodeProduction - only encode grammer rules which are not special.
+*/
+
+static void CodeProduction (pge_ProductionDesc p)
+{
+ if ((p != NULL) && (! p->firstsolved || ((p->statement != NULL) && (p->statement->expr != NULL))))
+ {
+ BeginningOfLine = TRUE;
+ Indent = 0;
+ Output_WriteLn ();
+ EmitFileLineTag (p->line);
+ IndentString ((const char *) "PROCEDURE ", 10);
+ Output_WriteKey (GetDefinitionName (p));
+ Output_WriteString ((const char *) " () : BOOLEAN ;", 15);
+ VarProduction (p);
+ Output_WriteLn ();
+ OnLineStart = TRUE;
+ EmitFileLineTag (p->line);
+ IndentString ((const char *) "BEGIN", 5);
+ StrIO_WriteLn ();
+ OnLineStart = FALSE;
+ EmitFileLineTag (p->line);
+ Indent = 3;
+ CodeStatement (p->statement, pge_m2none);
+ Output_WriteLn ();
+ Indent = 0;
+ IndentString ((const char *) "END ", 4);
+ NameKey_WriteKey (GetDefinitionName (p));
+ Output_WriteString ((const char *) " ;", 2);
+ Output_WriteLn ();
+ Output_WriteLn ();
+ Output_WriteLn ();
+ }
+}
+
+
+/*
+ RecoverCondition -
+*/
+
+static void RecoverCondition (pge_m2condition m)
+{
+ switch (m)
+ {
+ case pge_m2if:
+ IndentString ((const char *) "IF ", 3);
+ break;
+
+ case pge_m2none:
+ IndentString ((const char *) "IF ", 3);
+ break;
+
+ case pge_m2elsif:
+ IndentString ((const char *) "ELSIF ", 6);
+ break;
+
+ case pge_m2while:
+ IndentString ((const char *) "WHILE ", 6);
+ break;
+
+
+ default:
+ Debug_Halt ((const char *) "unrecognised m2condition", 24, 3045, (const char *) "m2/gm2-auto/pge.mod", 19);
+ break;
+ }
+}
+
+
+/*
+ ConditionIndent - returns the number of spaces indentation created via, m.
+*/
+
+static unsigned int ConditionIndent (pge_m2condition m)
+{
+ switch (m)
+ {
+ case pge_m2if:
+ return 3;
+ break;
+
+ case pge_m2none:
+ return 3;
+ break;
+
+ case pge_m2elsif:
+ return 6;
+ break;
+
+ case pge_m2while:
+ return 6;
+ break;
+
+
+ default:
+ Debug_Halt ((const char *) "unrecognised m2condition", 24, 3064, (const char *) "m2/gm2-auto/pge.mod", 19);
+ break;
+ }
+ ReturnException ("m2/gm2-auto/pge.mod", 1, 7);
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteGetTokenType - writes out the method of determining the token type.
+*/
+
+static void WriteGetTokenType (void)
+{
+ Output_WriteKey (TokenTypeProc);
+}
+
+
+/*
+ NumberOfElements - returns the number of elements in set, to, which lie between low..high
+*/
+
+static unsigned int NumberOfElements (pge_SetDesc to, unsigned int low, unsigned int high)
+{
+ unsigned int n;
+
+ n = 0;
+ while (to != NULL)
+ {
+ switch (to->type)
+ {
+ case pge_tokel:
+ if ((high == 0) || (IsBetween (to->string, low, high)))
+ {
+ n += 1;
+ }
+ break;
+
+ case pge_litel:
+ if ((high == 0) || (IsBetween (SymbolKey_GetSymKey (Aliases, to->string), low, high)))
+ {
+ n += 1;
+ }
+ break;
+
+ case pge_idel:
+ PushBackInput_WarnError ((const char *) "not expecting ident in first symbol list", 40);
+ WasNoError = FALSE;
+ break;
+
+
+ default:
+ PushBackInput_WarnError ((const char *) "unknown enuneration element", 27);
+ WasNoError = FALSE;
+ break;
+ }
+ to = to->next;
+ }
+ return n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteElement - writes the literal name for element, e.
+*/
+
+static void WriteElement (unsigned int e)
+{
+ Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, e));
+}
+
+
+/*
+ EmitIsInSet - writes out the equivalent of GetTokenType() IN { toset }
+*/
+
+static void EmitIsInSet (pge_SetDesc to, NameKey_Name low, NameKey_Name high)
+{
+ if ((NumberOfElements (to, low, high)) == 1)
+ {
+ WriteGetTokenType ();
+ Output_Write ('=');
+ EmitSet (to, low, high);
+ }
+ else
+ {
+ WriteGetTokenType ();
+ Output_WriteString ((const char *) " IN SetOfStop", 13);
+ if (LargestValue > MaxElementsInSet)
+ {
+ Output_WriteCard (((unsigned int ) (low)) / MaxElementsInSet, 0);
+ }
+ Output_WriteString ((const char *) " {", 2);
+ EmitSet (to, low, high);
+ Output_WriteString ((const char *) "}", 1);
+ }
+}
+
+
+/*
+ EmitIsInSubSet - writes out a test to see whether GetTokenype() is in { subset }
+*/
+
+static void EmitIsInSubSet (pge_SetDesc to, unsigned int low, unsigned int high)
+{
+ if ((NumberOfElements (to, low, high)) == 1)
+ {
+ Output_Write ('(');
+ EmitIsInSet (to, low, high);
+ Output_Write (')');
+ }
+ else if (low == 0)
+ {
+ /* avoid dangling else. */
+ /* no need to check whether GetTokenType > low */
+ Output_WriteString ((const char *) "((", 2);
+ WriteGetTokenType ();
+ Output_Write ('<');
+ WriteElement (static_cast<unsigned int> (((int ) (high))+1));
+ Output_WriteString ((const char *) ") AND (", 7);
+ EmitIsInSet (to, low, high);
+ Output_WriteString ((const char *) "))", 2);
+ }
+ else if (((unsigned int ) (high)) > LargestValue)
+ {
+ /* avoid dangling else. */
+ /* no need to check whether GetTokenType < high */
+ Output_WriteString ((const char *) "((", 2);
+ WriteGetTokenType ();
+ Output_WriteString ((const char *) ">=", 2);
+ WriteElement (low);
+ Output_WriteString ((const char *) ") AND (", 7);
+ EmitIsInSet (to, low, high);
+ Output_WriteString ((const char *) "))", 2);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ Output_WriteString ((const char *) "((", 2);
+ WriteGetTokenType ();
+ Output_WriteString ((const char *) ">=", 2);
+ WriteElement (low);
+ Output_WriteString ((const char *) ") AND (", 7);
+ WriteGetTokenType ();
+ Output_Write ('<');
+ WriteElement (static_cast<unsigned int> (((int ) (high))+1));
+ Output_WriteString ((const char *) ") AND (", 7);
+ EmitIsInSet (to, low, high);
+ Output_WriteString ((const char *) "))", 2);
+ }
+}
+
+
+/*
+ EmitIsInFirst -
+*/
+
+static void EmitIsInFirst (pge_SetDesc to, pge_m2condition m)
+{
+ unsigned int i;
+ unsigned int first;
+
+ if ((NumberOfElements (to, static_cast<unsigned int> (0), static_cast<unsigned int> (0))) == 1)
+ {
+ /* only one element */
+ WriteGetTokenType ();
+ Output_Write ('=');
+ EmitSet (to, static_cast<unsigned int> (0), static_cast<unsigned int> (0));
+ }
+ else
+ {
+ if (LargestValue <= MaxElementsInSet)
+ {
+ Output_Write ('(');
+ WriteGetTokenType ();
+ Output_WriteString ((const char *) " IN ", 4);
+ EmitSetAsParameters (to);
+ Output_WriteString ((const char *) ")", 1);
+ }
+ else
+ {
+ i = 0;
+ first = TRUE;
+ do {
+ if (! (IsEmptySet (to, i*MaxElementsInSet, ((i+1)*MaxElementsInSet)-1)))
+ {
+ if (! first)
+ {
+ Output_WriteString ((const char *) " OR", 3);
+ NewLine (Indent+(ConditionIndent (m)));
+ Indent -= ConditionIndent (m);
+ }
+ EmitIsInSubSet (to, i*MaxElementsInSet, ((i+1)*MaxElementsInSet)-1);
+ first = FALSE;
+ }
+ i += 1;
+ } while (! ((i*MaxElementsInSet) > LargestValue));
+ }
+ }
+}
+
+static void FlushRecoverCode (pge_FactorDesc *codeStack)
+{
+ /*
+ FlushCode -
+ */
+ if ((*codeStack) != NULL)
+ {
+ while ((*codeStack) != NULL)
+ {
+ EmitNonVarCode ((*codeStack)->code, 0, Indent);
+ (*codeStack) = (*codeStack)->pushed;
+ }
+ }
+}
+
+
+/*
+ RecoverFactor -
+*/
+
+static void RecoverFactor (pge_FactorDesc f, pge_m2condition m, pge_FactorDesc codeStack)
+{
+ pge_SetDesc to;
+
+ if (f == NULL)
+ {} /* empty. */
+ else
+ {
+ EmitFileLineTag (f->line);
+ switch (f->type)
+ {
+ case pge_id:
+ to = NULL;
+ CalcFirstFactor (f, NULL, &to);
+ if ((to != NULL) && (m != pge_m2none))
+ {
+ RecoverCondition (m);
+ EmitIsInFirst (to, m);
+ CodeThenDo (m);
+ Indent += 3;
+ }
+ FlushRecoverCode (&codeStack);
+ IndentString ((const char *) "", 0);
+ Output_WriteKey (f->ident->name);
+ Output_Write ('(');
+ EmitStopParametersAndFollow (f, m);
+ Output_WriteString ((const char *) ") ;", 3);
+ Output_WriteLn ();
+ RecoverFactor (f->next, pge_m2none, codeStack);
+ if ((to != NULL) && (m != pge_m2none))
+ {
+ Indent -= 3;
+ }
+ break;
+
+ case pge_lit:
+ if (m == pge_m2none)
+ {
+ FlushRecoverCode (&codeStack);
+ IndentString ((const char *) "Expect(", 7);
+ Output_WriteKey (SymbolKey_GetSymKey (Aliases, f->string));
+ Output_WriteString ((const char *) ", ", 2);
+ EmitStopParametersAndFollow (f, m);
+ Output_WriteString ((const char *) ") ;", 3);
+ Output_WriteLn ();
+ RecoverFactor (f->next, pge_m2none, codeStack);
+ }
+ else
+ {
+ RecoverCondition (m);
+ WriteGetTokenType ();
+ Output_Write ('=');
+ Output_WriteKey (SymbolKey_GetSymKey (Aliases, f->string));
+ CodeThenDo (m);
+ Indent += 3;
+ IndentString ((const char *) "Expect(", 7);
+ Output_WriteKey (SymbolKey_GetSymKey (Aliases, f->string));
+ Output_WriteString ((const char *) ", ", 2);
+ EmitStopParametersAndFollow (f, m);
+ Output_WriteString ((const char *) ") ;", 3);
+ Output_WriteLn ();
+ FlushRecoverCode (&codeStack);
+ RecoverFactor (f->next, pge_m2none, codeStack);
+ Indent -= 3;
+ }
+ break;
+
+ case pge_sub:
+ FlushRecoverCode (&codeStack);
+ RecoverExpression (f->expr, pge_m2none, m);
+ RecoverFactor (f->next, pge_m2none, codeStack);
+ break;
+
+ case pge_opt:
+ FlushRecoverCode (&codeStack);
+ if (OptExpSeen (f))
+ {
+ to = NULL;
+ CalcFirstExpression (f->expr, NULL, &to);
+ RecoverCondition (m);
+ EmitIsInFirst (to, m);
+ CodeThenDo (m);
+ Indent += 3;
+ IndentString ((const char *) "(* seen optional [ | ] expression *)", 36);
+ Output_WriteLn ();
+ stop ();
+ RecoverExpression (f->expr, pge_m2none, pge_m2if);
+ IndentString ((const char *) "(* end of optional [ | ] expression *)", 38);
+ Output_WriteLn ();
+ Indent -= 3;
+ IndentString ((const char *) "END ;", 5);
+ Output_WriteLn ();
+ }
+ else
+ {
+ RecoverExpression (f->expr, pge_m2if, m);
+ }
+ RecoverFactor (f->next, pge_m2none, codeStack);
+ break;
+
+ case pge_mult:
+ FlushRecoverCode (&codeStack);
+ if (((OptExpSeen (f)) || (m == pge_m2if)) || (m == pge_m2elsif))
+ {
+ /* avoid dangling else. */
+ to = NULL;
+ CalcFirstExpression (f->expr, NULL, &to);
+ RecoverCondition (m);
+ EmitIsInFirst (to, m);
+ CodeThenDo (m);
+ Indent += 3;
+ IndentString ((const char *) "(* seen optional { | } expression *)", 36);
+ Output_WriteLn ();
+ RecoverCondition (pge_m2while);
+ EmitIsInFirst (to, pge_m2while);
+ CodeThenDo (pge_m2while);
+ Indent += 3;
+ RecoverExpression (f->expr, pge_m2none, pge_m2while);
+ IndentString ((const char *) "(* end of optional { | } expression *)", 38);
+ Output_WriteLn ();
+ Indent -= 3;
+ IndentString ((const char *) "END ;", 5);
+ Output_WriteLn ();
+ Indent -= 3;
+ if (m == pge_m2none)
+ {
+ IndentString ((const char *) "END ;", 5);
+ Output_WriteLn ();
+ Indent -= 3;
+ }
+ }
+ else
+ {
+ RecoverExpression (f->expr, pge_m2while, m);
+ }
+ RecoverFactor (f->next, pge_m2none, codeStack);
+ break;
+
+ case pge_m2:
+ codeStack = ChainOn (codeStack, f);
+ if (f->next == NULL)
+ {
+ FlushRecoverCode (&codeStack);
+ }
+ else
+ {
+ RecoverFactor (f->next, m, codeStack); /* was m2none */
+ }
+ break;
+
+
+ default:
+ break;
+ }
+ }
+}
+
+
+/*
+ OptExpSeen - returns TRUE if we can see an optional expression in the factor.
+ This is not the same as epsilon. Example { '+' } matches epsilon as
+ well as { '+' | '-' } but OptExpSeen returns TRUE in the second case
+ and FALSE in the first.
+*/
+
+static unsigned int OptExpSeen (pge_FactorDesc f)
+{
+ if (f == NULL)
+ {
+ return FALSE;
+ }
+ else
+ {
+ switch (f->type)
+ {
+ case pge_id:
+ case pge_lit:
+ return FALSE;
+ break;
+
+ case pge_sub:
+ return FALSE; /* is this correct? */
+ break;
+
+ case pge_opt:
+ case pge_mult:
+ return ((f->expr != NULL) && (f->expr->term != NULL)) && (f->expr->term->next != NULL); /* is this correct? */
+ break;
+
+ case pge_m2:
+ return TRUE;
+ break;
+
+
+ default:
+ break;
+ }
+ }
+ PushBackInput_WarnError ((const char *) "all cases were not handled", 26);
+ WasNoError = FALSE;
+ ReturnException ("m2/gm2-auto/pge.mod", 1, 7);
+ __builtin_unreachable ();
+}
+
+
+/*
+ RecoverTerm -
+*/
+
+static void RecoverTerm (pge_TermDesc t, pge_m2condition new_, pge_m2condition old)
+{
+ unsigned int LastWasM2Only;
+ unsigned int alternative;
+ pge_SetDesc to;
+
+ LastWasM2Only = (t->factor->type == pge_m2) && (t->factor->next == NULL); /* does the factor only contain inline code? */
+ to = NULL;
+ CalcFirstTerm (t, NULL, &to);
+ alternative = FALSE;
+ if (t->next != NULL)
+ {
+ new_ = pge_m2if;
+ }
+ while (t != NULL)
+ {
+ EmitFileLineTag (t->line);
+ LastWasM2Only = (t->factor->type == pge_m2) && (t->factor->next == NULL);
+ if ((t->factor->type == pge_m2) && (new_ == pge_m2elsif))
+ {
+ new_ = pge_m2if;
+ IndentString ((const char *) "ELSE", 4);
+ Output_WriteLn ();
+ Indent += 3;
+ RecoverFactor (t->factor, pge_m2none, NULL);
+ alternative = FALSE;
+ }
+ else
+ {
+ RecoverFactor (t->factor, new_, NULL);
+ }
+ if (t->next != NULL)
+ {
+ new_ = pge_m2elsif;
+ alternative = TRUE;
+ }
+ t = t->next;
+ }
+ if ((new_ == pge_m2if) || (new_ == pge_m2elsif))
+ {
+ if (alternative && (old != pge_m2while))
+ {
+ IndentString ((const char *) "ELSE", 4);
+ Output_WriteLn ();
+ Indent += 3;
+ IndentString ((const char *) "", 0);
+ Output_WriteKey (ErrorProcArray);
+ Output_WriteString ((const char *) "('expecting one of: ", 20);
+ EmitSetName (to, static_cast<unsigned int> (0), static_cast<unsigned int> (0));
+ Output_WriteString ((const char *) "')", 2);
+ Output_WriteLn ();
+ Indent -= 3;
+ }
+ else if (LastWasM2Only)
+ {
+ /* avoid dangling else. */
+ Indent -= 3;
+ }
+ IndentString ((const char *) "END ;", 5);
+ Output_WriteLn ();
+ }
+ else if (new_ == pge_m2while)
+ {
+ /* avoid dangling else. */
+ IndentString ((const char *) "END (* while *) ;", 17);
+ Output_WriteLn ();
+ }
+ else if (LastWasM2Only)
+ {
+ /* avoid dangling else. */
+ Indent -= 3;
+ }
+}
+
+
+/*
+ RecoverExpression -
+*/
+
+static void RecoverExpression (pge_ExpressionDesc e, pge_m2condition new_, pge_m2condition old)
+{
+ if (e != NULL)
+ {
+ EmitFileLineTag (e->line);
+ RecoverTerm (e->term, new_, old);
+ }
+}
+
+
+/*
+ RecoverStatement -
+*/
+
+static void RecoverStatement (pge_StatementDesc s, pge_m2condition m)
+{
+ if (s != NULL)
+ {
+ EmitFileLineTag (s->line);
+ RecoverExpression (s->expr, m, pge_m2none);
+ }
+}
+
+
+/*
+ EmitFirstFactor - generate a list of all first tokens between the range: low..high.
+*/
+
+static void EmitFirstFactor (pge_FactorDesc f, unsigned int low, unsigned int high)
+{
+}
+
+
+/*
+ EmitUsed -
+*/
+
+static void EmitUsed (unsigned int wordno)
+{
+ if (! ((((1 << (wordno)) & (ParametersUsed)) != 0)))
+ {
+ Output_WriteString ((const char *) " (* <* unused *> *) ", 20);
+ }
+}
+
+
+/*
+ EmitStopParameters - generate the stop set.
+*/
+
+static void EmitStopParameters (unsigned int FormalParameters)
+{
+ unsigned int i;
+
+ if (LargestValue <= MaxElementsInSet)
+ {
+ Output_WriteString ((const char *) "stopset", 7);
+ if (FormalParameters)
+ {
+ Output_WriteString ((const char *) ": SetOfStop", 11);
+ EmitUsed (0);
+ }
+ else
+ {
+ ParametersUsed |= (1 << (0 ));
+ }
+ }
+ else
+ {
+ i = 0;
+ do {
+ Output_WriteString ((const char *) "stopset", 7);
+ Output_WriteCard (i, 0);
+ if (FormalParameters)
+ {
+ Output_WriteString ((const char *) ": SetOfStop", 11);
+ Output_WriteCard (i, 0);
+ EmitUsed (i);
+ }
+ else
+ {
+ ParametersUsed |= (1 << (i ));
+ }
+ i += 1;
+ if ((i*MaxElementsInSet) < LargestValue)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (FormalParameters)
+ {
+ Output_WriteString ((const char *) "; ", 2);
+ }
+ else
+ {
+ Output_WriteString ((const char *) ", ", 2);
+ }
+ }
+ } while (! ((i*MaxElementsInSet) >= LargestValue));
+ }
+}
+
+
+/*
+ IsBetween - returns TRUE if the value of the token, string, is
+ in the range: low..high
+*/
+
+static unsigned int IsBetween (NameKey_Name string, unsigned int low, unsigned int high)
+{
+ return ((SymbolKey_GetSymKey (Values, string)) >= low) && ((SymbolKey_GetSymKey (Values, string)) <= high);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsEmptySet - returns TRUE if no elements exist in set, to, with values, low..high.
+*/
+
+static unsigned int IsEmptySet (pge_SetDesc to, unsigned int low, unsigned int high)
+{
+ while (to != NULL)
+ {
+ switch (to->type)
+ {
+ case pge_tokel:
+ if (IsBetween (to->string, low, high))
+ {
+ return FALSE;
+ }
+ break;
+
+ case pge_litel:
+ if (IsBetween (SymbolKey_GetSymKey (Aliases, to->string), low, high))
+ {
+ return FALSE;
+ }
+ break;
+
+ case pge_idel:
+ PushBackInput_WarnError ((const char *) "not expecting ident in first symbol list", 40);
+ WasNoError = FALSE;
+ break;
+
+
+ default:
+ PushBackInput_WarnError ((const char *) "unknown enuneration element", 27);
+ WasNoError = FALSE;
+ break;
+ }
+ to = to->next;
+ }
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EmitSet - emits the tokens in the set, to, which have values low..high
+*/
+
+static void EmitSet (pge_SetDesc to, unsigned int low, unsigned int high)
+{
+ unsigned int first;
+
+ first = TRUE;
+ while (to != NULL)
+ {
+ switch (to->type)
+ {
+ case pge_tokel:
+ if ((high == 0) || (IsBetween (to->string, low, high)))
+ {
+ if (! first)
+ {
+ Output_WriteString ((const char *) ", ", 2);
+ }
+ Output_WriteKey (to->string);
+ first = FALSE;
+ }
+ break;
+
+ case pge_litel:
+ if ((high == 0) || (IsBetween (SymbolKey_GetSymKey (Aliases, to->string), low, high)))
+ {
+ if (! first)
+ {
+ Output_WriteString ((const char *) ", ", 2);
+ }
+ Output_WriteKey (SymbolKey_GetSymKey (Aliases, to->string));
+ first = FALSE;
+ }
+ break;
+
+ case pge_idel:
+ PushBackInput_WarnError ((const char *) "not expecting ident in first symbol list", 40);
+ WasNoError = FALSE;
+ break;
+
+
+ default:
+ PushBackInput_WarnError ((const char *) "unknown enuneration element", 27);
+ WasNoError = FALSE;
+ break;
+ }
+ to = to->next;
+ }
+}
+
+
+/*
+ EmitSetName - emits the tokens in the set, to, which have values low..high, using
+ their names.
+*/
+
+static void EmitSetName (pge_SetDesc to, unsigned int low, unsigned int high)
+{
+ while (to != NULL)
+ {
+ switch (to->type)
+ {
+ case pge_tokel:
+ if ((high == 0) || (IsBetween (to->string, low, high)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((NameKey_MakeKey ((const char *) "'", 1)) == (SymbolKey_GetSymKey (ReverseAliases, to->string)))
+ {
+ Output_WriteString ((const char *) "single quote", 12);
+ }
+ else
+ {
+ KeyWord (SymbolKey_GetSymKey (ReverseAliases, to->string));
+ }
+ }
+ break;
+
+ case pge_litel:
+ if ((high == 0) || (IsBetween (SymbolKey_GetSymKey (Aliases, to->string), low, high)))
+ {
+ Output_WriteKey (to->string);
+ }
+ break;
+
+ case pge_idel:
+ PushBackInput_WarnError ((const char *) "not expecting ident in first symbol list", 40);
+ WasNoError = FALSE;
+ break;
+
+
+ default:
+ PushBackInput_WarnError ((const char *) "unknown enuneration element", 27);
+ WasNoError = FALSE;
+ break;
+ }
+ to = to->next;
+ if (to != NULL)
+ {
+ Output_Write (' ');
+ }
+ }
+}
+
+
+/*
+ EmitStopParametersAndSet - generates the stop parameters together with a set
+ inclusion of all the symbols in set, to.
+*/
+
+static void EmitStopParametersAndSet (pge_SetDesc to)
+{
+ unsigned int i;
+
+ if (LargestValue <= MaxElementsInSet)
+ {
+ /* avoid dangling else. */
+ Output_WriteString ((const char *) "stopset", 7);
+ ParametersUsed |= (1 << (0 ));
+ if ((to != NULL) && ((NumberOfElements (to, static_cast<unsigned int> (0), static_cast<unsigned int> (MaxElementsInSet-1))) > 0))
+ {
+ Output_WriteString ((const char *) " + SetOfStop", 12);
+ Output_Write ('{');
+ EmitSet (to, static_cast<unsigned int> (0), static_cast<unsigned int> (MaxElementsInSet-1));
+ Output_Write ('}');
+ }
+ }
+ else
+ {
+ i = 0;
+ do {
+ Output_WriteString ((const char *) "stopset", 7);
+ Output_WriteCard (i, 0);
+ ParametersUsed |= (1 << (i ));
+ if ((to != NULL) && ((NumberOfElements (to, i*MaxElementsInSet, ((i+1)*MaxElementsInSet)-1)) > 0))
+ {
+ Output_WriteString ((const char *) " + SetOfStop", 12);
+ Output_WriteCard (i, 0);
+ Output_Write ('{');
+ EmitSet (to, i*MaxElementsInSet, ((i+1)*MaxElementsInSet)-1);
+ Output_Write ('}');
+ }
+ i += 1;
+ if ((i*MaxElementsInSet) < LargestValue)
+ {
+ Output_WriteString ((const char *) ", ", 2);
+ }
+ } while (! ((i*MaxElementsInSet) >= LargestValue));
+ }
+}
+
+
+/*
+ EmitSetAsParameters - generates the first symbols as parameters to a set function.
+*/
+
+static void EmitSetAsParameters (pge_SetDesc to)
+{
+ unsigned int i;
+
+ if (LargestValue <= MaxElementsInSet)
+ {
+ Output_Write ('{');
+ EmitSet (to, static_cast<unsigned int> (0), static_cast<unsigned int> (MaxElementsInSet-1));
+ }
+ else
+ {
+ i = 0;
+ do {
+ Output_Write ('{');
+ EmitSet (to, i*MaxElementsInSet, ((i+1)*MaxElementsInSet)-1);
+ i += 1;
+ if (((i+1)*MaxElementsInSet) > LargestValue)
+ {
+ Output_WriteString ((const char *) "}, ", 3);
+ }
+ } while (! (((i+1)*MaxElementsInSet) >= LargestValue));
+ }
+ Output_Write ('}');
+}
+
+
+/*
+ EmitStopParametersAndFollow - generates the stop parameters together with a set
+ inclusion of all the follow symbols for subsequent
+ sentances.
+*/
+
+static void EmitStopParametersAndFollow (pge_FactorDesc f, pge_m2condition m)
+{
+ pge_SetDesc to;
+
+ to = NULL;
+ /*
+ IF m=m2while
+ THEN
+ CalcFirstFactor(f, NIL, to)
+ END ;
+ */
+ CollectFollow (&to, f->followinfo);
+ EmitStopParametersAndSet (to);
+ if (Debugging)
+ {
+ Output_WriteLn ();
+ Output_WriteString ((const char *) "factor is: ", 11);
+ PrettyCommentFactor (f, StrLib_StrLen ((const char *) "factor is: ", 11));
+ Output_WriteLn ();
+ Output_WriteString ((const char *) "follow set:", 11);
+ EmitSet (to, static_cast<unsigned int> (0), static_cast<unsigned int> (0));
+ Output_WriteLn ();
+ }
+}
+
+
+/*
+ EmitFirstAsParameters -
+*/
+
+static void EmitFirstAsParameters (pge_FactorDesc f)
+{
+ pge_SetDesc to;
+
+ to = NULL;
+ CalcFirstFactor (f, NULL, &to);
+ EmitSetAsParameters (to);
+}
+
+
+/*
+ RecoverProduction - only encode grammer rules which are not special.
+ Generate error recovery code.
+*/
+
+static void RecoverProduction (pge_ProductionDesc p)
+{
+ DynamicStrings_String s;
+
+ if ((p != NULL) && (! p->firstsolved || ((p->statement != NULL) && (p->statement->expr != NULL))))
+ {
+ BeginningOfLine = TRUE;
+ Indent = 0;
+ Output_WriteLn ();
+ OnLineStart = FALSE;
+ EmitFileLineTag (p->line);
+ IndentString ((const char *) "PROCEDURE ", 10);
+ Output_WriteKey (GetDefinitionName (p));
+ Output_WriteString ((const char *) " (", 2);
+ ParametersUsed = (unsigned int) 0;
+ Output_StartBuffer ();
+ Output_WriteString ((const char *) ") ;", 3);
+ VarProduction (p);
+ Output_WriteLn ();
+ OnLineStart = FALSE;
+ EmitFileLineTag (p->line);
+ Indent = 0;
+ IndentString ((const char *) "BEGIN", 5);
+ Output_WriteLn ();
+ OnLineStart = FALSE;
+ EmitFileLineTag (p->line);
+ Indent = 3;
+ RecoverStatement (p->statement, pge_m2none);
+ Indent = 0;
+ IndentString ((const char *) "END ", 4);
+ Output_WriteKey (GetDefinitionName (p));
+ Output_WriteString ((const char *) " ;", 2);
+ Output_WriteLn ();
+ Output_WriteLn ();
+ Output_WriteLn ();
+ s = Output_EndBuffer ();
+ EmitStopParameters (TRUE);
+ Output_KillWriteS (s);
+ }
+}
+
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch)
+{
+ return ((ch == ' ') || (ch == ASCII_tab)) || (ch == ASCII_lf);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FindStr - returns TRUE if, str, was seen inside the code hunk
+*/
+
+static unsigned int FindStr (pge_CodeHunk *code, unsigned int *i, const char *str_, unsigned int _str_high)
+{
+ unsigned int j;
+ unsigned int k;
+ pge_CodeHunk t;
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ t = (*code);
+ k = (StrLib_StrLen ((const char *) &(*code)->codetext.array[0], MaxCodeHunkLength))+1;
+ while (t != NULL)
+ {
+ do {
+ while ((k > 0) && (IsWhite (t->codetext.array[k-1])))
+ {
+ k -= 1;
+ }
+ if (k == 0)
+ {
+ t = t->next;
+ k = MaxCodeHunkLength+1;
+ }
+ } while (! ((t == NULL) || (! (IsWhite (t->codetext.array[k-1])))));
+ /* found another word check it */
+ if (t != NULL)
+ {
+ j = StrLib_StrLen ((const char *) str, _str_high);
+ (*i) = k;
+ while (((t != NULL) && (j > 0)) && ((str[j-1] == t->codetext.array[k-1]) || ((IsWhite (str[j-1])) && (IsWhite (t->codetext.array[k-1])))))
+ {
+ j -= 1;
+ k -= 1;
+ if (j == 0)
+ {
+ /* found word remember position */
+ (*code) = t;
+ }
+ if (k == 0)
+ {
+ t = t->next;
+ k = MaxCodeHunkLength+1;
+ }
+ }
+ if (k > 0)
+ {
+ k -= 1;
+ }
+ else
+ {
+ t = t->next;
+ }
+ }
+ }
+ return (t == NULL) && (j == 0);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteUpto -
+*/
+
+static void WriteUpto (pge_CodeHunk code, pge_CodeHunk upto, unsigned int limit)
+{
+ if (code != upto)
+ {
+ WriteUpto (code->next, upto, limit);
+ Output_WriteString ((const char *) &code->codetext.array[0], MaxCodeHunkLength);
+ }
+ else
+ {
+ while ((limit <= MaxCodeHunkLength) && (code->codetext.array[limit] != ASCII_nul))
+ {
+ Output_Write (code->codetext.array[limit]);
+ limit += 1;
+ }
+ }
+}
+
+
+/*
+ CheckForVar - checks for any local variables which need to be emitted during
+ this production.
+*/
+
+static void CheckForVar (pge_CodeHunk code)
+{
+ unsigned int i;
+ pge_CodeHunk t;
+
+ t = code;
+ if ((FindStr (&t, &i, (const char *) "VAR", 3)) && EmitCode)
+ {
+ if (! EmittedVar)
+ {
+ Output_WriteLn ();
+ Indent = 0;
+ IndentString ((const char *) "VAR", 3);
+ Indent += 3;
+ Output_WriteLn ();
+ EmittedVar = TRUE;
+ }
+ WriteUpto (code, t, i);
+ }
+}
+
+
+/*
+ VarFactor -
+*/
+
+static void VarFactor (pge_FactorDesc f)
+{
+ while (f != NULL)
+ {
+ switch (f->type)
+ {
+ case pge_id:
+ break;
+
+ case pge_lit:
+ break;
+
+ case pge_sub:
+ case pge_opt:
+ case pge_mult:
+ VarExpression (f->expr);
+ break;
+
+ case pge_m2:
+ CheckForVar (f->code->code);
+ break;
+
+
+ default:
+ break;
+ }
+ f = f->next;
+ }
+}
+
+
+/*
+ VarTerm -
+*/
+
+static void VarTerm (pge_TermDesc t)
+{
+ while (t != NULL)
+ {
+ VarFactor (t->factor);
+ t = t->next;
+ }
+}
+
+
+/*
+ VarExpression -
+*/
+
+static void VarExpression (pge_ExpressionDesc e)
+{
+ if (e != NULL)
+ {
+ VarTerm (e->term);
+ }
+}
+
+
+/*
+ VarStatement -
+*/
+
+static void VarStatement (pge_StatementDesc s)
+{
+ if (s != NULL)
+ {
+ VarExpression (s->expr);
+ }
+}
+
+
+/*
+ VarProduction - writes out all variable declarations.
+*/
+
+static void VarProduction (pge_ProductionDesc p)
+{
+ EmittedVar = FALSE;
+ if (p != NULL)
+ {
+ VarStatement (p->statement);
+ }
+}
+
+
+/*
+ In - returns TRUE if token, s, is already in the set, to.
+*/
+
+static unsigned int In (pge_SetDesc to, NameKey_Name s)
+{
+ while (to != NULL)
+ {
+ switch (to->type)
+ {
+ case pge_idel:
+ if (s == to->ident->name)
+ {
+ return TRUE;
+ }
+ break;
+
+ case pge_tokel:
+ case pge_litel:
+ if (s == to->string)
+ {
+ return TRUE;
+ }
+ break;
+
+
+ default:
+ PushBackInput_WarnError ((const char *) "internal error CASE type not known", 34);
+ WasNoError = FALSE;
+ break;
+ }
+ to = to->next;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IntersectionIsNil - given two set lists, s1, s2, return TRUE if the
+ s1 * s2 = {}
+*/
+
+static unsigned int IntersectionIsNil (pge_SetDesc s1, pge_SetDesc s2)
+{
+ while (s1 != NULL)
+ {
+ switch (s1->type)
+ {
+ case pge_idel:
+ if (In (s2, s1->ident->name))
+ {
+ return FALSE;
+ }
+ break;
+
+ case pge_tokel:
+ case pge_litel:
+ if (In (s2, s1->string))
+ {
+ return FALSE;
+ }
+ break;
+
+
+ default:
+ PushBackInput_WarnError ((const char *) "internal error CASE type not known", 34);
+ WasNoError = FALSE;
+ break;
+ }
+ s1 = s1->next;
+ }
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AddSet - adds a first symbol to a production.
+*/
+
+static void AddSet (pge_SetDesc *to, NameKey_Name s)
+{
+ pge_SetDesc d;
+
+ if (! (In ((*to), s)))
+ {
+ d = NewSetDesc ();
+ d->type = pge_tokel;
+ d->string = s;
+ d->next = (*to);
+ (*to) = d;
+ Finished = FALSE;
+ }
+}
+
+
+/*
+ OrSet -
+*/
+
+static void OrSet (pge_SetDesc *to, pge_SetDesc from)
+{
+ while (from != NULL)
+ {
+ switch (from->type)
+ {
+ case pge_tokel:
+ AddSet (to, from->string);
+ break;
+
+ case pge_litel:
+ AddSet (to, SymbolKey_GetSymKey (Aliases, from->string));
+ break;
+
+ case pge_idel:
+ PushBackInput_WarnError ((const char *) "not expecting ident in first symbol list", 40);
+ WasNoError = FALSE;
+ break;
+
+
+ default:
+ Debug_Halt ((const char *) "unknown element in enumeration type", 35, 4122, (const char *) "m2/gm2-auto/pge.mod", 19);
+ break;
+ }
+ from = from->next;
+ }
+}
+
+
+/*
+ CalcFirstFactor -
+*/
+
+static void CalcFirstFactor (pge_FactorDesc f, pge_ProductionDesc from, pge_SetDesc *to)
+{
+ while (f != NULL)
+ {
+ switch (f->type)
+ {
+ case pge_id:
+ if (f->ident->definition == NULL)
+ {
+ WarnError1 ((const char *) "no rule found for an 'ident' called '%s'", 40, f->ident->name);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ OrSet (to, f->ident->definition->first);
+ if ((GetReachEnd (f->ident->definition->followinfo)) == pge_false)
+ {
+ return ;
+ }
+ break;
+
+ case pge_lit:
+ if ((SymbolKey_GetSymKey (Aliases, f->string)) == SymbolKey_NulKey)
+ {
+ WarnError1 ((const char *) "unknown token for '%s'", 22, f->string);
+ WasNoError = FALSE;
+ }
+ else
+ {
+ AddSet (to, SymbolKey_GetSymKey (Aliases, f->string));
+ }
+ return ;
+ break;
+
+ case pge_sub:
+ case pge_opt:
+ case pge_mult:
+ CalcFirstExpression (f->expr, from, to);
+ break;
+
+ case pge_m2:
+ break;
+
+
+ default:
+ break;
+ }
+ f = f->next;
+ }
+}
+
+
+/*
+ CalcFirstTerm -
+*/
+
+static void CalcFirstTerm (pge_TermDesc t, pge_ProductionDesc from, pge_SetDesc *to)
+{
+ while (t != NULL)
+ {
+ CalcFirstFactor (t->factor, from, to);
+ t = t->next;
+ }
+}
+
+
+/*
+ CalcFirstExpression -
+*/
+
+static void CalcFirstExpression (pge_ExpressionDesc e, pge_ProductionDesc from, pge_SetDesc *to)
+{
+ if (e != NULL)
+ {
+ CalcFirstTerm (e->term, from, to);
+ }
+}
+
+
+/*
+ CalcFirstStatement -
+*/
+
+static void CalcFirstStatement (pge_StatementDesc s, pge_ProductionDesc from, pge_SetDesc *to)
+{
+ if (s != NULL)
+ {
+ CalcFirstExpression (s->expr, from, to);
+ }
+}
+
+
+/*
+ CalcFirstProduction - calculates all of the first symbols for the grammer
+*/
+
+static void CalcFirstProduction (pge_ProductionDesc p, pge_ProductionDesc from, pge_SetDesc *to)
+{
+ pge_SetDesc s;
+
+ if (p != NULL)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (p->firstsolved)
+ {
+ s = p->first;
+ while (s != NULL)
+ {
+ switch (s->type)
+ {
+ case pge_idel:
+ CalcFirstProduction (s->ident->definition, from, to);
+ break;
+
+ case pge_tokel:
+ case pge_litel:
+ AddSet (to, s->string);
+ break;
+
+
+ default:
+ break;
+ }
+ s = s->next;
+ }
+ }
+ else
+ {
+ CalcFirstStatement (p->statement, from, to);
+ }
+ }
+}
+
+static void WorkOutFollowFactor (pge_FactorDesc f, pge_SetDesc *followset, pge_SetDesc after)
+{
+ pge_TraverseResult foundepsilon;
+ pge_TraverseResult canreachend;
+
+ /*
+ WorkOutFollow -
+ */
+ foundepsilon = pge_true;
+ canreachend = pge_true;
+ while ((f != NULL) && (foundepsilon == pge_true))
+ {
+ switch (f->type)
+ {
+ case pge_id:
+ if (f->ident->definition == NULL)
+ {
+ WarnError1 ((const char *) "no rule found for an 'ident' called '%s'", 40, f->ident->name);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ OrSet (followset, f->ident->definition->first);
+ break;
+
+ case pge_lit:
+ AddSet (followset, SymbolKey_GetSymKey (Aliases, f->string));
+ break;
+
+ case pge_sub:
+ WorkOutFollowExpression (f->expr, followset, NULL);
+ break;
+
+ case pge_opt:
+ WorkOutFollowExpression (f->expr, followset, NULL);
+ break;
+
+ case pge_mult:
+ WorkOutFollowExpression (f->expr, followset, NULL);
+ break;
+
+ case pge_m2:
+ break;
+
+
+ default:
+ break;
+ }
+ if ((GetEpsilon (f->followinfo)) == pge_unknown)
+ {
+ PushBackInput_WarnError ((const char *) "internal error: epsilon unknown", 31);
+ PrettyCommentFactor (f, 3);
+ WasNoError = FALSE;
+ }
+ foundepsilon = GetEpsilon (f->followinfo);
+ canreachend = GetReachEnd (f->followinfo); /* only goes from FALSE -> TRUE */
+ f = f->next; /* only goes from FALSE -> TRUE */
+ }
+ if (canreachend == pge_true)
+ {
+ OrSet (followset, after);
+ }
+}
+
+
+/*
+ WorkOutFollowTerm -
+*/
+
+static void WorkOutFollowTerm (pge_TermDesc t, pge_SetDesc *followset, pge_SetDesc after)
+{
+ if (t != NULL)
+ {
+ while (t != NULL)
+ {
+ WorkOutFollowFactor (t->factor, followset, after); /* { '|' Term } */
+ t = t->next; /* { '|' Term } */
+ }
+ }
+}
+
+
+/*
+ WorkOutFollowExpression -
+*/
+
+static void WorkOutFollowExpression (pge_ExpressionDesc e, pge_SetDesc *followset, pge_SetDesc after)
+{
+ if (e != NULL)
+ {
+ WorkOutFollowTerm (e->term, followset, after);
+ }
+}
+
+
+/*
+ CollectFollow - collects the follow set from, f, into, to.
+*/
+
+static void CollectFollow (pge_SetDesc *to, pge_FollowDesc f)
+{
+ OrSet (to, f->follow);
+}
+
+
+/*
+ CalcFollowFactor -
+*/
+
+static void CalcFollowFactor (pge_FactorDesc f, pge_SetDesc after)
+{
+ while (f != NULL)
+ {
+ switch (f->type)
+ {
+ case pge_id:
+ WorkOutFollowFactor (f->next, &f->followinfo->follow, after);
+ break;
+
+ case pge_lit:
+ WorkOutFollowFactor (f->next, &f->followinfo->follow, after);
+ break;
+
+ case pge_opt:
+ case pge_sub:
+ CalcFirstFactor (f->next, NULL, &f->followinfo->follow);
+ if ((f->next == NULL) || ((GetReachEnd (f->next->followinfo)) == pge_true))
+ {
+ OrSet (&f->followinfo->follow, after);
+ CalcFollowExpression (f->expr, f->followinfo->follow);
+ }
+ else
+ {
+ CalcFollowExpression (f->expr, f->followinfo->follow);
+ }
+ break;
+
+ case pge_mult:
+ CalcFirstFactor (f, NULL, &f->followinfo->follow);
+ /* include first as we may repeat this sentance */
+ if (Debugging)
+ {
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) "found mult: and first is: ", 26);
+ EmitSet (f->followinfo->follow, static_cast<unsigned int> (0), static_cast<unsigned int> (0));
+ StrIO_WriteLn ();
+ }
+ if ((f->next == NULL) || ((GetReachEnd (f->next->followinfo)) == pge_true))
+ {
+ OrSet (&f->followinfo->follow, after);
+ CalcFollowExpression (f->expr, f->followinfo->follow);
+ }
+ else
+ {
+ CalcFollowExpression (f->expr, f->followinfo->follow);
+ }
+ break;
+
+
+ default:
+ break;
+ }
+ f = f->next;
+ }
+}
+
+
+/*
+ CalcFollowTerm -
+*/
+
+static void CalcFollowTerm (pge_TermDesc t, pge_SetDesc after)
+{
+ if (t != NULL)
+ {
+ while (t != NULL)
+ {
+ CalcFollowFactor (t->factor, after); /* { '|' Term } */
+ t = t->next; /* { '|' Term } */
+ }
+ }
+}
+
+
+/*
+ CalcFollowExpression -
+*/
+
+static void CalcFollowExpression (pge_ExpressionDesc e, pge_SetDesc after)
+{
+ if (e != NULL)
+ {
+ CalcFollowTerm (e->term, after);
+ }
+}
+
+
+/*
+ CalcFollowStatement - given a bnf statement generate the follow set.
+*/
+
+static void CalcFollowStatement (pge_StatementDesc s)
+{
+ if (s != NULL)
+ {
+ CalcFollowExpression (s->expr, NULL);
+ }
+}
+
+
+/*
+ CalcFollowProduction -
+*/
+
+static void CalcFollowProduction (pge_ProductionDesc p)
+{
+ if (p != NULL)
+ {
+ CalcFollowStatement (p->statement);
+ }
+}
+
+
+/*
+ CalcEpsilonFactor -
+*/
+
+static void CalcEpsilonFactor (pge_FactorDesc f)
+{
+ while (f != NULL)
+ {
+ switch (f->type)
+ {
+ case pge_id:
+ AssignEpsilon ((GetEpsilon (f->ident->definition->followinfo)) != pge_unknown, f->followinfo, GetEpsilon (f->ident->definition->followinfo));
+ break;
+
+ case pge_lit:
+ AssignEpsilon (TRUE, f->followinfo, pge_false);
+ break;
+
+ case pge_sub:
+ CalcEpsilonExpression (f->expr);
+ AssignEpsilon ((GetEpsilon (f->expr->followinfo)) != pge_unknown, f->followinfo, GetEpsilon (f->expr->followinfo));
+ break;
+
+ case pge_m2:
+ AssignEpsilon (TRUE, f->followinfo, pge_true);
+ break;
+
+ case pge_opt:
+ case pge_mult:
+ CalcEpsilonExpression (f->expr);
+ AssignEpsilon (TRUE, f->followinfo, pge_true);
+ break;
+
+
+ default:
+ break;
+ }
+ f = f->next;
+ }
+}
+
+
+/*
+ CalcEpsilonTerm -
+*/
+
+static void CalcEpsilonTerm (pge_TermDesc t)
+{
+ if (t != NULL)
+ {
+ while (t != NULL)
+ {
+ if (t->factor != NULL)
+ {
+ switch (GetReachEnd (t->factor->followinfo))
+ {
+ case pge_true:
+ AssignEpsilon (TRUE, t->followinfo, pge_true);
+ break;
+
+ case pge_false:
+ AssignEpsilon (TRUE, t->followinfo, pge_false);
+ break;
+
+ case pge_unknown:
+ break;
+
+
+ default:
+ break;
+ }
+ }
+ CalcEpsilonFactor (t->factor); /* { '|' Term } */
+ t = t->next;
+ }
+ }
+}
+
+
+/*
+ CalcEpsilonExpression -
+*/
+
+static void CalcEpsilonExpression (pge_ExpressionDesc e)
+{
+ pge_TermDesc t;
+ pge_TraverseResult result;
+
+ if (e != NULL)
+ {
+ CalcEpsilonTerm (e->term);
+ if ((GetEpsilon (e->followinfo)) == pge_unknown)
+ {
+ result = pge_unknown;
+ t = e->term;
+ while (t != NULL)
+ {
+ if ((GetEpsilon (t->followinfo)) != pge_unknown)
+ {
+ stop ();
+ }
+ switch (GetEpsilon (t->followinfo))
+ {
+ case pge_unknown:
+ break;
+
+ case pge_true:
+ result = pge_true;
+ break;
+
+ case pge_false:
+ if (result != pge_true)
+ {
+ result = pge_false;
+ }
+ break;
+
+
+ default:
+ break;
+ }
+ t = t->next;
+ }
+ AssignEpsilon (result != pge_unknown, e->followinfo, result);
+ }
+ }
+}
+
+
+/*
+ CalcEpsilonStatement - given a bnf statement generate the follow set.
+*/
+
+static void CalcEpsilonStatement (pge_StatementDesc s)
+{
+ if (s != NULL)
+ {
+ if (s->expr != NULL)
+ {
+ AssignEpsilon ((GetEpsilon (s->expr->followinfo)) != pge_unknown, s->followinfo, GetEpsilon (s->expr->followinfo));
+ }
+ CalcEpsilonExpression (s->expr);
+ }
+}
+
+
+/*
+ CalcEpsilonProduction -
+*/
+
+static void CalcEpsilonProduction (pge_ProductionDesc p)
+{
+ if (p != NULL)
+ {
+ /*
+ IF p^.statement^.ident^.name=MakeKey('DefinitionModule')
+ THEN
+ stop
+ END ;
+ */
+ if (Debugging)
+ {
+ NameKey_WriteKey (p->statement->ident->name);
+ StrIO_WriteString ((const char *) " calculating epsilon", 21);
+ StrIO_WriteLn ();
+ }
+ AssignEpsilon ((GetEpsilon (p->statement->followinfo)) != pge_unknown, p->followinfo, GetEpsilon (p->statement->followinfo));
+ CalcEpsilonStatement (p->statement);
+ }
+}
+
+
+/*
+ CalcReachEndFactor -
+*/
+
+static pge_TraverseResult CalcReachEndFactor (pge_FactorDesc f)
+{
+ pge_TraverseResult canreachend;
+ pge_TraverseResult result;
+
+ if (f == NULL)
+ {
+ return pge_true; /* we have reached the end of this factor list */
+ }
+ else
+ {
+ /* we need to traverse all factors even if we can short cut the answer to this list of factors */
+ result = CalcReachEndFactor (f->next);
+ switch (f->type)
+ {
+ case pge_id:
+ if (f->ident->definition == NULL)
+ {
+ WarnError1 ((const char *) "definition for %s is absent (assuming epsilon is false for this production)", 75, f->ident->name);
+ result = pge_false;
+ }
+ else if (result != pge_false)
+ {
+ /* avoid dangling else. */
+ switch (GetReachEnd (f->ident->definition->followinfo))
+ {
+ case pge_false:
+ result = pge_false;
+ break;
+
+ case pge_true:
+ break;
+
+ case pge_unknown:
+ result = pge_unknown;
+ break;
+
+
+ default:
+ break;
+ }
+ }
+ break;
+
+ case pge_lit:
+ result = pge_false;
+ break;
+
+ case pge_sub:
+ CalcReachEndExpression (f->expr);
+ if ((f->expr != NULL) && (result == pge_true))
+ {
+ result = GetReachEnd (f->expr->followinfo);
+ }
+ break;
+
+ case pge_mult:
+ case pge_opt:
+ if (f->expr != NULL)
+ {
+ /* not interested in the result as expression is optional */
+ CalcReachEndExpression (f->expr);
+ }
+ break;
+
+ case pge_m2:
+ break;
+
+
+ default:
+ break;
+ }
+ AssignReachEnd (result != pge_unknown, f->followinfo, result);
+ return result;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CalcReachEndTerm -
+*/
+
+static pge_TraverseResult CalcReachEndTerm (pge_TermDesc t)
+{
+ pge_TraverseResult canreachend;
+ pge_TraverseResult result;
+
+ if (t != NULL)
+ {
+ canreachend = pge_false;
+ while (t != NULL)
+ {
+ result = CalcReachEndFactor (t->factor);
+ AssignReachEnd (result != pge_unknown, t->followinfo, result);
+ switch (result)
+ {
+ case pge_true:
+ canreachend = pge_true;
+ break;
+
+ case pge_false:
+ break;
+
+ case pge_unknown:
+ if (canreachend == pge_false)
+ {
+ canreachend = pge_unknown;
+ }
+ break;
+
+
+ default:
+ break;
+ }
+ t = t->next; /* { '|' Term } */
+ }
+ return canreachend;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CalcReachEndExpression -
+*/
+
+static void CalcReachEndExpression (pge_ExpressionDesc e)
+{
+ pge_TraverseResult result;
+
+ if (e == NULL)
+ {} /* empty. */
+ else
+ {
+ /* no expression, thus reached the end of this sentance */
+ result = CalcReachEndTerm (e->term);
+ AssignReachEnd (result != pge_unknown, e->followinfo, result);
+ }
+}
+
+
+/*
+ CalcReachEndStatement -
+*/
+
+static void CalcReachEndStatement (pge_StatementDesc s)
+{
+ if (s != NULL)
+ {
+ if (s->expr != NULL)
+ {
+ CalcReachEndExpression (s->expr);
+ AssignReachEnd ((GetReachEnd (s->expr->followinfo)) != pge_unknown, s->followinfo, GetReachEnd (s->expr->followinfo));
+ }
+ }
+}
+
+
+/*
+ CalcReachEndStatement -
+*/
+
+static void stop (void)
+{
+}
+
+
+/*
+ CalcReachEndProduction -
+*/
+
+static void CalcReachEndProduction (pge_ProductionDesc p)
+{
+ if (p != NULL)
+ {
+ CalcReachEndStatement (p->statement);
+ if ((GetReachEnd (p->followinfo)) != pge_unknown)
+ {
+ if (Debugging)
+ {
+ StrIO_WriteString ((const char *) "already calculated reach end for: ", 34);
+ NameKey_WriteKey (p->statement->ident->name);
+ StrIO_WriteString ((const char *) " its value is ", 14);
+ if ((GetReachEnd (p->followinfo)) == pge_true)
+ {
+ StrIO_WriteString ((const char *) "reachable", 9);
+ }
+ else
+ {
+ StrIO_WriteString ((const char *) "non reachable", 13);
+ }
+ StrIO_WriteLn ();
+ }
+ }
+ AssignReachEnd ((GetReachEnd (p->statement->followinfo)) != pge_unknown, p->followinfo, GetReachEnd (p->statement->followinfo));
+ }
+}
+
+
+/*
+ EmptyFactor -
+*/
+
+static unsigned int EmptyFactor (pge_FactorDesc f)
+{
+ while (f != NULL)
+ {
+ switch (f->type)
+ {
+ case pge_id:
+ if (! (EmptyProduction (f->ident->definition)))
+ {
+ return FALSE;
+ }
+ break;
+
+ case pge_lit:
+ return FALSE;
+ break;
+
+ case pge_sub:
+ if (! (EmptyExpression (f->expr)))
+ {
+ return FALSE;
+ }
+ break;
+
+ case pge_opt:
+ case pge_mult:
+ return TRUE;
+ break;
+
+ case pge_m2:
+ break;
+
+
+ default:
+ break;
+ }
+ f = f->next;
+ }
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EmptyTerm - returns TRUE if the term maybe empty.
+*/
+
+static unsigned int EmptyTerm (pge_TermDesc t)
+{
+ while (t != NULL)
+ {
+ if (EmptyFactor (t->factor))
+ {
+ return TRUE;
+ }
+ else
+ {
+ t = t->next;
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EmptyExpression -
+*/
+
+static unsigned int EmptyExpression (pge_ExpressionDesc e)
+{
+ if (e == NULL)
+ {
+ return TRUE;
+ }
+ else
+ {
+ return EmptyTerm (e->term);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EmptyStatement - returns TRUE if statement, s, is empty.
+*/
+
+static unsigned int EmptyStatement (pge_StatementDesc s)
+{
+ if (s == NULL)
+ {
+ return TRUE;
+ }
+ else
+ {
+ return EmptyExpression (s->expr);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EmptyProduction - returns if production, p, maybe empty.
+*/
+
+static unsigned int EmptyProduction (pge_ProductionDesc p)
+{
+ if (p == NULL)
+ {
+ PushBackInput_WarnError ((const char *) "unknown production", 18);
+ return TRUE;
+ }
+ else if (p->firstsolved && (p->first != NULL))
+ {
+ /* avoid dangling else. */
+ /* predefined but first set to something - thus not empty */
+ return FALSE;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return EmptyStatement (p->statement);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EmitFDLNotice -
+*/
+
+static void EmitFDLNotice (void)
+{
+ Output_WriteString ((const char *) "@c Copyright (C) 2000-2023 Free Software Foundation, Inc.", 57);
+ Output_WriteLn ();
+ Output_WriteLn ();
+ Output_WriteString ((const char *) "@c This file is part of GCC.", 28);
+ Output_WriteLn ();
+ Output_WriteString ((const char *) "@c Permission is granted to copy, distribute and/or modify this document", 72);
+ Output_WriteLn ();
+ Output_WriteString ((const char *) "@c under the terms of the GNU Free Documentation License, Version 1.2 or", 72);
+ Output_WriteLn ();
+ Output_WriteString ((const char *) "@c any later version published by the Free Software Foundation.", 63);
+ Output_WriteLn ();
+}
+
+
+/*
+ EmitRules - generates the BNF rules.
+*/
+
+static void EmitRules (void)
+{
+ if (Texinfo && FreeDocLicense)
+ {
+ EmitFDLNotice ();
+ }
+ ForeachRuleDo ((pge_DoProcedure) {(pge_DoProcedure_t) EmitRule});
+}
+
+
+/*
+ DescribeElement -
+*/
+
+static void DescribeElement (unsigned int name)
+{
+ NameKey_Name lit;
+
+ if (InitialElement)
+ {
+ InitialElement = FALSE;
+ }
+ else
+ {
+ Output_WriteString ((const char *) " |", 2);
+ }
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "", 0);
+ Output_WriteKey (name);
+ Output_WriteString ((const char *) ": ", 2);
+ lit = static_cast<NameKey_Name> (SymbolKey_GetSymKey (ReverseAliases, name));
+ if ((NameKey_MakeKey ((const char *) "\"", 1)) == lit)
+ {
+ Output_WriteString ((const char *) "str := ConCat(ConCatChar(ConCatChar(InitString(\"syntax error, found ", 68);
+ Output_Write ('\'');
+ Output_WriteString ((const char *) "\"), ", 4);
+ Output_Write ('\'');
+ Output_Write ('"');
+ Output_Write ('\'');
+ Output_WriteString ((const char *) "), ", 3);
+ Output_Write ('"');
+ Output_Write ('\'');
+ Output_Write ('"');
+ Output_WriteString ((const char *) "), Mark(str))", 13);
+ }
+ else if ((NameKey_MakeKey ((const char *) "'", 1)) == lit)
+ {
+ /* avoid dangling else. */
+ Output_WriteString ((const char *) "str := ConCat(ConCatChar(ConCatChar(InitString('syntax error, found ", 68);
+ Output_Write ('"');
+ Output_WriteString ((const char *) "'), ", 4);
+ Output_Write ('"');
+ Output_Write ('\'');
+ Output_Write ('"');
+ Output_WriteString ((const char *) "), ", 3);
+ Output_Write ('\'');
+ Output_Write ('"');
+ Output_Write ('\'');
+ Output_WriteString ((const char *) "), Mark(str))", 13);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ Output_WriteString ((const char *) "str := ConCat(InitString(", 25);
+ Output_Write ('"');
+ Output_WriteString ((const char *) "syntax error, found ", 20);
+ KeyWord (lit);
+ Output_WriteString ((const char *) "\"), Mark(str))", 14);
+ }
+}
+
+
+/*
+ EmitInTestStop - construct a test for stop element, name.
+*/
+
+static void EmitInTestStop (NameKey_Name name)
+{
+ unsigned int i;
+ unsigned int value;
+
+ if (LargestValue <= MaxElementsInSet)
+ {
+ Output_WriteKey (name);
+ Output_WriteString ((const char *) " IN stopset", 11);
+ ParametersUsed |= (1 << (0 ));
+ }
+ else
+ {
+ value = static_cast<unsigned int> (SymbolKey_GetSymKey (Values, name));
+ i = value / MaxElementsInSet;
+ Output_WriteKey (name);
+ Output_WriteString ((const char *) " IN stopset", 11);
+ Output_WriteCard (i, 0);
+ ParametersUsed |= (1 << (i ));
+ }
+}
+
+
+/*
+ DescribeStopElement -
+*/
+
+static void DescribeStopElement (unsigned int name)
+{
+ NameKey_Name lit;
+
+ Indent = 3;
+ IndentString ((const char *) "IF ", 3);
+ EmitInTestStop (name);
+ Output_WriteLn ();
+ IndentString ((const char *) "THEN", 4);
+ Output_WriteLn ();
+ Indent = 6;
+ lit = static_cast<NameKey_Name> (SymbolKey_GetSymKey (ReverseAliases, name));
+ if ((lit == NameKey_NulName) || (lit == (NameKey_MakeKey ((const char *) "", 0))))
+ {
+ IndentString ((const char *) "(* ", 3);
+ Output_WriteKey (name);
+ Output_WriteString ((const char *) " has no token name (needed to generate error messages) *)", 57);
+ }
+ else if ((NameKey_MakeKey ((const char *) "'", 1)) == lit)
+ {
+ /* avoid dangling else. */
+ IndentString ((const char *) "message := ConCatChar(ConCatChar(ConCatChar(ConCatChar(ConCatChar(message, ", 75);
+ Output_WriteString ((const char *) "' '), ", 6);
+ Output_Write ('\'');
+ Output_Write ('"');
+ Output_WriteString ((const char *) "'), ", 4);
+ Output_Write ('"');
+ Output_Write ('\'');
+ Output_WriteString ((const char *) "\"), ", 4);
+ Output_Write ('\'');
+ Output_Write ('"');
+ Output_WriteString ((const char *) "'), ',') ; INC(n) ; ", 20);
+ }
+ else if ((NameKey_MakeKey ((const char *) "\"", 1)) == lit)
+ {
+ /* avoid dangling else. */
+ IndentString ((const char *) "message := ConCatChar(ConCatChar(ConCatChar(ConCatChar(ConCatChar(message, ", 75);
+ Output_WriteString ((const char *) "\" \"), ", 6);
+ Output_Write ('"');
+ Output_Write ('`');
+ Output_WriteString ((const char *) "\"), ", 4);
+ Output_Write ('\'');
+ Output_Write ('"');
+ Output_WriteString ((const char *) "'), ", 4);
+ Output_Write ('"');
+ Output_Write ('\'');
+ Output_WriteString ((const char *) "\"), \",\") ; INC(n) ; ", 20);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ IndentString ((const char *) "message := ConCat(ConCatChar(message, ' ", 40);
+ Output_WriteString ((const char *) "'), ", 4);
+ Output_WriteString ((const char *) "Mark(InitString(\"", 17);
+ KeyWord (lit);
+ Output_Write ('"');
+ Output_WriteString ((const char *) "))) ; INC(n)", 12);
+ }
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "END ;", 5);
+ Output_WriteLn ();
+}
+
+
+/*
+ EmitDescribeStop -
+*/
+
+static void EmitDescribeStop (void)
+{
+ DynamicStrings_String s;
+
+ Output_WriteLn ();
+ Indent = 0;
+ IndentString ((const char *) "(*", 2);
+ Indent = 3;
+ Output_WriteLn ();
+ IndentString ((const char *) "DescribeStop - issues a message explaining what tokens were expected", 68);
+ Output_WriteLn ();
+ Output_WriteString ((const char *) "*)", 2);
+ Output_WriteLn ();
+ Output_WriteLn ();
+ Indent = 0;
+ IndentString ((const char *) "PROCEDURE DescribeStop (", 24);
+ ParametersUsed = (unsigned int) 0;
+ Output_StartBuffer ();
+ Output_WriteString ((const char *) ") : String ;", 12);
+ Output_WriteLn ();
+ IndentString ((const char *) "VAR", 3);
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "n : CARDINAL ;", 19);
+ Output_WriteLn ();
+ IndentString ((const char *) "str,", 4);
+ Output_WriteLn ();
+ IndentString ((const char *) "message: String ;", 17);
+ Output_WriteLn ();
+ Indent = 0;
+ IndentString ((const char *) "BEGIN", 5);
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "n := 0 ;", 8);
+ Output_WriteLn ();
+ IndentString ((const char *) "message := InitString('') ;", 27);
+ Output_WriteLn ();
+ SymbolKey_ForeachNodeDo (Aliases, (SymbolKey_PerformOperation) {(SymbolKey_PerformOperation_t) DescribeStopElement});
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "IF n=0", 6);
+ Output_WriteLn ();
+ IndentString ((const char *) "THEN", 4);
+ Output_WriteLn ();
+ Indent = 6;
+ IndentString ((const char *) "str := InitString(' syntax error') ; ", 37);
+ Output_WriteLn ();
+ IndentString ((const char *) "message := KillString(message) ; ", 33);
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "ELSIF n=1", 9);
+ Output_WriteLn ();
+ IndentString ((const char *) "THEN", 4);
+ Output_WriteLn ();
+ Indent = 6;
+ IndentString ((const char *) "str := ConCat(message, Mark(InitString(' missing '))) ;", 55);
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "ELSE", 4);
+ Output_WriteLn ();
+ Indent = 6;
+ IndentString ((const char *) "str := ConCat(InitString(' expecting one of'), message) ;", 57);
+ Output_WriteLn ();
+ IndentString ((const char *) "message := KillString(message) ;", 32);
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "END ;", 5);
+ Output_WriteLn ();
+ IndentString ((const char *) "RETURN( str )", 13);
+ Output_WriteLn ();
+ Indent = 0;
+ IndentString ((const char *) "END DescribeStop ;", 18);
+ Output_WriteLn ();
+ Output_WriteLn ();
+ s = Output_EndBuffer ();
+ EmitStopParameters (TRUE);
+ Output_KillWriteS (s);
+}
+
+
+/*
+ EmitDescribeError -
+*/
+
+static void EmitDescribeError (void)
+{
+ Output_WriteLn ();
+ Indent = 0;
+ IndentString ((const char *) "(*", 2);
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "DescribeError - issues a message explaining what tokens were expected", 69);
+ Output_WriteLn ();
+ Indent = 0;
+ IndentString ((const char *) "*)", 2);
+ Output_WriteLn ();
+ Output_WriteLn ();
+ IndentString ((const char *) "PROCEDURE DescribeError ;", 25);
+ Output_WriteLn ();
+ IndentString ((const char *) "VAR", 3);
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "str: String ;", 13);
+ Output_WriteLn ();
+ Indent = 0;
+ IndentString ((const char *) "BEGIN", 5);
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "str := InitString('') ;", 23);
+ Output_WriteLn ();
+ /* was
+ IndentString('str := DescribeStop(') ; EmitStopParameters(FALSE) ; Output.WriteString(') ;') ; Output.WriteLn ;
+ */
+ IndentString ((const char *) "CASE ", 5);
+ WriteGetTokenType ();
+ Output_WriteString ((const char *) " OF", 3);
+ NewLine (3);
+ InitialElement = TRUE;
+ SymbolKey_ForeachNodeDo (Aliases, (SymbolKey_PerformOperation) {(SymbolKey_PerformOperation_t) DescribeElement});
+ Output_WriteLn ();
+ Indent = 3;
+ IndentString ((const char *) "ELSE", 4);
+ Output_WriteLn ();
+ IndentString ((const char *) "END ;", 5);
+ Output_WriteLn ();
+ IndentString ((const char *) "", 0);
+ Output_WriteKey (ErrorProcString);
+ Output_WriteString ((const char *) "(str) ;", 7);
+ Output_WriteLn ();
+ Indent = 0;
+ IndentString ((const char *) "END DescribeError ;", 19);
+ Output_WriteLn ();
+}
+
+
+/*
+ EmitSetTypes - write out the set types used during error recovery
+*/
+
+static void EmitSetTypes (void)
+{
+ unsigned int i;
+ unsigned int j;
+ unsigned int m;
+ unsigned int n;
+
+ Output_WriteString ((const char *) "(*", 2);
+ NewLine (3);
+ Output_WriteString ((const char *) "expecting token set defined as an enumerated type", 49);
+ NewLine (3);
+ Output_WriteString ((const char *) "(", 1);
+ i = 0;
+ while (i < LargestValue)
+ {
+ Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, (unsigned int ) (i)));
+ i += 1;
+ if (i < LargestValue)
+ {
+ Output_WriteString ((const char *) ", ", 2);
+ }
+ }
+ Output_WriteString ((const char *) ") ;", 3);
+ NewLine (0);
+ Output_WriteString ((const char *) "*)", 2);
+ NewLine (0);
+ Output_WriteString ((const char *) "TYPE", 4);
+ NewLine (3);
+ if (LargestValue > MaxElementsInSet)
+ {
+ i = 0;
+ n = LargestValue / MaxElementsInSet;
+ while (i <= n)
+ {
+ j = i*MaxElementsInSet;
+ if (LargestValue < (((i+1)*MaxElementsInSet)-1))
+ {
+ m = LargestValue-1;
+ }
+ else
+ {
+ m = ((i+1)*MaxElementsInSet)-1;
+ }
+ Output_WriteString ((const char *) "stop", 4);
+ Output_WriteCard (i, 0);
+ Output_WriteString ((const char *) " = [", 4);
+ Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, (unsigned int ) (j)));
+ Output_WriteString ((const char *) "..", 2);
+ Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, (unsigned int ) (m)));
+ Output_WriteString ((const char *) "] ;", 3);
+ NewLine (3);
+ Output_WriteString ((const char *) "SetOfStop", 9);
+ Output_WriteCard (i, 0);
+ Output_WriteString ((const char *) " = SET OF stop", 14);
+ Output_WriteCard (i, 0);
+ Output_WriteString ((const char *) " ;", 2);
+ NewLine (3);
+ i += 1;
+ }
+ }
+ else
+ {
+ Output_WriteString ((const char *) "SetOfStop", 9);
+ Output_WriteString ((const char *) " = SET OF [", 11);
+ Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, (unsigned int ) (0)));
+ Output_WriteString ((const char *) "..", 2);
+ Output_WriteKey (SymbolKey_GetSymKey (ReverseValues, (unsigned int ) (LargestValue-1)));
+ Output_WriteString ((const char *) "] ;", 3);
+ }
+ NewLine (0);
+}
+
+
+/*
+ EmitSupport - generates the support routines.
+*/
+
+static void EmitSupport (void)
+{
+ if (ErrorRecovery)
+ {
+ EmitSetTypes ();
+ EmitDescribeStop ();
+ EmitDescribeError ();
+ }
+}
+
+
+/*
+ DisposeSetDesc - dispose of the set list, s.
+*/
+
+static void DisposeSetDesc (pge_SetDesc *s)
+{
+ pge_SetDesc h;
+ pge_SetDesc n;
+
+ if ((*s) != NULL)
+ {
+ h = (*s);
+ n = (*s)->next;
+ do {
+ Storage_DEALLOCATE ((void **) &h, sizeof (pge__T7));
+ h = n;
+ if (n != NULL)
+ {
+ n = n->next;
+ }
+ } while (! (h == NULL));
+ (*s) = NULL;
+ }
+}
+
+
+/*
+ OptionalFactor -
+*/
+
+static unsigned int OptionalFactor (pge_FactorDesc f)
+{
+ while (f != NULL)
+ {
+ switch (f->type)
+ {
+ case pge_id:
+ break;
+
+ case pge_lit:
+ break;
+
+ case pge_sub:
+ case pge_opt:
+ case pge_mult:
+ if (OptionalExpression (f->expr))
+ {
+ return TRUE;
+ }
+ break;
+
+ case pge_m2:
+ break;
+
+
+ default:
+ break;
+ }
+ f = f->next;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OptionalTerm - returns TRUE if the term maybe empty.
+*/
+
+static unsigned int OptionalTerm (pge_TermDesc t)
+{
+ pge_TermDesc u;
+ pge_TermDesc v;
+ pge_SetDesc tov;
+ pge_SetDesc tou;
+
+ u = t;
+ while (u != NULL)
+ {
+ if (OptionalFactor (u->factor))
+ {
+ return TRUE;
+ }
+ v = t;
+ tou = NULL;
+ CalcFirstFactor (u->factor, NULL, &tou);
+ while (v != NULL)
+ {
+ if (v != u)
+ {
+ tov = NULL;
+ CalcFirstFactor (v->factor, NULL, &tov);
+ if (IntersectionIsNil (tov, tou))
+ {
+ DisposeSetDesc (&tov);
+ }
+ else
+ {
+ StrIO_WriteString ((const char *) "problem with two first sets. Set 1: ", 36);
+ EmitSet (tou, static_cast<unsigned int> (0), static_cast<unsigned int> (0));
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " Set 2: ", 36);
+ EmitSet (tov, static_cast<unsigned int> (0), static_cast<unsigned int> (0));
+ StrIO_WriteLn ();
+ DisposeSetDesc (&tou);
+ DisposeSetDesc (&tov);
+ return TRUE;
+ }
+ }
+ v = v->next;
+ }
+ DisposeSetDesc (&tou);
+ u = u->next;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OptionalExpression -
+*/
+
+static unsigned int OptionalExpression (pge_ExpressionDesc e)
+{
+ if (e == NULL)
+ {
+ return FALSE;
+ }
+ else
+ {
+ return OptionalTerm (e->term);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OptionalStatement - returns FALSE if statement, s, does not have a optional ambiguity.
+*/
+
+static unsigned int OptionalStatement (pge_StatementDesc s)
+{
+ if (s == NULL)
+ {
+ return FALSE;
+ }
+ else
+ {
+ return OptionalExpression (s->expr);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OptionalProduction -
+*/
+
+static unsigned int OptionalProduction (pge_ProductionDesc p)
+{
+ if (p == NULL)
+ {
+ return FALSE;
+ }
+ else
+ {
+ return OptionalStatement (p->statement);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CheckFirstFollow -
+*/
+
+static unsigned int CheckFirstFollow (pge_FactorDesc f, pge_FactorDesc after)
+{
+ pge_SetDesc first;
+ pge_SetDesc follow;
+
+ first = NULL;
+ CalcFirstFactor (f, NULL, &first);
+ follow = NULL;
+ follow = GetFollow (f->followinfo);
+ if (IntersectionIsNil (first, follow))
+ {
+ DisposeSetDesc (&first);
+ DisposeSetDesc (&follow);
+ return FALSE;
+ }
+ else
+ {
+ PrettyCommentFactor (f, 3);
+ NewLine (3);
+ StrIO_WriteString ((const char *) "first: ", 7);
+ EmitSet (first, static_cast<unsigned int> (0), static_cast<unsigned int> (0));
+ NewLine (3);
+ StrIO_WriteString ((const char *) "follow: ", 8);
+ EmitSet (follow, static_cast<unsigned int> (0), static_cast<unsigned int> (0));
+ NewLine (3);
+ DisposeSetDesc (&first);
+ DisposeSetDesc (&follow);
+ return TRUE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConstrainedEmptyFactor -
+*/
+
+static unsigned int ConstrainedEmptyFactor (pge_FactorDesc f)
+{
+ while (f != NULL)
+ {
+ switch (f->type)
+ {
+ case pge_id:
+ break;
+
+ case pge_lit:
+ break;
+
+ case pge_sub:
+ case pge_opt:
+ case pge_mult:
+ if (ConstrainedEmptyExpression (f->expr))
+ {
+ return TRUE;
+ }
+ break;
+
+ case pge_m2:
+ break;
+
+
+ default:
+ break;
+ }
+ if (((f->type != pge_m2) && (EmptyFactor (f))) && (CheckFirstFollow (f, f->next)))
+ {
+ return TRUE;
+ }
+ f = f->next;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConstrainedEmptyTerm - returns TRUE if the term maybe empty.
+*/
+
+static unsigned int ConstrainedEmptyTerm (pge_TermDesc t)
+{
+ pge_SetDesc first;
+ pge_SetDesc follow;
+
+ while (t != NULL)
+ {
+ if (ConstrainedEmptyFactor (t->factor))
+ {
+ return TRUE;
+ }
+ else if (((t->factor->type != pge_m2) && (EmptyFactor (t->factor))) && (CheckFirstFollow (t->factor, t->factor->next)))
+ {
+ /* avoid dangling else. */
+ return TRUE;
+ }
+ t = t->next;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConstrainedEmptyExpression -
+*/
+
+static unsigned int ConstrainedEmptyExpression (pge_ExpressionDesc e)
+{
+ if (e == NULL)
+ {
+ return FALSE;
+ }
+ else
+ {
+ return ConstrainedEmptyTerm (e->term);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConstrainedEmptyStatement - returns FALSE if statement, s, does not have a optional ambiguity.
+*/
+
+static unsigned int ConstrainedEmptyStatement (pge_StatementDesc s)
+{
+ if (s == NULL)
+ {
+ return FALSE;
+ }
+ else
+ {
+ return ConstrainedEmptyExpression (s->expr);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConstrainedEmptyProduction - returns TRUE if a problem exists with, p.
+*/
+
+static unsigned int ConstrainedEmptyProduction (pge_ProductionDesc p)
+{
+ if (p == NULL)
+ {
+ return FALSE;
+ }
+ else
+ {
+ return ConstrainedEmptyStatement (p->statement);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ TestForLALR1 -
+*/
+
+static void TestForLALR1 (pge_ProductionDesc p)
+{
+ if (OptionalProduction (p))
+ {
+ WarnError1 ((const char *) "production %s has two optional sentances using | which both have the same start symbols", 87, p->statement->ident->name);
+ WasNoError = FALSE;
+ PrettyCommentProduction (p);
+ }
+}
+
+
+/*
+ DoEpsilon - runs the epsilon interrelated rules
+*/
+
+static void DoEpsilon (pge_ProductionDesc p)
+{
+ CalcEpsilonProduction (p);
+ CalcReachEndProduction (p);
+}
+
+
+/*
+ CheckComplete - checks that production, p, is complete.
+*/
+
+static void CheckComplete (pge_ProductionDesc p)
+{
+ if ((GetReachEnd (p->followinfo)) == pge_unknown)
+ {
+ PrettyCommentProduction (p);
+ WarnError1 ((const char *) "cannot determine epsilon, probably a left recursive rule in %s and associated rules (hint rewrite using ebnf and eliminate left recursion)", 138, p->statement->ident->name);
+ WasNoError = FALSE;
+ }
+}
+
+
+/*
+ PostProcessRules - backpatch the ident to rule definitions and emit comments and code.
+*/
+
+static void PostProcessRules (void)
+{
+ ForeachRuleDo ((pge_DoProcedure) {(pge_DoProcedure_t) BackPatchIdentToDefinitions});
+ if (! WasNoError)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ WhileNotCompleteDo ((pge_DoProcedure) {(pge_DoProcedure_t) DoEpsilon});
+ if (! WasNoError)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ ForeachRuleDo ((pge_DoProcedure) {(pge_DoProcedure_t) CheckComplete});
+ if (! WasNoError)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ WhileNotCompleteDo ((pge_DoProcedure) {(pge_DoProcedure_t) CalculateFirstAndFollow});
+ if (! WasNoError)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ ForeachRuleDo ((pge_DoProcedure) {(pge_DoProcedure_t) TestForLALR1});
+ if (! WasNoError)
+ {
+ ForeachRuleDo ((pge_DoProcedure) {(pge_DoProcedure_t) PrettyCommentProduction});
+ }
+}
+
+
+/*
+ DisplayHelp - display a summary help and then exit (0).
+*/
+
+static void DisplayHelp (void)
+{
+ StrIO_WriteString ((const char *) "Usage: pge [-l] [-c] [-d] [-e] [-k] [-t] [-k] [-p] [-x] [-f] [-o outputfile] filename", 85);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " -l suppress file and line source information", 59);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " -c do not generate any Modula-2 code within the parser rules", 75);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " -h or --help generate this help message", 44);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " -e do not generate a parser with error recovery", 62);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " -k generate keyword errors with GCC formatting directives", 72);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " -d generate internal debugging information", 57);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " -p only display the ebnf rules", 45);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " -t generate texinfo formating for pretty printing (-p)", 69);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " -x generate sphinx formating for pretty printing (-p)", 68);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " -f generate GNU Free Documentation header before pretty printing in texinfo", 90);
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) " -o write output to filename", 42);
+ StrIO_WriteLn ();
+ libc_exit (0);
+}
+
+
+/*
+ ParseArgs -
+*/
+
+static void ParseArgs (void)
+{
+ unsigned int n;
+ unsigned int i;
+
+ ErrorRecovery = TRUE; /* DefaultRecovery ; */
+ Debugging = FALSE; /* DefaultRecovery ; */
+ PrettyPrint = FALSE;
+ KeywordFormatting = FALSE;
+ i = 1;
+ n = Args_Narg ();
+ while (i < n)
+ {
+ if (Args_GetArg ((char *) &ArgName.array[0], MaxFileName, i))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-e", 2))
+ {
+ ErrorRecovery = FALSE;
+ }
+ else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-d", 2))
+ {
+ /* avoid dangling else. */
+ Debugging = TRUE;
+ bnflex_SetDebugging (TRUE);
+ }
+ else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-c", 2))
+ {
+ /* avoid dangling else. */
+ EmitCode = FALSE;
+ }
+ else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-k", 2))
+ {
+ /* avoid dangling else. */
+ KeywordFormatting = TRUE;
+ }
+ else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-l", 2))
+ {
+ /* avoid dangling else. */
+ SuppressFileLineTag = TRUE;
+ }
+ else if ((StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-h", 2)) || (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "--help", 6)))
+ {
+ /* avoid dangling else. */
+ DisplayHelp ();
+ }
+ else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-p", 2))
+ {
+ /* avoid dangling else. */
+ PrettyPrint = TRUE;
+ }
+ else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-t", 2))
+ {
+ /* avoid dangling else. */
+ Texinfo = TRUE;
+ }
+ else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-x", 2))
+ {
+ /* avoid dangling else. */
+ Sphinx = TRUE;
+ }
+ else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-f", 2))
+ {
+ /* avoid dangling else. */
+ FreeDocLicense = TRUE;
+ }
+ else if (StrLib_StrEqual ((const char *) &ArgName.array[0], MaxFileName, (const char *) "-o", 2))
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if (Args_GetArg ((char *) &ArgName.array[0], MaxFileName, i))
+ {
+ if (! (Output_Open ((const char *) &ArgName.array[0], MaxFileName)))
+ {
+ StrIO_WriteString ((const char *) "cannot open ", 12);
+ StrIO_WriteString ((const char *) &ArgName.array[0], MaxFileName);
+ StrIO_WriteString ((const char *) " for writing", 12);
+ StrIO_WriteLn ();
+ libc_exit (1);
+ }
+ }
+ }
+ else if (bnflex_OpenSource ((const char *) &ArgName.array[0], MaxFileName))
+ {
+ /* avoid dangling else. */
+ StrLib_StrCopy ((const char *) &ArgName.array[0], MaxFileName, (char *) &FileName.array[0], MaxFileName);
+ bnflex_AdvanceToken ();
+ }
+ else
+ {
+ /* avoid dangling else. */
+ StrIO_WriteString ((const char *) "cannot open ", 12);
+ StrIO_WriteString ((const char *) &ArgName.array[0], MaxFileName);
+ StrIO_WriteString ((const char *) " for reading", 12);
+ StrIO_WriteLn ();
+ libc_exit (1);
+ }
+ }
+ i += 1;
+ }
+ if (n == 1)
+ {
+ DisplayHelp ();
+ }
+}
+
+
+/*
+ Init - initialize the modules data structures
+*/
+
+static void Init (void)
+{
+ WasNoError = TRUE;
+ Texinfo = FALSE;
+ Sphinx = FALSE;
+ FreeDocLicense = FALSE;
+ EmitCode = TRUE;
+ LargestValue = 0;
+ HeadProduction = NULL;
+ CurrentProduction = NULL;
+ SymbolKey_InitTree (&Aliases);
+ SymbolKey_InitTree (&ReverseAliases);
+ SymbolKey_InitTree (&Values);
+ SymbolKey_InitTree (&ReverseValues);
+ LastLineNo = 0;
+ CodePrologue = NULL;
+ CodeEpilogue = NULL;
+ CodeDeclaration = NULL;
+ ErrorProcArray = NameKey_MakeKey ((const char *) "Error", 5);
+ ErrorProcString = NameKey_MakeKey ((const char *) "ErrorS", 6);
+ TokenTypeProc = NameKey_MakeKey ((const char *) "GetCurrentTokenType()", 21);
+ SymIsProc = NameKey_MakeKey ((const char *) "SymIs", 5);
+ OnLineStart = TRUE;
+ ParseArgs ();
+ Main (static_cast<pge_SetOfStop> ((unsigned int) ((1 << (bnflex_eoftok))))); /* this line will be manipulated by sed in buildpg */
+ if (WasNoError) /* this line will be manipulated by sed in buildpg */
+ {
+ PostProcessRules ();
+ if (WasNoError)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (Debugging)
+ {
+ EmitRules ();
+ }
+ else if (PrettyPrint)
+ {
+ /* avoid dangling else. */
+ EmitRules ();
+ }
+ else
+ {
+ /* avoid dangling else. */
+ Output_WriteString ((const char *) "(* it is advisable not to edit this file as it was automatically generated from the grammer file ", 97);
+ Output_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ Output_WriteString ((const char *) " *)", 3);
+ Output_WriteLn ();
+ OnLineStart = FALSE;
+ EmitFileLineTag (LinePrologue);
+ BeginningOfLine = TRUE;
+ WriteCodeHunkList (CodePrologue);
+ EmitSupport ();
+ EmitFileLineTag (LineDeclaration);
+ WriteCodeHunkList (CodeDeclaration);
+ EmitRules ();
+ /* code rules */
+ EmitFileLineTag (LineEpilogue);
+ WriteCodeHunkList (CodeEpilogue);
+ }
+ }
+ }
+ Output_Close ();
+}
+
+extern "C" void _M2_pge_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_pge_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
--- /dev/null
+/* Gwrapc.c wrap libc functions for mc.
+
+Copyright (C) 2005-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+#include "ansidecl.h"
+
+#include "gm2-libs-host.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* strtime returns the address of a string which describes the
+ local time. */
+
+char *
+wrapc_strtime (void)
+{
+#if defined(HAVE_CTIME)
+ time_t clock = time ((time_t *)0);
+ char *string = ctime (&clock);
+
+ string[24] = (char)0;
+
+ return string;
+#else
+ return "";
+#endif
+}
+
+int
+wrapc_filesize (int f, unsigned int *low, unsigned int *high)
+{
+ struct stat s;
+ int res = fstat (f, (struct stat *)&s);
+
+ if (res == 0)
+ {
+ *low = (unsigned int)s.st_size;
+ *high = (unsigned int)(s.st_size >> (sizeof (unsigned int) * 8));
+ }
+ return res;
+}
+
+/* filemtime returns the mtime of a file, f. */
+
+int
+wrapc_filemtime (int f)
+{
+ struct stat s;
+
+ if (fstat (f, (struct stat *)&s) == 0)
+ return s.st_mtime;
+ else
+ return -1;
+}
+
+/* getrand returns a random number between 0..n-1 */
+
+int
+wrapc_getrand (int n)
+{
+ return rand () % n;
+}
+
+#if defined(HAVE_PWD_H)
+#include <pwd.h>
+
+char *
+wrapc_getusername (void)
+{
+ return getpwuid (getuid ())->pw_gecos;
+}
+
+/* getnameuidgid fills in the, uid, and, gid, which represents
+ user, name. */
+
+void
+wrapc_getnameuidgid (char *name, int *uid, int *gid)
+{
+ struct passwd *p = getpwnam (name);
+
+ if (p == NULL)
+ {
+ *uid = -1;
+ *gid = -1;
+ }
+ else
+ {
+ *uid = p->pw_uid;
+ *gid = p->pw_gid;
+ }
+}
+#else
+char *
+wrapc_getusername (void)
+{
+ return "unknown";
+}
+
+void
+wrapc_getnameuidgid (char *name, int *uid, int *gid)
+{
+ *uid = -1;
+ *gid = -1;
+}
+#endif
+
+int
+wrapc_signbit (double r)
+{
+#if defined(HAVE_SIGNBIT)
+
+ /* signbit is a macro which tests its argument against sizeof(float),
+ sizeof(double). */
+ return signbit (r);
+#else
+ return 0;
+#endif
+}
+
+int
+wrapc_signbitl (long double r)
+{
+#if defined(HAVE_SIGNBITL)
+
+ /* signbit is a macro which tests its argument against sizeof(float),
+ sizeof(double). */
+ return signbitl (r);
+#else
+ return 0;
+#endif
+}
+
+int
+wrapc_signbitf (float r)
+{
+#if defined(HAVE_SIGNBITF)
+
+ /* signbit is a macro which tests its argument against sizeof(float),
+ sizeof(double). */
+ return signbitf (r);
+#else
+ return 0;
+#endif
+}
+
+/* init constructor for the module. */
+
+void
+_M2_wrapc_init ()
+{
+}
+
+/* finish deconstructor for the module. */
+
+void
+_M2_wrapc_finish ()
+{
+}
+
+#ifdef __cplusplus
+}
+#endif
--- /dev/null
+extern "C" void _M2_RTExceptions_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_RTExceptions_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2EXCEPTION_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2EXCEPTION_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2RTS_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2RTS_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysExceptions_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysExceptions_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrLib_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrLib_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_errno_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_errno_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_termios_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_termios_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_IO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_IO_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StdIO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StdIO_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Debug_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Debug_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysStorage_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysStorage_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Storage_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Storage_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrIO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrIO_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_DynamicStrings_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_DynamicStrings_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Assertion_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Assertion_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Indexing_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Indexing_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NameKey_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NameKey_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NumberIO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NumberIO_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_PushBackInput_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_PushBackInput_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SymbolKey_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SymbolKey_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_UnixArgs_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_UnixArgs_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_FIO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_FIO_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SFIO_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SFIO_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrCase_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrCase_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_bnflex_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_bnflex_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Lists_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Lists_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Args_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Args_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Output_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Output_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_pge_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_pge_fini (int argc, char *argv[], char *envp[]);
+extern "C" void _exit(int);
+
+
+int main(int argc, char *argv[], char *envp[])
+{
+ _M2_RTExceptions_init (argc, argv, envp);
+ _M2_M2EXCEPTION_init (argc, argv, envp);
+ _M2_M2RTS_init (argc, argv, envp);
+ _M2_SysExceptions_init (argc, argv, envp);
+ _M2_StrLib_init (argc, argv, envp);
+ _M2_errno_init (argc, argv, envp);
+ _M2_termios_init (argc, argv, envp);
+ _M2_IO_init (argc, argv, envp);
+ _M2_StdIO_init (argc, argv, envp);
+ _M2_Debug_init (argc, argv, envp);
+ _M2_SysStorage_init (argc, argv, envp);
+ _M2_Storage_init (argc, argv, envp);
+ _M2_StrIO_init (argc, argv, envp);
+ _M2_DynamicStrings_init (argc, argv, envp);
+ _M2_Assertion_init (argc, argv, envp);
+ _M2_Indexing_init (argc, argv, envp);
+ _M2_NameKey_init (argc, argv, envp);
+ _M2_NumberIO_init (argc, argv, envp);
+ _M2_PushBackInput_init (argc, argv, envp);
+ _M2_SymbolKey_init (argc, argv, envp);
+ _M2_UnixArgs_init (argc, argv, envp);
+ _M2_FIO_init (argc, argv, envp);
+ _M2_SFIO_init (argc, argv, envp);
+ _M2_StrCase_init (argc, argv, envp);
+ _M2_bnflex_init (argc, argv, envp);
+ _M2_Lists_init (argc, argv, envp);
+ _M2_Args_init (argc, argv, envp);
+ _M2_Output_init (argc, argv, envp);
+ _M2_pge_init (argc, argv, envp);
+ _M2_pge_fini (argc, argv, envp);
+ _M2_Output_fini (argc, argv, envp);
+ _M2_Args_fini (argc, argv, envp);
+ _M2_Lists_fini (argc, argv, envp);
+ _M2_bnflex_fini (argc, argv, envp);
+ _M2_StrCase_fini (argc, argv, envp);
+ _M2_SFIO_fini (argc, argv, envp);
+ _M2_FIO_fini (argc, argv, envp);
+ _M2_UnixArgs_fini (argc, argv, envp);
+ _M2_SymbolKey_fini (argc, argv, envp);
+ _M2_PushBackInput_fini (argc, argv, envp);
+ _M2_NumberIO_fini (argc, argv, envp);
+ _M2_NameKey_fini (argc, argv, envp);
+ _M2_Indexing_fini (argc, argv, envp);
+ _M2_Assertion_fini (argc, argv, envp);
+ _M2_DynamicStrings_fini (argc, argv, envp);
+ _M2_StrIO_fini (argc, argv, envp);
+ _M2_Storage_fini (argc, argv, envp);
+ _M2_SysStorage_fini (argc, argv, envp);
+ _M2_Debug_fini (argc, argv, envp);
+ _M2_StdIO_fini (argc, argv, envp);
+ _M2_IO_fini (argc, argv, envp);
+ _M2_termios_fini (argc, argv, envp);
+ _M2_errno_fini (argc, argv, envp);
+ _M2_StrLib_fini (argc, argv, envp);
+ _M2_SysExceptions_fini (argc, argv, envp);
+ _M2_M2RTS_fini (argc, argv, envp);
+ _M2_M2EXCEPTION_fini (argc, argv, envp);
+ _M2_RTExceptions_fini (argc, argv, envp);
+ return(0);
+}
--- /dev/null
+/* network.c provide access to htons and htonl.
+
+Copyright (C) 2010-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+
+#define _network_C
+#include "Gnetwork.h"
+
+#include "config.h"
+#include "system.h"
+
+
+short unsigned int
+network_htons (short unsigned int s)
+{
+ return htons (s);
+}
+
+unsigned int
+network_htonl (unsigned int s)
+{
+ return htonl (s);
+}
projects / thirdparty / gcc.git / commitdiff
