From: Gaius Mulley <gaiusmod2@gmail.com>
Date: Fri, 19 Sep 2025 16:26:18 +0000 (+0100)
Subject: PR modula2/121856: New wideset implementation
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=273b53effbf5497e3e08bddeba74e72f1e7e8315;p=thirdparty%2Fgcc.git

PR modula2/121856: New wideset implementation

The new wideset implementation uses an ARRAY OF BYTE (internally) to
represent large sets.  This replaces the huge struct of anonymous
fields created by the old implementation and results in quicker
declaration times for large set types.

gcc/ChangeLog:

	PR modula2/121856
	* doc/gm2.texi (Compiler options): New item -fwideset.

gcc/m2/ChangeLog:

	PR modula2/121856
	* Make-lang.in (GM2-LIBS-BOOT-DEFS): Add M2Diagnostic.def.
	Add Selective.def.
	(GM2-LIBS-BOOT-MODS): Add M2Diagnostic.mod.
	(GM2-LIBS-BOOT-C): Add Selective.c.
	(GM2-LIBS-DEFS): Add Selective.def.
	(GM2-LIBS-MODS): Add M2Diagnostic.mod.
	(MC-LIB-MODS): Add M2Diagnostic.mod.
	(m2/gm2-libs-boot/Selective.o): New rule.
	(BUILD-PGE-O): Add m2/pge-boot/GM2Diagnostic.o.
	Add m2/pge-boot/GM2Diagnostic.o.
	Add m2/pge-boot/GStringConvert.o.
	Add m2/pge-boot/Gdtoa.o.
	Add m2/pge-boot/Gldtoa.o.
	* Make-maintainer.in (PPG-LIB-DEFS): Add M2Diagnostic.def.
	Add StringConvert.def.
	(PPG-LIB-MODS): Add M2Diagnostic.mod.
	Add StringConvert.mod.
	(PGE-DEF): Add M2Diagnostic.def.
	(PGE-DEPS): Add GM2Diagnostic.cc.
	Add GM2Diagnostic.h.
	* gm2-compiler/FifoQueue.def (PutSetIntoFifoQueue): New
	procedure.
	(GetSetFromFifoQueue): New procedure function.
	* gm2-compiler/FifoQueue.mod (PutSetIntoFifoQueue): New
	procedure.
	(GetSetFromFifoQueue): New procedure function.
	* gm2-compiler/M2ALU.def (KillValue): New procedure.
	(PushSetTree): Rename parameter t to value.
	(ConstructSetConstant): Rewrite comment.
	* gm2-compiler/M2ALU.mod: Rewrite to use the new set type
	and introduce memory diagnostics.
	* gm2-compiler/M2Base.mod (InitBaseProcedures): Lookup M2WIDESET.
	* gm2-compiler/M2CaseList.mod (CheckCaseBoundsResolved): Change
	format specifier to allow the preceeding indefinite article to
	have a n concatenated providing the following string substitute
	begins with a vowel.
	(checkTypes): Ditto.
	* gm2-compiler/M2Check.mod (checkGenericUnboundedTyped): New
	procedure function.
	* gm2-compiler/M2Code.mod (OptimizationAnalysis): Replace with ...
	(ResourceAnalysis): ... this.
	* gm2-compiler/M2Comp.mod (PopulateResource): New procedure.
	(compile): Call PopulateResource.
	Call M2Diagnostic.Generate.
	* gm2-compiler/M2GCCDeclare.mod: Rewrite for new set type.
	* gm2-compiler/M2GenGCC.mod: Rewrite implementation for
	becomes, incl, excl, and, or, not, xor for the new set type.
	* gm2-compiler/M2MetaError.def: Extend comment documenting
	the v format specifier.
	* gm2-compiler/M2MetaError.mod (errorBlock): New field vowel.
	(initErrorBlock): Initialize field vowel.
	Reformat comments.
	(pop): Call checkVowel.
	(checkVowel): New procedure.
	(isVowel): New procedure function.
	(symDesc): Remove indefinite article.
	(op): Set vowel field in case clause.
	* gm2-compiler/M2Options.def (OptimizeSets): New global.
	(TimeReport): Ditto.
	(MemReport): Ditto.
	(SetMemReport): New procedure.
	(SetTimeReport): Ditto.
	(SetWideset): Ditto.
	(GetWideset): New procedure function.
	* gm2-compiler/M2Options.mod (SetOptimizing): Assign
	OptimizeSets depending upon the optimization level.
	(SetMemReport): New procedure.
	(SetTimeReport): Ditto.
	(SetWideset): Ditto.
	(GetWideset): New procedure function.
	(OptimizeSets): Initialize to FALSE.
	(TimeReport): Ditto.
	(MemReport): Ditto.
	* gm2-compiler/M2Quads.mod (M2Diagnostic): Import.
	(QuadsMemDiag): New global variable.
	(NewQuad): Bump QuadsMemDiag whenever a quad is allocated.
	(BuildAssignmentBoolean): New procedure.
	(doBuildAssignment): Ditto.
	Add v to the format specifier.
	(CheckCompatibleWithBecomes): Add v to the format specifier.
	(CheckProcTypeAndProcedure): Ditto.
	(BuildAddAdrFunction): Ditto.
	(BuildSubAdrFunction): Ditto.
	(BuildDifAdrFunction): Ditto.
	(BuildDesignatorArrayStaticDynamic): Ditto.
	(BuildDesignatorPointer): Ditto.
	(CheckVariableOrConstantOrProcedure): Ditto.
	(Init): Initialize QuadsMemDiag.
	* gm2-compiler/M2Range.mod (CodeTypeAssign): Add v to the
	format specifier.
	* gm2-compiler/M2Scaffold.mod (DeclareScaffoldFunctions):
	Generate more precise warning note.
	* gm2-compiler/M2SymInit.mod (PrintSymInit): Add record
	field warning.
	* gm2-compiler/M2System.mod
	(IsPseudoSystemFunctionConstExpression): Add TBitSize.
	* gm2-compiler/NameKey.mod: Add MemDiagnostic code
	commented out.
	* gm2-compiler/P1SymBuild.mod (StartBuildProcedure):
	Add v format specifier.
	* gm2-compiler/P2SymBuild.mod (BuildFieldRecord): Ditto.
	* gm2-compiler/P3Build.bnf (SetType): Reformat.
	* gm2-compiler/PathName.def (Copyright): Added.
	* gm2-compiler/PathName.mod: Remove blank line.
	* gm2-compiler/SymbolConversion.mod (gdbhook): New procedure.
	(BreakWhenSymBooked): Ditto.
	(CheckBook): Ditto.
	(Init): Rewrite.
	* gm2-compiler/SymbolTable.def (GetSetArray): New procedure.
	(PutSetArray): Ditto.
	(MakeSetArray): New procedure function.
	(PutSetInWord): New procedure.
	(GetSetInWord): New procedure function.
	(IsConstVar): Ditto.
	* gm2-compiler/SymbolTable.mod (SymSet): SetInWord new field.
	SetArray new field.
	Align new field.
	(SymMemDiag): New global variable.
	(Init): Initialize SymMemDiag.
	(IsConstVar): New procedure function.
	(IsVariableSSA): Replace InternalError with Return FALSE.
	(GetNthParamOrdered): Reimplement.
	(GetNthParamAnyClosest): Ditto.
	(GetOuterModuleScope): Ditto.
	(MakeSet): Ditto.
	(PutSetArray): New procedure.
	(GetSetArray): New procedure function.
	(MakeSetArray): Ditto.
	(PutSetInWord): New procedure.
	(GetSetInWord): New procedure function.
	* gm2-gcc/init.cc (_M2_M2Diagnostic_init): Define
	prototype.
	(init_FrontEndInit):Call _M2_M2Diagnostic_init.
	* gm2-gcc/m2block.cc (m2block_GetTotalConstants): New function.
	(m2block_GetGlobalTypes): Ditto.
	* gm2-gcc/m2block.def (GetTotalConstants): New procedure function.
	(GetGlobalTypes): New procedure function.
	* gm2-gcc/m2block.h (m2block_GetTotalConstants): New function
	prototype.
	(m2block_GetGlobalTypes): Ditto.
	* gm2-gcc/m2convert.cc (converting_ISO_generic): Reimplement.
	(m2convert_ToPIMByte): New function.
	* gm2-gcc/m2convert.def (ToLoc): New procedure function.
	(ToPIMByte): Ditto.
	* gm2-gcc/m2convert.h (m2convert_ToPIMByte): Ditto.
	* gm2-gcc/m2decl.h (m2decl_RememberVariables): Ditto.
	* gm2-gcc/m2expr.cc (m2expr_BuildLogicalShift): Reimplement.
	(m2expr_BuildLRotate): Ditto.
	(m2expr_BuildLRLn): Ditto.
	(m2expr_BuildLRRn): Ditto.
	(m2expr_BuildLogicalRotate): Ditto.
	(buildUnboundedArrayOf): Ditto.
	(BuildIfBitInSetLower): New function.
	(m2expr_BuildBinarySetDo): Reimplement.
	(m2expr_BuildIfInSet): Ditto.
	(m2expr_BuildIfNotInSet): New function.
	(m2expr_Build4LogicalOr): Reimplement.
	(m2expr_BuildSetNegate): Ditto.
	(m2expr_BuildLogicalOrAddress): Ditto.
	(m2expr_BuildLogicalOr): Ditto.
	(m2expr_BuildLogicalAnd): Ditto.
	(m2expr_BuildSymmetricDifference): Ditto.
	(m2expr_BuildLogicalDifference): Ditto.
	(boolean_enum_to_unsigned): Ditto.
	(m2expr_BuildIsSuperset): Ditto.
	(m2expr_BuildIsNotSuperset): Ditto.
	(m2expr_BuildIsSubset): Ditto.
	(m2expr_BuildIfBitInSetJump): Ditto.
	(m2expr_BuildIfNotConstInVar): Ditto.
	(m2expr_BuildIfVarInVar): Ditto.
	(m2expr_BuildIfNotVarInVar): Remove.
	(m2expr_BuildIfConstInVar): Remove.
	(m2expr_BuildForeachWordInSetDoIfExpr): Ditto.
	(m2expr_BuildBinaryForeachWordDo): Ditto.
	(m2expr_BuildIfInRangeGoto): Reimplement.
	(m2expr_BuildIfNotInRangeGoto): Ditto.
	(m2expr_SetAndNarrow): Ditto.
	(m2expr_GetBitsetZero): New function.
	(m2expr_GetRValue): Ditto.
	* gm2-gcc/m2expr.def (GetBitsetZero): New function.
	(BuildSetNegate): Ditto.
	(BuildLogicalOr): Reimplement.
	(BuildLogicalAnd): Ditto.
	(BuildSymmetricDifference): Ditto.
	(BuildLogicalDifference): Ditto.
	(BuildIfInSet): New procedure function.
	(BuildIfNotInSet): Ditto.
	(BuildEqualTo): Reimplement.
	(BuildNotEqualTo): Ditto.
	(BuildBinaryForeachWordDo): Remove.
	(BuildBinarySetDo): Ditto.
	(GetRValue): New procedure function.
	* gm2-gcc/m2expr.h (m2expr_BuildBinaryForeachWordDo): Remove.
	(m2expr_BuildForeachWordInSetDoIfExpr): Ditto.
	(m2expr_BuildIfNotVarInVar): Ditto.
	(m2expr_BuildIfVarInVar): Ditto.
	(m2expr_BuildIfNotConstInVar): Ditto.
	(m2expr_BuildIfConstInVar): Ditto.
	(m2expr_BuildLogicalDifference): Reimplement.
	(m2expr_BuildSymmetricDifference): Ditto.
	(m2expr_BuildLogicalAnd): Ditto.
	(m2expr_BuildLogicalOr): Ditto.
	(m2expr_BuildLogicalOrAddress): Ditto.
	(m2expr_BuildSetNegate): Ditto.
	(m2expr_GetBitsetZero): New function.
	(m2expr_GetRValue): Ditto.
	(m2expr_BuildIfInSet): Ditto.
	(m2expr_BuildIfNotInSet): Ditto.
	* gm2-gcc/m2options.h (M2Options_SetTimeReport): New function.
	(M2Options_SetMemReport): Ditto.
	(M2Options_SetWideset): Ditto.
	(M2Options_GetWideset): Ditto.
	* gm2-gcc/m2pp.cc (m2pp_shiftrotate_expr): New function.
	(m2pp_simple_expression): Ditto.
	* gm2-gcc/m2statement.cc (m2statement_BuildStartFunctionCode):
	Tidyup comments.
	(m2statement_BuildEndFunctionCode): Ditto.
	(m2statement_BuildPushFunctionContext): Ditto.
	(copy_array): Ditto.
	(CopyByField_Lower): Ditto.
	(m2statement_BuildGoto): Ditto.
	(m2statement_DeclareLabel): Ditto.
	(m2statement_BuildParam): Ditto.
	(nCount): Ditto.
	(m2statement_BuildProcedureCallTree): Ditto.
	(m2statement_BuildBuiltinCallTree): Ditto.
	(m2statement_BuildFunctValue): Ditto.
	(m2statement_BuildCall2): Ditto.
	(m2statement_BuildCall3): Ditto.
	(m2statement_BuildFunctionCallTree): Ditto.
	(m2statement_SetLastFunction): Ditto.
	(m2statement_SetParamList): Ditto.
	(m2statement_GetLastFunction): Ditto.
	(m2statement_GetParamList): Ditto.
	(m2statement_GetCurrentFunction): Ditto.
	(m2statement_GetParamTree): Ditto.
	(m2statement_BuildTryFinally): Ditto.
	(m2statement_BuildCleanUp): Ditto.
	(m2statement_BuildUnaryForeachWordDo): Remove.
	(m2statement_BuildExcludeVarConst): Ditto.
	(m2statement_BuildExcludeVarVar): Ditto.
	(m2statement_BuildIncludeVarConst): Ditto.
	(m2statement_BuildIncludeVarVar): Ditto.
	(m2statement_DoJump): Remove.
	(m2statement_IfExprJump): New function.
	(m2statement_IfBitInSetJump): Ditto.
	* gm2-gcc/m2statement.def (DoJump): Remove.
	(IfExprJump): New procedure function.
	(BuildUnaryForeachWordDo): Remove.
	(IfBitInSetJump): New procedure function.
	* gm2-gcc/m2statement.h (m2statement_BuildForeachWordDo): Remove.
	(m2statement_DoJump): Ditto.
	(m2statement_IfExprJump): New function.
	(m2statement_IfBitInSetJump): Ditto.
	* gm2-gcc/m2treelib.cc (m2treelib_do_jump_if_bit): Reimplement.
	(nCount): Replace with ...
	(m2treelib_nCount): ... this.
	(m2treelib_DoCall): Reimplement.
	(m2treelib_get_rvalue): Remove.
	* gm2-gcc/m2treelib.def (get_rvalue): Remove.
	(nCount): New procedure function.
	* gm2-gcc/m2treelib.h (m2treelib_get_rvalue): Remove.
	(m2treelib_nCount): New function.
	* gm2-gcc/m2type.cc (constructor_elements): Change type to vec.
	(m2type_BuildEndArrayType): Reformat.
	(build_m2_type_node_by_array): Ditto.
	(m2type_GetBooleanEnumList): New procedure function.
	(m2type_BuildEnumerator): Add const to char *.
	(m2type_BuildSetConstructorElement): Reimplement.
	(m2type_BuildEndSetConstructor): Ditto.
	(build_record_constructor): New function.
	(m2type_BuildEndRecordConstructor): Reimplement.
	(m2type_BuildRecordConstructorElement): Ditto.
	(m2type_BuildStartArrayConstructor): Reimplement.
	(m2type_BuildEndArrayConstructor): Remove blank lines.
	* gm2-gcc/m2type.def (BuildSetConstructorElement): Reimplement.
	(BuildEndArrayType): Reformat.
	(GetBooleanEnumList): New function.
	* gm2-gcc/m2type.h (m2type_BuildEnumerator): Add const to char *.
	(m2type_BuildSetConstructorElement): Reimplement.
	(m2type_GetBooleanEnumList): New procedure function.
	* gm2-lang.cc (OPT_fmem_report): New option.
	(OPT_ftime_report): Ditto.
	(OPT_fwideset): Ditto.
	* gm2-libs-coroutines/SYSTEM.def (ShiftVal): Remove.
	(ShiftLeft): Ditto.
	(ShiftRight): Ditto.
	(RotateVal): Ditto.
	(RotateLeft): Ditto.
	(RotateRight): Ditto.
	* gm2-libs-coroutines/SYSTEM.mod: Reimplement.
	* gm2-libs-iso/SYSTEM.def (ShiftVal): Remove.
	(ShiftLeft): Ditto.
	(ShiftRight): Ditto.
	(RotateVal): Ditto.
	(RotateLeft): Ditto.
	(RotateRight): Ditto.
	* gm2-libs-iso/SYSTEM.mod: Reimplement.
	* gm2-libs/SYSTEM.def (ShiftVal): Remove.
	(ShiftLeft): Ditto.
	(ShiftRight): Ditto.
	(RotateVal): Ditto.
	(RotateLeft): Ditto.
	(RotateRight): Ditto.
	* gm2-libs/SYSTEM.mod: Reimplement.
	* gm2-libs/SysStorage.def (DEALLOCATE): Improve comment.
	* gm2-libs/SysStorage.mod: Improve comment.
	* init/ppginit (M2Diagnostic): Add.
	(StringConvert): Add.
	* lang.opt (fmem-report): Add access to c.opt.
	(ftime-report): Ditto.
	(fwideset): New option.
	* pge-boot/main.cc (_M2_M2Diagnostic_init): New function.
	(_M2_M2Diagnostic_fini): Ditto.
	(_M2_StringConvert_init): Ditto.
	(_M2_StringConvert_fini): Ditto.
	(main): Call _M2_M2Diagnostic_init.
	Call _M2_StringConvert_init.
	Call _M2_M2Diagnostic_fini.
	Call _M2_StringConvert_fini.
	* tools-src/makeSystem: Add -gdb option.
	* gm2-libs/M2Diagnostic.def: New file.
	* gm2-libs/M2Diagnostic.mod: New file.
	* gm2-libs/M2WIDESET.def: New file.
	* gm2-libs/M2WIDESET.mod: New file.
	* mc-boot/GM2Diagnostic.cc: New file.
	* mc-boot/GM2Diagnostic.h: New file.
	* pge-boot/GM2Diagnostic.cc: New file.
	* pge-boot/GM2Diagnostic.h: New file.
	* pge-boot/GSelective.h: New file.
	* pge-boot/GStringConvert.cc: New file.

libgm2/ChangeLog:

	* libm2pim/Makefile.am (M2MODS): Add M2Diagnostic.mod.
	Add M2WIDESET.mod.
	(M2DEFS): Add M2Diagnostic.def.
	Add M2WIDESET.def.
	* libm2pim/Makefile.in: Regenerate.

gcc/testsuite/ChangeLog:

	* gm2/errors/fail/testbit2.mod: Rewrite.
	* gm2/iso/run/pass/shift4.mod: Rewrite adding more internal
	tests.
	* gm2/iso/run/pass/testsystem.mod (FindFirstElement): Add
	bounds check.
	* gm2/sets/run/pass/multisetrotate4.mod: Add more runtime
	error messages.
	* gm2/sets/run/pass/simplepacked.mod (testpset): Correct
	setname.
	* lib/gm2.exp (gm2_init_minx): Add -fno-wideset.
	* gm2/iso/run/pass/assigncons.mod: New test.
	* gm2/iso/run/pass/constructor3.mod: New test.
	* gm2/iso/run/pass/proc_test.mod: New test.
	* gm2/iso/run/pass/simplelarge2.mod: New test.
	* gm2/iso/run/pass/simplelarge3.mod: New test.
	* gm2/iso/run/pass/simplelarge4.mod: New test.
	* gm2/pimlib/wideset/run/pass/bitset.mod: New test.
	* gm2/pimlib/wideset/run/pass/bitset2.mod: New test.
	* gm2/pimlib/wideset/run/pass/colorset.mod: New test.
	* gm2/pimlib/wideset/run/pass/colorset2.mod: New test.
	* gm2/pimlib/wideset/run/pass/colorset3.mod: New test.
	* gm2/pimlib/wideset/run/pass/highbit.mod: New test.
	* gm2/pimlib/wideset/run/pass/highbit2.mod: New test.
	* gm2/sets/run/pass/multisetrotate5.mod: New test.
	* gm2/sets/run/pass/setcard.mod: New test.
	* gm2/sets/run/pass/setincl.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
---

diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi
index d908aeaaa05..1aa647d5878 100644
--- a/gcc/doc/gm2.texi
+++ b/gcc/doc/gm2.texi
@@ -723,6 +723,12 @@ The option @samp{-Wall} will turn on this flag with
 @samp{-Wuninit-variable-checking=known}.
 The @samp{-Wuninit-variable-checking=all} will increase compile time.
 
+@item -fwideset
+turn on access to the runtime support library module @samp{M2WIDESET}.
+By default this option is on.
+Wideset provision can be disabled by @samp{-fno-wideset}
+and no reference will be made to the run time @samp{M2WIDESET} library.
+
 @c the following warning options are complete but need to be
 @c regression tested against all other front ends
 @c to ensure the options do not conflict.
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index 470825ca2cc..fd5193fea1d 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -681,6 +681,7 @@ GM2-LIBS-BOOT-DEFS = \
    IO.def \
    Indexing.def \
    M2Dependent.def \
+   M2Diagnostic.def \
    M2EXCEPTION.def \
    M2RTS.def \
    NumberIO.def \
@@ -690,6 +691,7 @@ GM2-LIBS-BOOT-DEFS = \
    SEnvironment.def \
    SFIO.def \
    SYSTEM.def \
+   Selective.def \
    Scan.def \
    StdIO.def \
    Storage.def \
@@ -726,6 +728,7 @@ GM2-LIBS-BOOT-MODS = \
    IO.mod \
    Indexing.mod \
    M2Dependent.mod \
+   M2Diagnostic.mod \
    M2EXCEPTION.mod \
    M2RTS.mod \
    NumberIO.mod \
@@ -747,6 +750,7 @@ GM2-LIBS-BOOT-MODS = \
 # found in gm2-libs-ch.
 
 GM2-LIBS-BOOT-C = \
+   Selective.c \
    StdIO.c \
    SysExceptions.c \
    choosetemp.c \
@@ -954,6 +958,7 @@ GM2-LIBS-DEFS = \
    LMathLib0.def \
    LegacyReal.def \
    M2Dependent.def \
+   M2Diagnostic.def \
    M2EXCEPTION.def \
    M2RTS.def \
    MathLib0.def \
@@ -968,6 +973,7 @@ GM2-LIBS-DEFS = \
    SMathLib0.def \
    SYSTEM.def \
    Scan.def \
+   Selective.def \
    StdIO.def \
    Storage.def \
    StrCase.def \
@@ -1006,6 +1012,7 @@ GM2-LIBS-MODS = \
    LMathLib0.mod \
    LegacyReal.mod \
    M2Dependent.mod \
+   M2Diagnostic.mod \
    M2EXCEPTION.mod \
    M2RTS.mod \
    MathLib0.mod \
@@ -1246,6 +1253,7 @@ MC-LIB-DEFS = \
    FpuIO.def \
    IO.def \
    M2Dependent.def \
+   M2Diagnostic.def \
    M2EXCEPTION.def \
    M2RTS.def \
    MemUtils.def \
@@ -1293,6 +1301,7 @@ MC-LIB-MODS = \
    FpuIO.mod \
    IO.mod \
    M2Dependent.mod \
+   M2Diagnostic.mod \
    M2EXCEPTION.mod \
    M2RTS.mod \
    MemUtils.mod \
@@ -1558,6 +1567,12 @@ m2/gm2-libs-boot/SysStorage.o: $(srcdir)/m2/gm2-libs/SysStorage.mod $(MCDEPS) $(
           m2/gm2-libs-boot/SysStorage.c -o m2/gm2-libs-boot/SysStorage.o
 	$(POSTCOMPILE)
 
+m2/gm2-libs-boot/Selective.o: $(srcdir)/m2/gm2-libs-ch/Selective.c \
+                                  m2/gm2-libs-boot/$(SRC_PREFIX)Selective.h m2/gm2-libs/gm2-libs-host.h
+	-test -d $(@D)/$(DEPDIR) || $(mkinstalldirs) $(@D)/$(DEPDIR)
+	$(CXX) $(CM2DEP) -c $(CFLAGS) $(GM2_PICFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@
+	$(POSTCOMPILE)
+
 m2/gm2-compiler-boot/M2GCCDeclare.o: $(srcdir)/m2/gm2-compiler/M2GCCDeclare.mod $(MCDEPS) $(BUILD-BOOT-H)
 	-test -d $(@D)/$(DEPDIR) || $(mkinstalldirs) $(@D)/$(DEPDIR)
 	$(MC) $(MC_EXTENDED_OPAQUE) -o=m2/gm2-compiler-boot/M2GCCDeclare.c $<
@@ -1873,6 +1888,7 @@ BUILD-PGE-O = \
    m2/pge-boot/GIO.o \
    m2/pge-boot/GLists.o \
    m2/pge-boot/GM2Dependent.o \
+   m2/pge-boot/GM2Diagnostic.o \
    m2/pge-boot/GM2EXCEPTION.o \
    m2/pge-boot/GM2RTS.o \
    m2/pge-boot/GNameKey.o \
@@ -1882,9 +1898,11 @@ BUILD-PGE-O = \
    m2/pge-boot/GPushBackInput.o \
    m2/pge-boot/GRTExceptions.o \
    m2/pge-boot/GSFIO.o \
+   m2/pge-boot/GSelective.o \
    m2/pge-boot/GStdIO.o \
    m2/pge-boot/GStorage.o \
    m2/pge-boot/GStrCase.o \
+   m2/pge-boot/GStringConvert.o \
    m2/pge-boot/GStrIO.o \
    m2/pge-boot/GStrLib.o \
    m2/pge-boot/GSymbolKey.o \
@@ -1896,6 +1914,8 @@ BUILD-PGE-O = \
    m2/pge-boot/Gtermios.o \
    m2/pge-boot/GSysExceptions.o \
    m2/pge-boot/Gabort.o \
+   m2/pge-boot/Gdtoa.o \
+   m2/pge-boot/Gldtoa.o \
    m2/pge-boot/Gmcrts.o \
    m2/pge-boot/main.o
 
diff --git a/gcc/m2/Make-maintainer.in b/gcc/m2/Make-maintainer.in
index ad89474f375..cf05e0f3d71 100644
--- a/gcc/m2/Make-maintainer.in
+++ b/gcc/m2/Make-maintainer.in
@@ -41,10 +41,11 @@ PPG-DEFS         = SymbolKey.def   NameKey.def  Lists.def  bnflex.def  Output.de
 PPG-LIB-DEFS     = Args.def Assertion.def ASCII.def Debug.def \
                    DynamicStrings.def FIO.def Indexing.def IO.def \
                    NumberIO.def PushBackInput.def \
-                   M2Dependent.def \
+                   M2Dependent.def M2Diagnostic.def \
                    M2EXCEPTION.def M2RTS.def \
                    RTExceptions.def \
                    StdIO.def SFIO.def StrIO.def StrLib.def \
+                   StringConvert.def \
                    Storage.def StrCase.def SysStorage.def
 
 # Core library implementation modules used by ppg found in the gm2-libs directory.
@@ -58,6 +59,7 @@ PPG-LIB-MODS     = ASCII.mod \
                    IO.mod \
                    Indexing.mod \
                    M2Dependent.mod \
+                   M2Diagnostic.mod \
                    M2EXCEPTION.mod \
                    M2RTS.mod \
                    NumberIO.mod \
@@ -69,6 +71,7 @@ PPG-LIB-MODS     = ASCII.mod \
                    StrCase.mod \
                    StrIO.mod \
                    StrLib.mod \
+                   StringConvert.mod \
                    SysStorage.mod
 
 # Program module ppg.mod from which pge.mod is created.  ppg.mod is
@@ -96,6 +99,7 @@ PGE-DEF = ASCII.def \
    FpuIO.def \
    IO.def \
    M2Dependent.def \
+   M2Diagnostic.def \
    M2EXCEPTION.def \
    M2RTS.def \
    MemUtils.def \
@@ -169,6 +173,8 @@ PGE-DEPS = Gabort.cc \
    GLists.h \
    GM2Dependent.cc \
    GM2Dependent.h \
+   GM2Diagnostic.cc \
+   GM2Diagnostic.h \
    GM2EXCEPTION.cc \
    GM2EXCEPTION.h \
    GM2RTS.cc \
diff --git a/gcc/m2/gm2-compiler/FifoQueue.def b/gcc/m2/gm2-compiler/FifoQueue.def
index a6a454a9da6..26e985c478c 100644
--- a/gcc/m2/gm2-compiler/FifoQueue.def
+++ b/gcc/m2/gm2-compiler/FifoQueue.def
@@ -25,15 +25,25 @@ DEFINITION MODULE FifoQueue ;
    Author     : Gaius Mulley
    Title      : FifoQueue
    Date       : Tue Dec 12 16:23:22 GMT 1989
-   Description: FifoQueue provides a mechanism to and from which CARDINAL
-                numbers can be stored and retrieved from a FIFO queue.
-   Last update: Tue Dec 12 16:24:24 GMT 1989
+   Description: FifoQueue provides a fifo mechanism to allow symbols to be
+                stored and retrieved between passes in the same order.
 *)
 
-EXPORT QUALIFIED PutEnumerationIntoFifoQueue, GetEnumerationFromFifoQueue,
-                 PutSubrangeIntoFifoQueue, GetSubrangeFromFifoQueue,
-                 PutConstIntoFifoQueue, GetConstFromFifoQueue,
-                 PutConstructorIntoFifoQueue, GetConstructorFromFifoQueue ;
+
+(*
+   PutSetIntoFifoQueue - places a set symbol
+                         into a fifo queue.
+*)
+
+PROCEDURE PutSetIntoFifoQueue (c: CARDINAL) ;
+
+
+(*
+   GetSetFromFifoQueue - retrieves a set symbol
+                         from a fifo queue.
+*)
+
+PROCEDURE GetSetFromFifoQueue (VAR c: CARDINAL) ;
 
 
 (*
diff --git a/gcc/m2/gm2-compiler/FifoQueue.mod b/gcc/m2/gm2-compiler/FifoQueue.mod
index 9d309557286..8d9accf0d9c 100644
--- a/gcc/m2/gm2-compiler/FifoQueue.mod
+++ b/gcc/m2/gm2-compiler/FifoQueue.mod
@@ -31,6 +31,7 @@ TYPE
 
 VAR
    const,
+   set,
    subrange,
    enumeration,
    constructor: Fifo ;
@@ -149,6 +150,28 @@ BEGIN
 END GetConstFromFifoQueue ;
 
 
+(*
+   PutSetIntoFifoQueue - places a set symbol
+                         into a fifo queue.
+*)
+
+PROCEDURE PutSetIntoFifoQueue (c: CARDINAL) ;
+BEGIN
+   PutInto (set, c)
+END PutSetIntoFifoQueue ;
+
+
+(*
+   GetSetFromFifoQueue - retrieves a set symbol
+                         from a fifo queue.
+*)
+
+PROCEDURE GetSetFromFifoQueue (VAR c: CARDINAL) ;
+BEGIN
+   GetFrom (set, c)
+END GetSetFromFifoQueue ;
+
+
 (*
    Init - initialize the fifo queue.
 *)
@@ -164,6 +187,7 @@ END Init ;
 
 BEGIN
    Init(const) ;
+   Init(set) ;
    Init(enumeration) ;
    Init(subrange) ;
    Init(constructor)
diff --git a/gcc/m2/gm2-compiler/M2ALU.def b/gcc/m2/gm2-compiler/M2ALU.def
index 1e4fdb8e893..fbf3245ef91 100644
--- a/gcc/m2/gm2-compiler/M2ALU.def
+++ b/gcc/m2/gm2-compiler/M2ALU.def
@@ -35,52 +35,6 @@ FROM NameKey IMPORT Name ;
 FROM M2GCCDeclare IMPORT WalkAction, IsAction ;
 FROM gcctypes IMPORT tree ;
 
-EXPORT QUALIFIED PtrToValue,
-                 InitValue,
-                 IsValueTypeNone,
-                 IsValueTypeInteger,
-                 IsValueTypeReal,
-                 IsValueTypeComplex,
-                 IsValueTypeSet,
-                 IsValueTypeConstructor,
-                 IsValueTypeArray,
-                 IsValueTypeRecord,
-                 PopInto, PushFrom,
-                 PushIntegerTree, PopIntegerTree,
-                 PushSetTree, PopSetTree,
-                 PushRealTree, PopRealTree,
-                 PushComplexTree, PopComplexTree,
-                 PopConstructorTree,
-                 PopChar,
-                 PushCard,
-                 PushInt,
-                 PushChar,
-                 PushString,
-                 PushTypeOfTree,
-                 CoerseLongRealToCard,
-                 ConvertRealToInt,
-                 ConvertToInt,
-                 ConvertToType,
-                 GetSetValueType,
-                 IsSolved, IsValueConst,
-                 PutConstructorSolved, EvaluateValue, TryEvaluateValue,
-
-                 IsNulSet, IsGenericNulSet, PushNulSet, AddBitRange, AddBit, SubBit,
-      	       	 SetOr, SetAnd, SetIn,
-                 SetDifference, SetSymmetricDifference,
-                 SetNegate, SetShift, SetRotate,
-
-                 Addn, Multn, Sub,
-                 DivFloor, ModFloor, DivTrunc, ModTrunc,
-                 Equ, NotEqu, Less, Gre, LessEqu, GreEqu,
-                 GetValue, GetRange,  ConstructSetConstant, BuildRange,
-                 IsConstructorDependants, WalkConstructorDependants,
-                 AddField, AddElements,
-
-                 PushEmptyConstructor, PushEmptyArray, PushEmptyRecord,
-                 ChangeToConstructor,
-
-                 IsValueAndTreeKnown, CheckOrResetOverflow ;
 
 TYPE
    PtrToValue ;
@@ -93,6 +47,13 @@ TYPE
 PROCEDURE InitValue () : PtrToValue ;
 
 
+(*
+   KillValue - deconstructor for value.  value is set to NIL upon return.
+*)
+
+PROCEDURE KillValue (VAR value: PtrToValue) ;
+
+
 (*
    IsValueTypeNone - returns TRUE if the value on the top stack has no value.
 *)
@@ -208,8 +169,7 @@ PROCEDURE PopComplexTree () : tree ;
                  type (sym). Bit 0 maps onto MIN(sym).
 *)
 
-PROCEDURE PushSetTree (tokenno: CARDINAL;
-                       t: tree; sym: CARDINAL) ;
+PROCEDURE PushSetTree (tokenno: CARDINAL; value: tree; sym: CARDINAL) ;
 
 
 (*
@@ -828,8 +788,8 @@ PROCEDURE GetRange (v: PtrToValue; n: CARDINAL; VAR low, high: CARDINAL) : BOOLE
 
 
 (*
-   ConstructSetConstant - builds a struct of integers which represents the
-                          set const, sym.
+   ConstructSetConstant - builds an array of BYTE which represents the
+                          set const symbol.
 *)
 
 PROCEDURE ConstructSetConstant (tokenno: CARDINAL; v: PtrToValue) : tree ;
diff --git a/gcc/m2/gm2-compiler/M2ALU.mod b/gcc/m2/gm2-compiler/M2ALU.mod
index e53f2edf478..6809bcb2fb8 100644
--- a/gcc/m2/gm2-compiler/M2ALU.mod
+++ b/gcc/m2/gm2-compiler/M2ALU.mod
@@ -52,7 +52,7 @@ FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaErrorStringT0,
 
 FROM SymbolTable IMPORT NulSym, IsEnumeration, IsSubrange, IsValueSolved, PushValue,
                         ForeachFieldEnumerationDo, MakeTemporary, PutVar, PopValue, GetType,
-                        MakeConstLit, GetArraySubscript,
+                        MakeConstLit, GetArraySubscript, GetSetInWord,
                         IsSet, SkipType, IsRecord, IsArray, IsConst, IsConstructor,
                         IsConstString, SkipTypeAndSubrange, GetDeclaredMod,
                         GetSubrange, GetSymName, GetNth, GetString, GetStringLength,
@@ -70,7 +70,7 @@ FROM m2expr IMPORT BuildAdd, BuildSub, BuildMult,
                    GetWordOne, GetCardinalZero, TreeOverflow, RemoveOverflow,
                    GetCstInteger ;
 
-FROM m2decl IMPORT GetBitsPerBitset, BuildIntegerConstant, BuildConstLiteralNumber ;
+FROM m2decl IMPORT GetBitsPerUnit, GetBitsPerBitset, BuildIntegerConstant, BuildConstLiteralNumber ;
 FROM m2misc IMPORT DebugTree ;
 
 FROM m2type IMPORT RealToTree, Constructor, GetIntegerType, GetLongRealType,
@@ -80,12 +80,17 @@ FROM m2type IMPORT RealToTree, Constructor, GetIntegerType, GetLongRealType,
                    BuildArrayConstructorElement, BuildStartArrayConstructor, BuildEndArrayConstructor,
                    GetM2CharType ;
 
-FROM m2convert IMPORT ConvertConstantAndCheck, ToWord, ToInteger, ToCardinal, ToBitset ;
+FROM m2convert IMPORT ConvertConstantAndCheck, ToWord, ToInteger, ToCardinal,
+                      ToBitset, ToLoc, ToPIMByte, BuildConvert ;
+
 FROM m2block IMPORT RememberConstant ;
 
 FROM m2expr IMPORT GetPointerZero, GetIntegerZero, GetIntegerOne,
                    CompareTrees, FoldAndStrip, AreRealOrComplexConstantsEqual, AreConstantsEqual ;
 
+FROM M2Diagnostic IMPORT Diagnostic, InitMemDiagnostic, MemIncr, MemSet ;
+
+
 
 TYPE
    cellType   = (none, integer, real, complex, set, constructor, array, record) ;
@@ -150,6 +155,9 @@ VAR
    EnumerationField: CARDINAL ;
    CurrentTokenNo  : CARDINAL ;
    (* WatchedValue    : PtrToValue ;  *)
+   StackMemDiag    : Diagnostic ;   (* Contains memory related statistics *)
+   RangeMemDiag    : Diagnostic ;   (* Contains memory related statistics *)
+
 
 
 (*
@@ -162,7 +170,9 @@ VAR
 BEGIN
    IF FreeList=NIL
    THEN
-      NEW (v)
+      NEW (v) ;
+      MemIncr (StackMemDiag, 1, 1) ;
+      MemIncr (StackMemDiag, 2, SIZE (v^))
    ELSE
       v := FreeList ;
       FreeList := FreeList^.next
@@ -203,7 +213,9 @@ BEGIN
       IF v=NIL
       THEN
          InternalError ('out of memory error')
-      END
+      END ;
+      MemIncr (RangeMemDiag, 1, 1) ;
+      MemIncr (RangeMemDiag, 2, SIZE (v^))
    ELSE
       v := RangeFreeList ;
       RangeFreeList := RangeFreeList^.next
@@ -490,6 +502,17 @@ BEGIN
 END InitValue ;
 
 
+(*
+   KillValue - deconstructor for value.  value is set to NIL upon return.
+*)
+
+PROCEDURE KillValue (VAR value: PtrToValue) ;
+BEGIN
+   Dispose (value) ;
+   value := NIL
+END KillValue ;
+
+
 (*
    IsValueTypeNone - returns TRUE if the value on the top stack has no value.
 *)
@@ -818,49 +841,48 @@ END PopComplexTree ;
 
 (*
    PushSetTree - pushes a gcc tree onto the ALU stack.
-                 The tree, t, is expected to contain a
-                 word value. It is converted into a set
-                 type (sym). Bit 0 maps onto MIN(sym).
+                 The tree value is expected to contain a
+                 word sized or less value.  It is converted into a set
+                 type (sym). Bit 0 maps onto MIN (sym).
 *)
 
 PROCEDURE PushSetTree (tokenno: CARDINAL;
-                       t: tree; sym: CARDINAL) ;
+                       value: tree; sym: CARDINAL) ;
 VAR
-   v: PtrToValue ;
-   c,
-   i: INTEGER ;
-   r: listOfRange ;
-   l: location_t ;
+   newVal: PtrToValue ;
+   c, i  : INTEGER ;
+   range : listOfRange ;
+   loc   : location_t ;
 BEGIN
-   l := TokenToLocation(tokenno) ;
-   r := NIL ;
+   loc := TokenToLocation (tokenno) ;
+   range := NIL ;
    i := 0 ;
-   WHILE (i<GetBitsPerBitset()) AND
-         (CompareTrees(GetIntegerZero(l), t)#0) DO
-      IF CompareTrees(GetIntegerOne(l),
-                      BuildLogicalAnd(l, t, GetIntegerOne(l), FALSE))=0
+   WHILE (i < GetBitsPerBitset ()) AND
+         (CompareTrees (GetIntegerZero (loc), value) # 0) DO
+      IF CompareTrees (GetIntegerOne (loc),
+                       BuildLogicalAnd (loc, value, GetIntegerOne (loc))) = 0
       THEN
-         PushCard(i) ;
-         c := Val(tokenno, SkipType(sym), PopIntegerTree()) ;
-         DeclareConstant(tokenno, c) ;
-         r := AddRange(r, c, c)
+         PushCard (i) ;
+         c := Val (tokenno, SkipType (sym), PopIntegerTree ()) ;
+         DeclareConstant (tokenno, c) ;
+         range := AddRange (range, c, c)
       END ;
-      t := BuildLSR(l, t, GetIntegerOne(l), FALSE) ;
-      INC(i)
+      value := BuildLSR (loc, value, GetIntegerOne (loc), FALSE) ;
+      INC (i)
    END ;
-   SortElements(tokenno, r) ;
-   CombineElements(tokenno, r) ;
-   v := New() ;
-   WITH v^ DO
-      location        := l ;
+   SortElements (tokenno, range) ;
+   CombineElements (tokenno, range) ;
+   newVal := New () ;
+   WITH newVal^ DO
+      location        := loc ;
       type            := set ;
       constructorType := sym ;
       areAllConstants := FALSE ;
       solved          := FALSE ;
-      setValue        := r
+      setValue        := range
    END ;
-   Eval(tokenno, v) ;
-   Push(v)
+   Eval (tokenno, newVal) ;
+   Push (newVal)
 END PushSetTree ;
 
 
@@ -1393,7 +1415,6 @@ BEGIN
 END ConvertToType ;
 
 
-
 (*
    IsSolved - returns true if the memory cell indicated by v
               has a known value.
@@ -4397,107 +4418,106 @@ END GetRange ;
 
 
 (*
-   BuildStructBitset - v is the PtrToValue.
+   ConstructLargeOrSmallSet - generates a constant representing the set value of the symbol, sym.
+                              We manufacture the constant by using a initialization
+                              structure of cardinals.
+
+                              { (cardinal), (cardinal) etc }
+*)
+
+PROCEDURE ConstructLargeOrSmallSet (tokenno: CARDINAL; v: PtrToValue; low, high: CARDINAL) : tree ;
+VAR
+   settype: CARDINAL ;
+BEGIN
+   Assert (v^.constructorType # NulSym) ;
+   settype := SkipType (v^.constructorType) ;
+   Assert (IsSet (settype)) ;
+   IF GetSetInWord (settype)
+   THEN
+      (* Narrow set.  *)
+      RETURN BuildConvert (TokenToLocation (tokenno),
+                           Mod2Gcc (settype),
+                           BuildBitset (tokenno, v, Mod2Gcc (low), Mod2Gcc (high)),
+                           FALSE)
+   ELSE
+      (* Wide set.  *)
+      RETURN BuildArrayByteset (tokenno, v, Mod2Gcc (low), Mod2Gcc (high))
+   END
+END ConstructLargeOrSmallSet ;
+
+
+(*
+   BuildArrayByteset - v is the PtrToValue.
                        low and high are the limits of the subrange.
 *)
 
-PROCEDURE BuildStructBitset (tokenno: CARDINAL; v: PtrToValue; low, high: tree) : tree ;
+PROCEDURE BuildArrayByteset (tokenno: CARDINAL; v: PtrToValue; low, high: tree) : tree ;
 VAR
-   BitsInSet : tree ;
-   bpw       : CARDINAL ;
-   cons      : Constructor ;
+   location   : location_t ;
+   BitsInSet  : tree ;
+   BitsPerByte: CARDINAL ;
+   cons       : Constructor ;
 BEGIN
-   PushIntegerTree(low) ;
+   location := TokenToLocation (tokenno) ;
+   PushIntegerTree (low) ;
    ConvertToInt ;
-   low := PopIntegerTree() ;
-   PushIntegerTree(high) ;
+   low := PopIntegerTree () ;
+   PushIntegerTree (high) ;
    ConvertToInt ;
-   high := PopIntegerTree() ;
-   bpw  := GetBitsPerBitset() ;
+   high := PopIntegerTree () ;
+   BitsPerByte := GetBitsPerUnit () ;
 
-   PushIntegerTree(high) ;
-   PushIntegerTree(low) ;
+   PushIntegerTree (high) ;
+   PushIntegerTree (low) ;
    Sub ;
-   PushCard(1) ;
+   PushCard (1) ;
    Addn ;
-   BitsInSet := PopIntegerTree() ;
+   BitsInSet := PopIntegerTree () ;
 
-   cons := BuildStartSetConstructor(Mod2Gcc(v^.constructorType)) ;
+   cons := BuildStartSetConstructor (Mod2Gcc (v^.constructorType)) ;
 
-   PushIntegerTree(BitsInSet) ;
-   PushCard(0) ;
-   WHILE Gre(tokenno) DO
-      PushIntegerTree(BitsInSet) ;
-      PushCard(bpw-1) ;
-      IF GreEqu(tokenno)
+   PushIntegerTree (BitsInSet) ;
+   PushCard (0) ;
+   WHILE Gre (tokenno) DO
+      PushIntegerTree (BitsInSet) ;
+      PushCard (BitsPerByte - 1) ;
+      IF GreEqu (tokenno)
       THEN
-         PushIntegerTree(low) ;
-         PushCard(bpw-1) ;
+         PushIntegerTree (low) ;
+         PushCard (BitsPerByte - 1) ;
          Addn ;
-
-         BuildSetConstructorElement(cons, BuildBitset(tokenno, v, low, PopIntegerTree())) ;
-
-         PushIntegerTree(low) ;
-         PushCard(bpw) ;
+         BuildSetConstructorElement (location,
+                                     cons, BuildByte (tokenno, v, low, PopIntegerTree ())) ;
+         PushIntegerTree (low) ;
+         PushCard (BitsPerByte) ;
          Addn ;
-         low := PopIntegerTree() ;
-         PushIntegerTree(BitsInSet) ;
-         PushCard(bpw) ;
+         low := PopIntegerTree () ;
+         PushIntegerTree (BitsInSet) ;
+         PushCard (BitsPerByte) ;
          Sub ;
-         BitsInSet := PopIntegerTree()
+         BitsInSet := PopIntegerTree ()
       ELSE
-         (* printf2('range is %a..%a\n', GetSymName(low), GetSymName(high)) ; *)
-
-         BuildSetConstructorElement(cons, BuildBitset(tokenno, v, low, high)) ;
-
-         PushCard(0) ;
-         BitsInSet := PopIntegerTree()
+         BuildSetConstructorElement (location,
+                                     cons, BuildByte (tokenno, v, low, high)) ;
+         PushCard (0) ;
+         BitsInSet := PopIntegerTree ()
       END ;
-      PushIntegerTree(BitsInSet) ;
-      PushCard(0)
+      PushIntegerTree (BitsInSet) ;
+      PushCard (0)
    END ;
-   RETURN( BuildEndSetConstructor(cons) )
-END BuildStructBitset ;
+   RETURN BuildEndSetConstructor (cons)
+END BuildArrayByteset ;
 
 
 (*
-   ConstructLargeOrSmallSet - generates a constant representing the set value of the symbol, sym.
-                              We manufacture the constant by using a initialization
-                              structure of cardinals.
-
-                              { (cardinal), (cardinal) etc }
-*)
-
-PROCEDURE ConstructLargeOrSmallSet (tokenno: CARDINAL; v: PtrToValue; low, high: CARDINAL) : tree ;
-BEGIN
-   PushValue(high) ;
-   ConvertToInt ;
-   PushValue(low) ;
-   ConvertToInt ;
-   Sub ;
-   PushCard(GetBitsPerBitset()) ;
-   IF Less(tokenno)
-   THEN
-      (* small set *)
-      RETURN( BuildBitset(tokenno, v, Mod2Gcc(low), Mod2Gcc(high)) )
-   ELSE
-      (* large set *)
-      RETURN( BuildStructBitset(tokenno, v, Mod2Gcc(low), Mod2Gcc(high)) )
-   END
-END ConstructLargeOrSmallSet ;
-
-
-(*
-   ConstructSetConstant - builds a struct of integers which represents the
-                          set const as defined by, v.
+   ConstructSetConstant - builds an array of bytes which represents the
+                          set const as defined by v.
 *)
 
 PROCEDURE ConstructSetConstant (tokenno: CARDINAL; v: PtrToValue) : tree ;
 VAR
    n1, n2   : Name ;
-   gccsym   : tree ;
-   baseType,
-   high, low: CARDINAL ;
+   baseType: CARDINAL ;
 BEGIN
    WITH v^ DO
       IF constructorType=NulSym
@@ -4511,14 +4531,7 @@ BEGIN
             n2 := GetSymName(baseType) ;
             printf2('ConstructSetConstant of type %a and baseType %a\n', n1, n2)
          END ;
-         IF IsSubrange(baseType)
-         THEN
-            GetSubrange(baseType, high, low) ;
-            gccsym := ConstructLargeOrSmallSet(tokenno, v, low, high)
-         ELSE
-            gccsym := ConstructLargeOrSmallSet(tokenno, v, GetTypeMin(baseType), GetTypeMax(baseType))
-         END ;
-         RETURN( gccsym )
+         RETURN ConstructLargeOrSmallSet (tokenno, v, GetTypeMin (baseType), GetTypeMax (baseType))
       END
    END
 END ConstructSetConstant ;
@@ -5074,7 +5087,7 @@ BEGIN
       THEN
          t := BuildLSL(location, GetWordOne(location), ToWord(location, i), FALSE)
       ELSE
-         t := BuildLogicalOr(location, t, BuildLSL(location, GetWordOne(location), ToWord(location, i), FALSE), FALSE)
+         t := BuildLogicalOr (location, t, BuildLSL(location, GetWordOne(location), ToWord(location, i), FALSE))
       END ;
       PushIntegerTree(i) ;
       PushIntegerTree(GetIntegerOne(location)) ;
@@ -5083,7 +5096,7 @@ BEGIN
       PushIntegerTree(i) ;
       PushIntegerTree(e2) ;
    UNTIL Gre(tokenno) ;
-   RETURN( t )
+   RETURN t
 END BuildRange ;
 
 
@@ -5115,7 +5128,7 @@ BEGIN
       THEN
          tl := ToCardinal(location, SubTree(MaxTree(tokenno, tl, low), low)) ;
          th := ToCardinal(location, SubTree(MinTree(tokenno, th, high), low)) ;
-         t := BuildLogicalOr(location, t, BuildRange(tokenno, tl, th), FALSE)
+         t := BuildLogicalOr(location, t, BuildRange(tokenno, tl, th))
       END ;
       INC(n)
    END ;
@@ -5123,6 +5136,42 @@ BEGIN
 END BuildBitset ;
 
 
+(*
+   BuildByte - given a set v construct the bitmask for its
+               constant value which lie in the range low..high.
+*)
+
+PROCEDURE BuildByte (tokenno: CARDINAL;
+                     v: PtrToValue; low, high: tree) : tree ;
+VAR
+   tl, th,
+   t       : tree ;
+   n       : CARDINAL ;
+   r1, r2  : CARDINAL ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   low := ToInteger (location, low) ;
+   high := ToInteger (location, high) ;
+   n := 1 ;
+   t := GetCardinalZero (location) ;
+   WHILE GetRange (v, n, r1, r2) DO
+      PushValue (r1) ;
+      tl := ToInteger (location, PopIntegerTree ()) ;
+      PushValue (r2) ;
+      th := ToInteger (location, PopIntegerTree ()) ;
+      IF IsIntersectionTree (tokenno, tl, th, low, high)
+      THEN
+         tl := ToCardinal (location, SubTree (MaxTree (tokenno, tl, low), low)) ;
+         th := ToCardinal (location, SubTree (MinTree (tokenno, th, high), low)) ;
+         t := BuildLogicalOr (location, t, BuildRange (tokenno, tl, th))
+      END ;
+      INC(n)
+   END ;
+   RETURN ToPIMByte (location, t)
+END BuildByte ;
+
+
 (*
    IsValueAndTreeKnown - returns TRUE if the value is known and the gcc tree
                          is defined.
@@ -5309,7 +5358,15 @@ BEGIN
    TopOfStack      := NIL ;
    RangeFreeList   := NIL ;
    FieldFreeList   := NIL ;
-   ElementFreeList := NIL
+   ElementFreeList := NIL ;
+   StackMemDiag
+      := InitMemDiagnostic
+            ('M2ALU:Stack',
+            '{0N} total symbols {1d} consuming {2M} ram {0M} ({2P})') ;
+   RangeMemDiag
+      := InitMemDiagnostic
+            ('M2ALU:Range',
+            '{0N} total symbols {1d} consuming {2M} ram {0M} ({2P})')
 END Init ;
 
 
diff --git a/gcc/m2/gm2-compiler/M2Base.mod b/gcc/m2/gm2-compiler/M2Base.mod
index 5e373cf398a..14fea699649 100644
--- a/gcc/m2/gm2-compiler/M2Base.mod
+++ b/gcc/m2/gm2-compiler/M2Base.mod
@@ -96,7 +96,7 @@ FROM M2Options IMPORT NilChecking,
                       IndexChecking, RangeChecking,
                       ReturnChecking, CaseElseChecking, Exceptions,
 		      WholeValueChecking,
-                      DebugBuiltins,
+                      DebugBuiltins, GetWideset,
                       Iso, Pim, Pim2, Pim3 ;
 
 FROM m2type IMPORT GetIntegerType,
@@ -150,6 +150,7 @@ VAR
    Comp,
    Expr,
    Ass        : CompatibilityArray ;
+   m2wideset,
    Ord,
    OrdS, OrdL,
    Float,
@@ -222,7 +223,7 @@ BEGIN
    InitSystem ;
 
    MakeBitset ;  (* We do this after SYSTEM has been created as BITSET
-                    is dependant upon WORD.  *)
+                    is dependant upon WORD and BOOLEAN.  *)
 
    InitBaseConstants ;
    InitBaseFunctions ;
@@ -635,6 +636,14 @@ BEGIN
                 (* PIM-2 Modula-2                             *)
    END ;
 
+   IF GetWideset ()
+   THEN
+      (* Ensure that M2WIDESET is available if needed by M2GenGCC.mod.
+         By default -fwideset is TRUE however the user may override using
+         -fno-wideset.  *)
+      m2wideset := MakeDefinitionSource (BuiltinTokenNo, MakeKey('M2WIDESET'))
+   END ;
+
    (*
       The procedure HALT is a real procedure which
       is defined in M2RTS. However to remain compatible
diff --git a/gcc/m2/gm2-compiler/M2CaseList.mod b/gcc/m2/gm2-compiler/M2CaseList.mod
index 2810b024e7a..8788d4e4b7e 100644
--- a/gcc/m2/gm2-compiler/M2CaseList.mod
+++ b/gcc/m2/gm2-compiler/M2CaseList.mod
@@ -326,9 +326,9 @@ BEGIN
                ELSE
                   IF r^.high=NulSym
                   THEN
-                     MetaError1('the CASE statement variant must be defined by a constant {%1Da:is a {%1d}}', r^.low)
+                     MetaError1('the CASE statement variant must be defined by a constant {%1Da:is a {%1dv}}', r^.low)
                   ELSE
-                     MetaError1('the CASE statement variant low value in a range must be defined by a constant {%1Da:is a {%1d}}',
+                     MetaError1('the CASE statement variant low value in a range must be defined by a constant {%1Da:is a {%1dv}}',
                                 r^.low)
                   END
                END
@@ -343,7 +343,7 @@ BEGIN
                      RETURN( FALSE )
                   END
                ELSE
-                  MetaError1('the CASE statement variant high value in a range must be defined by a constant {%1Da:is a {%1d}}',
+                  MetaError1('the CASE statement variant high value in a range must be defined by a constant {%1Da:is a {%1dv}}',
                              r^.high)
                END
             END ;
@@ -1306,7 +1306,7 @@ BEGIN
       consttype := GetType (constant) ;
       IF NOT IsExpressionCompatible (consttype, type)
       THEN
-         MetaError2 ('the case statement variant tag {%1ad} must be type compatible with the constant {%2Da:is a {%2d}}',
+         MetaError2 ('the case statement variant tag {%1ad} must be type compatible with the constant {%2Da:is a {%2dv}}',
                      type, constant) ;
          RETURN FALSE
       END
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index 614526c0dc0..a717147039b 100644
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -34,6 +34,7 @@ IMPLEMENTATION MODULE M2Check ;
 
 FROM M2System IMPORT IsSystemType, IsGenericSystemType, IsSameSize, IsComplexN ;
 FROM M2Base IMPORT IsParameterCompatible, IsAssignmentCompatible, IsExpressionCompatible, IsComparisonCompatible, IsBaseType, IsMathType, ZType, CType, RType, IsComplexType, Char ;
+FROM M2Bitset IMPORT Bitset ;
 FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, KillIndex, HighIndice, LowIndice, IncludeIndiceIntoIndex, ForeachIndiceInIndexDo ;
 FROM M2Error IMPORT Error, InternalError, NewError, ErrorString, ChainError ;
 
@@ -456,7 +457,23 @@ END checkUnbounded ;
 
 
 (*
-   checkArrayTypeEquivalence - check array and unbounded array type equivalence.
+   checkGenericUnboundedTyped - return TRUE if we have a match for
+                                an unbounded generic type and a typed object
+                                which is not a Z, R or C type.
+*)
+
+PROCEDURE checkGenericUnboundedTyped (unbounded, typed: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN (IsUnbounded (unbounded) AND
+           IsGenericSystemType (GetDType (unbounded)) AND
+           ((NOT IsZRCType (typed)) OR
+            IsTyped (typed) AND (NOT IsZRCType (GetDType (typed)))))
+END checkGenericUnboundedTyped ;
+
+
+(*
+   checkArrayTypeEquivalence - check array and unbounded array type
+                               equivalence.
 *)
 
 PROCEDURE checkArrayTypeEquivalence (result: status; tinfo: tInfo;
@@ -476,6 +493,12 @@ BEGIN
       THEN
          result := checkSubrange (result, tinfo, getSType (lSub), getSType (rSub))
       END
+   ELSIF checkGenericUnboundedTyped (left, right) OR
+         checkGenericUnboundedTyped (right, left)
+   THEN
+      (* ARRAY OF BYTE (or WORD or LOC etc will be compatible with any typed
+         non ZRC type.  *)
+      RETURN true
    ELSIF IsUnbounded (left) AND (IsArray (right) OR IsUnbounded (right))
    THEN
       IF IsGenericSystemType (getSType (left)) OR IsGenericSystemType (getSType (right))
diff --git a/gcc/m2/gm2-compiler/M2Code.mod b/gcc/m2/gm2-compiler/M2Code.mod
index 02526a07b4f..22771fac74f 100644
--- a/gcc/m2/gm2-compiler/M2Code.mod
+++ b/gcc/m2/gm2-compiler/M2Code.mod
@@ -78,6 +78,8 @@ FROM M2SSA IMPORT DiscoverSSA ;
 FROM m2pp IMPORT CreateDumpGimple, CloseDumpGimple ;
 FROM DynamicStrings IMPORT String, KillString ;
 
+IMPORT M2Diagnostic ;
+
 
 CONST
    MaxOptimTimes   = 10 ;   (* upper limit of no of times we run through all optimization *)
@@ -119,10 +121,10 @@ END Percent ;
 
 
 (*
-   OptimizationAnalysis - displays some simple front end optimization statistics.
+   ResourceAnalysis - displays resource analysis relating to the front end.
 *)
 
-PROCEDURE OptimizationAnalysis ;
+PROCEDURE ResourceAnalysis ;
 VAR
    value: CARDINAL ;
 BEGIN
@@ -146,7 +148,7 @@ BEGIN
       FlushBuffer (StdOut)
    END ;
    DumpQuadruples ('after all front end optimization\n')
-END OptimizationAnalysis ;
+END ResourceAnalysis ;
 
 
 (*
@@ -293,7 +295,7 @@ BEGIN
    qprintf0 ('        gcc trees given to the gcc backend\n') ;
    EndGlobalContext ;
 
-   OptimizationAnalysis
+   ResourceAnalysis
 END Code ;
 
 
diff --git a/gcc/m2/gm2-compiler/M2Comp.mod b/gcc/m2/gm2-compiler/M2Comp.mod
index 8aef9ce923d..741daeb036d 100644
--- a/gcc/m2/gm2-compiler/M2Comp.mod
+++ b/gcc/m2/gm2-compiler/M2Comp.mod
@@ -48,6 +48,7 @@ FROM P0SymBuild IMPORT P0Init, P1Init ;
 FROM M2Debug IMPORT Assert ;
 
 IMPORT m2flex ;
+IMPORT m2block ;
 IMPORT P0SyntaxCheck ;
 IMPORT P1Build ;
 IMPORT P2Build ;
@@ -56,6 +57,7 @@ IMPORT P3Build ;
 IMPORT PHBuild ;
 IMPORT PCSymBuild ;
 IMPORT DynamicStrings ;
+IMPORT M2Diagnostic ;
 
 FROM M2Batch IMPORT GetSource, GetModuleNo, GetDefinitionModuleFile, GetModuleFile,
                     AssociateModule, AssociateDefinition, MakeImplementationSource,
@@ -70,6 +72,7 @@ FROM SymbolTable IMPORT GetSymName, IsDefImp, NulSym,
                         GetImportStatementList ;
 
 FROM M2Search IMPORT FindSourceDefFile ;
+FROM M2Diagnostic IMPORT Diagnostic, InitMemDiagnostic, MemIncr, MemSet ;
 
 FROM FIO IMPORT File, StdErr, StdOut, Close, EOF, IsNoError, WriteLine,
                 WriteChar, FlushOutErr ;
@@ -80,8 +83,8 @@ FROM M2Printf IMPORT fprintf0, fprintf1 ;
 FROM M2Quiet IMPORT qprintf0, qprintf1, qprintf2 ;
 
 FROM M2Options IMPORT Verbose, GetM2Prefix, GetM, GetMM, GetDepTarget, GetMF, GetMP,
-                      GetObj, PPonly, Statistics, Quiet, WholeProgram, GetMD, GetMMD,
-                      ExtendedOpaque, GenModuleList ;
+                      GetObj, PPonly, Quiet, WholeProgram, GetMD, GetMMD,
+                      ExtendedOpaque, GenModuleList, TimeReport, MemReport ;
 
 FROM PathName IMPORT DumpPathName ;
 FROM Lists IMPORT List, NoOfItemsInList, GetItemFromList ;
@@ -92,6 +95,7 @@ FROM DynamicStrings IMPORT String, InitString, KillString, InitStringCharStar,
                            InitStringChar, RIndex, Slice, Equal, RemoveWhitePrefix ;
 
 
+
 CONST
    Debugging = FALSE ;
 
@@ -281,14 +285,43 @@ END Compile ;
 
 PROCEDURE compile (filename: ADDRESS) ;
 VAR
-   f: String ;
+   f, s: String ;
 BEGIN
+   M2Diagnostic.Configure (TimeReport, MemReport) ;
    f := InitStringCharStar (filename) ;
    Compile (f) ;
-   f := KillString (f)
+   f := KillString (f) ;
+   PopulateResource ;
+   IF TimeReport OR MemReport
+   THEN
+      s := WriteS (StdOut, M2Diagnostic.Generate (FALSE)) ;
+      FlushOutErr ;
+      s := KillString (s)
+   END
 END compile ;
 
 
+(*
+   PopulateResource -
+*)
+
+PROCEDURE PopulateResource ;
+VAR
+   StatsMemDiag: Diagnostic ;
+BEGIN
+   IF MemReport
+   THEN
+      StatsMemDiag
+         := InitMemDiagnostic
+            ('M2Comp:statistics',
+            'total source lines {1d} total constants {2d} total types {3d}') ;
+      MemSet (StatsMemDiag, 1, m2flex.GetTotalLines ()) ;
+      MemSet (StatsMemDiag, 2, m2block.GetTotalConstants ()) ;
+      MemSet (StatsMemDiag, 3, m2block.GetGlobalTypes ())
+   END
+END PopulateResource ;
+
+
 (*
    ExamineHeader - examines up until the ';', '[' or eof and determines if the source file
                    is a program, implementation/definition module.
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
index 860a89ac8b0..710976e449e 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -43,6 +43,7 @@ FROM M2Options IMPORT GenerateDebugging, GenerateLineDebug, Iso, Optimizing, Who
                       ScaffoldStatic, GetRuntimeModuleOverride ;
 
 FROM M2AsmUtil IMPORT GetFullSymName, GetFullScopeAsmName ;
+FROM FormatStrings IMPORT Sprintf1 ;
 
 FROM M2Batch IMPORT MakeDefinitionSource ;
 FROM NameKey IMPORT Name, MakeKey, NulName, KeyToCharStar, makekey ;
@@ -52,6 +53,7 @@ FROM M2LexBuf IMPORT TokenToLineNo, FindFileNameFromToken, TokenToLocation, Unkn
 FROM M2MetaError IMPORT MetaError1, MetaError2, MetaError3 ;
 FROM M2Error IMPORT FlushErrors, InternalError ;
 FROM M2LangDump IMPORT GetDumpFile ;
+FROM M2Diagnostic IMPORT Diagnostic, InitTimeDiagnostic, EnterDiagnostic, ExitDiagnostic ;
 
 FROM M2Printf IMPORT printf0, printf1, printf2, printf3,
                      fprintf0, fprintf1, fprintf2, fprintf3 ;
@@ -84,6 +86,7 @@ FROM SymbolTable IMPORT NulSym,
       	       	     	GetSubrange, PutSubrange, GetArraySubscript,
       	       	     	NoOfParamAny, GetNthParamAny,
                         PushValue, PopValue, PopSize,
+                        IsProcedureAnyNoReturn,
                         IsTemporary, IsUnbounded, IsPartialUnbounded,
                         IsEnumeration, IsVar,
       	       	     	IsSubrange, IsPointer, IsRecord, IsArray,
@@ -121,10 +124,11 @@ FROM SymbolTable IMPORT NulSym,
                         GetAlignment, IsDeclaredPacked, PutDeclaredPacked,
                         GetDefaultRecordFieldAlignment, IsDeclaredPackedResolved,
                         GetPackedEquivalent,
+                        GetSetArray, PutSetInWord,
                         GetParameterShadowVar,
                         GetUnboundedRecordType,
                         GetModuleCtors, GetProcedureProcType,
-                        MakeSubrange, MakeConstVar, MakeConstLit,
+                        MakeSubrange, MakeConstVar, MakeConstLit, MakeSetArray, PutSetArray,
                         PutConst,
 			ForeachOAFamily, GetOAFamily,
                         IsModuleWithinProcedure, IsVariableSSA,
@@ -194,7 +198,7 @@ FROM m2type IMPORT MarkFunctionReferenced, BuildStartRecord, BuildStartVarient,
                    BuildSetType, BuildEndVarient, BuildEndArrayType, InitFunctionTypeParameters,
                    BuildProcTypeParameterDeclaration, DeclareKnownType,
                    ValueOutOfTypeRange, ExceedsTypeRange,
-                   GetMaxFrom, GetMinFrom ;
+                   GetMaxFrom, GetMinFrom, GetBooleanEnumList ;
 
 FROM m2convert IMPORT BuildConvert ;
 
@@ -260,6 +264,8 @@ VAR
    action              : IsAction ;
    ConstantResolved,
    enumDeps            : BOOLEAN ;
+   tempset             : CARDINAL ; (* Count of the number of set     *)
+                                    (* arrays created.                *)
 
 
 (* *************************************************** *)
@@ -666,7 +672,7 @@ END GetEnumList ;
 
 PROCEDURE PutEnumList (sym: CARDINAL; enumlist: tree) ;
 BEGIN
-   PutIndice(EnumerationIndex, sym, enumlist)
+   PutIndice (EnumerationIndex, sym, enumlist)
 END PutEnumList ;
 
 
@@ -729,17 +735,17 @@ END DoStartDeclaration ;
 
 PROCEDURE ArrayComponentsDeclared (sym: CARDINAL) : BOOLEAN ;
 VAR
-   Subscript      : CARDINAL ;
+   Subscript      ,
    Type, High, Low: CARDINAL ;
 BEGIN
-   Subscript := GetArraySubscript(sym) ;
-   Assert(IsSubscript(Subscript)) ;
-   Type := GetDType(Subscript) ;
-   Low := GetTypeMin(Type) ;
-   High := GetTypeMax(Type) ;
-   RETURN( IsFullyDeclared(Type) AND
-           IsFullyDeclared(Low) AND
-           IsFullyDeclared(High) )
+   Subscript := GetArraySubscript (sym) ;
+   Assert (IsSubscript (Subscript)) ;
+   Type := GetDType (Subscript) ;
+   Low := GetTypeMin (Type) ;
+   High := GetTypeMax (Type) ;
+   RETURN( IsFullyDeclared (Type) AND
+           IsFullyDeclared (Low) AND
+           IsFullyDeclared (High) )
 END ArrayComponentsDeclared ;
 
 
@@ -815,11 +821,11 @@ END CanDeclareRecord ;
 
 PROCEDURE FinishDeclareRecord (sym: CARDINAL) ;
 BEGIN
-   DeclareTypeConstFully(sym) ;
-   WatchRemoveList(sym, heldbyalignment) ;
-   WatchRemoveList(sym, finishedalignment) ;
-   WatchRemoveList(sym, todolist) ;
-   WatchIncludeList(sym, fullydeclared)
+   DeclareTypeConstFully (sym) ;
+   WatchRemoveList (sym, heldbyalignment) ;
+   WatchRemoveList (sym, finishedalignment) ;
+   WatchRemoveList (sym, todolist) ;
+   WatchIncludeList (sym, fullydeclared)
 END FinishDeclareRecord ;
 
 
@@ -912,8 +918,14 @@ END CanDeclareArrayAsNil ;
 *)
 
 PROCEDURE DeclareArrayAsNil (sym: CARDINAL) ;
+VAR
+   tokenno    : CARDINAL ;
+   typeOfArray: CARDINAL ;
 BEGIN
-   PreAddModGcc(sym, BuildStartArrayType(BuildIndex(GetDeclaredMod(sym), sym), NIL, GetDType(sym))) ;
+   typeOfArray := GetDType(sym) ;
+   tokenno := GetDeclaredMod (sym) ;
+   PreAddModGcc(sym, BuildStartArrayType (BuildIndex (tokenno, sym, FALSE),
+                                          NIL, typeOfArray)) ;
    WatchIncludeList(sym, niltypedarrays)
 END DeclareArrayAsNil ;
 
@@ -1040,9 +1052,9 @@ BEGIN
    ELSIF IsArray(sym)
    THEN
       RETURN( IsArrayDependants(sym, q) )
-   ELSIF IsProcType(sym)
+   ELSIF IsProcType (sym)
    THEN
-      RETURN( IsProcTypeDependants(sym, q) )
+      RETURN( IsProcTypeDependants (sym, q) )
    ELSIF IsUnbounded(sym)
    THEN
       RETURN( IsUnboundedDependants(sym, q) )
@@ -1100,7 +1112,7 @@ END IsFullyDeclared ;
 
 PROCEDURE AllDependantsFullyDeclared (sym: CARDINAL) : BOOLEAN ;
 BEGIN
-   RETURN( IsTypeQ(sym, IsFullyDeclared) )
+   RETURN( IsTypeQ (sym, IsFullyDeclared) )
 END AllDependantsFullyDeclared ;
 
 
@@ -1111,7 +1123,7 @@ END AllDependantsFullyDeclared ;
 
 PROCEDURE NotAllDependantsFullyDeclared (sym: CARDINAL) : BOOLEAN ;
 BEGIN
-   RETURN( NOT IsTypeQ(sym, IsFullyDeclared) )
+   RETURN( NOT IsTypeQ (sym, IsFullyDeclared) )
 END NotAllDependantsFullyDeclared ;
 
 
@@ -1132,7 +1144,7 @@ END IsPartiallyDeclared ;
 
 PROCEDURE AllDependantsPartiallyDeclared (sym: CARDINAL) : BOOLEAN ;
 BEGIN
-   RETURN( IsTypeQ(sym, IsPartiallyDeclared) )
+   RETURN( IsTypeQ (sym, IsPartiallyDeclared) )
 END AllDependantsPartiallyDeclared ;
 
 
@@ -1143,7 +1155,7 @@ END AllDependantsPartiallyDeclared ;
 
 PROCEDURE NotAllDependantsPartiallyDeclared (sym: CARDINAL) : BOOLEAN ;
 BEGIN
-   RETURN( NOT IsTypeQ(sym, IsPartiallyDeclared) )
+   RETURN( NOT IsTypeQ (sym, IsPartiallyDeclared) )
 END NotAllDependantsPartiallyDeclared ;
 
 
@@ -1165,7 +1177,7 @@ END IsPartiallyOrFullyDeclared ;
 
 PROCEDURE AllDependantsPartiallyOrFullyDeclared (sym: CARDINAL) : BOOLEAN ;
 BEGIN
-   RETURN( IsTypeQ(sym, IsPartiallyOrFullyDeclared) )
+   RETURN( IsTypeQ (sym, IsPartiallyOrFullyDeclared) )
 END AllDependantsPartiallyOrFullyDeclared ;
 
 
@@ -1208,8 +1220,8 @@ END TypeConstDependantsFullyDeclared ;
 
 PROCEDURE CanBeDeclaredViaPartialDependants (sym: CARDINAL) : BOOLEAN ;
 BEGIN
-   RETURN( (IsPointer(sym) OR IsProcType(sym)) AND
-           AllDependantsPartiallyOrFullyDeclared(sym) )
+   RETURN( (IsPointer (sym) OR IsProcType (sym)) AND
+           AllDependantsPartiallyOrFullyDeclared (sym) )
 END CanBeDeclaredViaPartialDependants ;
 
 
@@ -1262,7 +1274,8 @@ BEGIN
          WatchIncludeList(sym, fullydeclared) ;
          WatchRemoveList(sym, partiallydeclared) ;
          WatchRemoveList(sym, todolist)
-      ELSE
+      ELSIF NOT IsFullyDeclared (sym)
+      THEN
          t := TypeConstFullyDeclared(sym) ;
          IF t#NIL
          THEN
@@ -1300,6 +1313,105 @@ BEGIN
 END DeclareTypeFromPartial ;
 
 
+(*
+   CanCreateSetArray - return true if we need to create a set array.
+                       All sets will have a set array created even
+                       if it is not required.
+*)
+
+PROCEDURE CanCreateSetArray (sym: CARDINAL) : BOOLEAN ;
+VAR
+   setarray: CARDINAL ;
+BEGIN
+   IF IsSet (sym) AND CanCreateSet (sym)
+   THEN
+      setarray := GetSetArray (sym) ;
+      IF setarray = NulSym
+      THEN
+         RETURN TRUE
+      ELSE
+         (* Set array already exists, this can occur if the set is a base type
+            (bitset for example).
+             So we just move the symbol to the correct state.  *)
+         WatchRemoveList (sym, todolist) ;
+         WatchIncludeList (sym, finishedsetarray) ;
+         (* WatchIncludeList (setarray, todolist)  *)
+      END
+   END ;
+   RETURN FALSE
+END CanCreateSetArray ;
+
+
+(*
+   CreateSetArray - declare the set array for a set type.
+*)
+
+PROCEDURE CreateSetArray (set: CARDINAL) ;
+VAR
+   type, array,
+   high, low  : CARDINAL ;
+BEGIN
+   type := GetSType (set) ;
+   low  := GetTypeMin (type) ;
+   high := GetTypeMax (type) ;
+   DeclareConstant (GetDeclaredMod (set), high) ;
+   DeclareConstant (GetDeclaredMod (set), low) ;
+   array := DeclareSetArray (set, low, high) ;
+   PutSetArray (set, array) ;
+   WatchRemoveList (set, todolist) ;
+   WatchIncludeList (set, finishedsetarray) ;
+   (* WatchIncludeList (array, todolist)  *)
+END CreateSetArray ;
+
+
+(*
+   CanCreateSet - returns TRUE if the set can be created.
+                  All dependents of sym have been declared to GCC.
+*)
+
+PROCEDURE CanCreateSet (set: CARDINAL) : BOOLEAN ;
+VAR
+   type, low, high: CARDINAL ;
+BEGIN
+   type := GetSType (set) ;
+   IF NOT GccKnowsAbout (type)
+   THEN
+      RETURN FALSE
+   END ;
+   low  := GetTypeMin (type) ;
+   high := GetTypeMax (type) ;
+   IF NOT GccKnowsAbout (low)
+   THEN
+      RETURN FALSE
+   END ;
+   IF NOT GccKnowsAbout (high)
+   THEN
+      RETURN FALSE
+   END ;
+   RETURN TRUE
+END CanCreateSet ;
+
+
+(*
+   CreateSet -
+*)
+
+PROCEDURE CreateSet (set: CARDINAL) ;
+VAR
+   gccset: tree ;
+BEGIN
+   gccset := DeclareSet (set) ;
+   IF gccset = NIL
+   THEN
+      InternalError ('expecting to be able to create a gcc type')
+   ELSE
+      AddModGcc (set, gccset) ;
+      WatchIncludeList (set, fullydeclared) ;
+      WatchRemoveList (set, finishedsetarray)
+   END
+END CreateSet ;
+
+
 (*
    CanBeDeclaredPartiallyViaPartialDependants - returns TRUE if, sym,
                                                 can be partially declared via
@@ -1308,7 +1420,7 @@ END DeclareTypeFromPartial ;
 
 PROCEDURE CanBeDeclaredPartiallyViaPartialDependants (sym: CARDINAL) : BOOLEAN ;
 BEGIN
-   RETURN( IsType(sym) AND AllDependantsPartiallyDeclared(sym) )
+   RETURN( IsType (sym) AND AllDependantsPartiallyDeclared (sym) )
 END CanBeDeclaredPartiallyViaPartialDependants ;
 
 
@@ -1339,7 +1451,8 @@ TYPE
    Rule = (norule, partialtype, arraynil, pointernilarray, arraypartial,
            pointerfully, recordkind, recordfully, typeconstfully,
            pointerfrompartial, typefrompartial, partialfrompartial,
-           partialtofully, circulartodo, circularpartial, circularniltyped) ;
+           partialtofully, circulartodo, circularpartial, circularniltyped,
+           setarraynul, setfully) ;
 
 VAR
    bodyp          : WalkAction ;
@@ -1361,22 +1474,24 @@ BEGIN
    THEN
       CASE bodyr OF
 
-      norule            :  printf0('norule') |
-      partialtype       :  printf0('partialtype') |
-      arraynil          :  printf0('arraynil') |
-      pointernilarray   :  printf0('pointernilarray') |
-      arraypartial      :  printf0('arraypartial') |
-      pointerfully      :  printf0('pointerfully') |
-      recordkind        :  printf0('recordkind') |
-      recordfully       :  printf0('recordfully') |
-      typeconstfully    :  printf0('typeconstfully') |
-      pointerfrompartial:  printf0('pointerfrompartial') |
-      typefrompartial   :  printf0('typefrompartial') |
-      partialfrompartial:  printf0('partialfrompartial') |
-      partialtofully    :  printf0('partialtofully') |
-      circulartodo      :  printf0('circulartodo') |
-      circularpartial   :  printf0('circularpartial') |
-      circularniltyped  :  printf0('circularniltyped')
+      norule            :  printf0 ('norule') |
+      partialtype       :  printf0 ('partialtype') |
+      arraynil          :  printf0 ('arraynil') |
+      pointernilarray   :  printf0 ('pointernilarray') |
+      arraypartial      :  printf0 ('arraypartial') |
+      pointerfully      :  printf0 ('pointerfully') |
+      recordkind        :  printf0 ('recordkind') |
+      recordfully       :  printf0 ('recordfully') |
+      typeconstfully    :  printf0 ('typeconstfully') |
+      pointerfrompartial:  printf0 ('pointerfrompartial') |
+      typefrompartial   :  printf0 ('typefrompartial') |
+      partialfrompartial:  printf0 ('partialfrompartial') |
+      partialtofully    :  printf0 ('partialtofully') |
+      circulartodo      :  printf0 ('circulartodo') |
+      circularpartial   :  printf0 ('circularpartial') |
+      circularniltyped  :  printf0 ('circularniltyped') |
+      setarraynul       :  printf0 ('setarraynul') |
+      setfully          :  printf0 ('setfully')
 
       ELSE
          InternalError ('unknown rule')
@@ -1450,6 +1565,7 @@ VAR
    finished: BOOLEAN ;
    copy    : Group ;
 BEGIN
+   EnterDiagnostic (DeclaredOutstandingTypesDiag) ;
    copy := NIL ;
    finished := FALSE ;
    REPEAT
@@ -1468,6 +1584,20 @@ BEGIN
                             DeclareTypePartially)
       THEN
          (* continue looping *)
+      ELSIF ForeachTryDeclare (todolist,
+                               setarraynul,
+                               CanCreateSetArray,
+                               CreateSetArray)
+      THEN
+         (* Populates the finishedsetarray list with each set seen.  *)
+         (* Continue looping.  *)
+      ELSIF ForeachTryDeclare (finishedsetarray,
+                               setfully,
+                               CanCreateSet,
+                               CreateSet)
+      THEN
+         (* Populates the fullydeclared list with each set.  *)
+         (* Continue looping.  *)
       ELSIF ForeachTryDeclare (todolist,
                                arraynil,
                                CanDeclareArrayAsNil,
@@ -1553,6 +1683,7 @@ BEGIN
       THEN
       END
    END ;
+   ExitDiagnostic (DeclaredOutstandingTypesDiag) ;
    RETURN NoOfElementsInSet (GlobalGroup^.ToDoList) = 0
 END DeclaredOutstandingTypes ;
 
@@ -1565,18 +1696,18 @@ END DeclaredOutstandingTypes ;
 
 PROCEDURE CompleteDeclarationOf (sym: CARDINAL) : tree ;
 BEGIN
-   IF IsArray(sym)
+   IF IsArray (sym)
    THEN
-      RETURN( DeclareArray(sym) )
-   ELSIF IsProcType(sym)
+      RETURN( DeclareArray (sym) )
+   ELSIF IsProcType (sym)
    THEN
-      RETURN( DeclareProcType(sym) )
-   ELSIF IsRecordField(sym)
+      RETURN( DeclareProcType (sym) )
+   ELSIF IsRecordField (sym)
    THEN
-      RETURN( DeclareRecordField(sym) )
-   ELSIF IsPointer(sym)
+      RETURN( DeclareRecordField (sym) )
+   ELSIF IsPointer (sym)
    THEN
-      RETURN( DeclarePointer(sym) )
+      RETURN( DeclarePointer (sym) )
    ELSE
       RETURN( NIL )
    END
@@ -1593,26 +1724,27 @@ VAR
    t       : tree ;
    location: location_t ;
 BEGIN
-   IF GetSType(sym)=NulSym
+   IF GetSType (sym) = NulSym
    THEN
-      MetaError1('base type {%1Ua} not understood', sym) ;
+      MetaError1 ('base type {%1Ua} not understood', sym) ;
       InternalError ('base type should have been declared')
    ELSE
-      IF GetSymName(sym)=NulName
+      IF GetSymName (sym) = NulName
       THEN
-         RETURN( tree(Mod2Gcc(GetSType(sym))) )
+         RETURN( tree (Mod2Gcc (GetSType (sym))) )
       ELSE
-         location := TokenToLocation(GetDeclaredMod(sym)) ;
-         IF GccKnowsAbout(sym)
+         location := TokenToLocation (GetDeclaredMod (sym)) ;
+         IF GccKnowsAbout (sym)
          THEN
-            t := Mod2Gcc(sym)
+            t := Mod2Gcc (sym)
          ELSE
-            (* not partially declared therefore start it *)
-            t := BuildStartType(location,
-                                KeyToCharStar(GetFullSymName(sym)), Mod2Gcc(GetSType(sym)))
+            (* Not partially declared therefore start it.  *)
+            t := BuildStartType (location,
+                                 KeyToCharStar (GetFullSymName (sym)),
+                                 Mod2Gcc (GetSType (sym)))
          END ;
-         t := BuildEndType(location, t) ;  (* now finish it *)
-         RETURN( t )
+         t := BuildEndType (location, t) ;  (* Now finish it.  *)
+         RETURN t
       END
    END
 END DeclareType ;
@@ -2183,9 +2315,9 @@ BEGIN
    ELSIF IsArray(sym)
    THEN
       WalkArrayDependants(sym, p)
-   ELSIF IsProcType(sym)
+   ELSIF IsProcType (sym)
    THEN
-      WalkProcTypeDependants(sym, p)
+      WalkProcTypeDependants (sym, p)
    ELSIF IsUnbounded(sym)
    THEN
       WalkUnboundedDependants(sym, p)
@@ -2235,11 +2367,11 @@ END TraverseDependantsInner ;
 
 PROCEDURE TraverseDependants (sym: WORD) ;
 BEGIN
-   IF VisitedList=NIL
+   IF VisitedList = NIL
    THEN
-      VisitedList := InitSet(1) ;
-      TraverseDependantsInner(sym) ;
-      VisitedList := KillSet(VisitedList)
+      VisitedList := InitSet (1) ;
+      TraverseDependantsInner (sym) ;
+      VisitedList := KillSet (VisitedList)
    ELSE
       InternalError ('recursive call to TraverseDependants caught')
    END
@@ -2247,7 +2379,20 @@ END TraverseDependants ;
 
 
 (*
-   WalkTypeInfo - walks type, sym, and its dependants.
+   WalkUnbounded -
+*)
+
+PROCEDURE WalkUnbounded (sym: WORD) ;
+BEGIN
+   Assert (IsUnbounded (sym)) ;
+   TraverseDependants (sym) ;
+   WalkTypeInfo (GetUnboundedRecordType (sym)) ;
+   WalkTypeInfo (GetSType (sym))
+END WalkUnbounded ;
+
+
+(*
+   WalkTypeInfo - walks type sym and its dependants.
 *)
 
 PROCEDURE WalkTypeInfo (sym: WORD) ;
@@ -2255,16 +2400,25 @@ BEGIN
    IF IsVarient(sym)
    THEN
       InternalError ('why have we reached here?')
-   ELSIF IsVar(sym)
+   ELSIF IsVar (sym)
    THEN
-      WalkTypeInfo(GetSType(sym)) ;
-      IF GetVarBackEndType(sym)#NulSym
+      WalkTypeInfo (GetSType (sym)) ;
+      IF GetVarBackEndType (sym) # NulSym
       THEN
-         WalkTypeInfo(GetVarBackEndType(sym))
+         WalkTypeInfo (GetVarBackEndType (sym))
       END
-   ELSIF IsAModula2Type(sym)
+   ELSIF IsUnbounded (sym)
    THEN
-      TraverseDependants(sym)
+      WalkUnbounded (sym)
+   ELSIF IsAModula2Type (sym)
+   THEN
+      TraverseDependants (sym)
+   ELSIF IsProcedure (sym)
+   THEN
+      WalkProcedureDependants (sym, WalkTypeInfo)
+   ELSIF IsProcType (sym)
+   THEN
+      WalkProcTypeDependants (sym, WalkTypeInfo)
    END
 END WalkTypeInfo ;
 
@@ -2341,7 +2495,7 @@ END WalkUnboundedProcedureParameters ;
 
 PROCEDURE WalkTypesInProcedure (sym: WORD) ;
 BEGIN
-   ForeachLocalSymDo(sym, TraverseDependants)
+   ForeachLocalSymDo (sym, TraverseDependants)
 END WalkTypesInProcedure ;
 
 
@@ -2358,9 +2512,9 @@ BEGIN
       n := GetSymName(sym) ;
       printf1('Declaring types in MODULE %a\n', n)
    END ;
-   ForeachLocalSymDo(sym, WalkTypeInfo) ;
-   ForeachLocalSymDo(sym, WalkUnboundedProcedureParameters) ;
-   ForeachInnerModuleDo(sym, WalkTypesInModule)
+   ForeachLocalSymDo (sym, WalkTypeInfo) ;
+   ForeachLocalSymDo (sym, WalkUnboundedProcedureParameters) ;
+   ForeachInnerModuleDo (sym, WalkTypesInModule)
 END WalkTypesInModule ;
 
 
@@ -2375,12 +2529,12 @@ VAR
    final: BOOLEAN ;
 BEGIN
    final := TRUE ;
-   IF NOT q(GetSType(sym))
+   IF NOT q (GetSType (sym))
    THEN
       final := FALSE
    END ;
-   align := GetAlignment(sym) ;
-   IF (align#NulSym) AND (NOT q(align))
+   align := GetAlignment (sym) ;
+   IF (align # NulSym) AND (NOT q (align))
    THEN
       final := FALSE
    END ;
@@ -2494,7 +2648,7 @@ END IsExternalToWholeProgram ;
    DeclareProcedureToGccWholeProgram -
 *)
 
-PROCEDURE DeclareProcedureToGccWholeProgram (Sym: CARDINAL) ;
+PROCEDURE DeclareProcedureToGccWholeProgram (ProcedureSym: CARDINAL) ;
 VAR
    returnType,
    GccParam  : tree ;
@@ -2505,19 +2659,20 @@ VAR
    begin, end,
    location  : location_t ;
 BEGIN
-   IF (NOT GccKnowsAbout(Sym)) AND (NOT IsPseudoProcFunc(Sym))
+   Assert (IsProcedure (ProcedureSym)) ;
+   IF (NOT GccKnowsAbout(ProcedureSym)) AND (NOT IsPseudoProcFunc(ProcedureSym))
    THEN
-      BuildStartFunctionDeclaration(UsesVarArgs(Sym)) ;
-      p := NoOfParamAny (Sym) ;
+      BuildStartFunctionDeclaration(UsesVarArgs(ProcedureSym)) ;
+      p := NoOfParamAny (ProcedureSym) ;
       i := p ;
       WHILE i>0 DO
          (* note we dont use GetNthParamAny as we want the parameter that is seen by the procedure block
             remember that this is treated exactly the same as a variable, just its position on
             the activation record is special (ie a parameter)
          *)
-         Variable := GetNth(Sym, i) ;
-         location := TokenToLocation(GetDeclaredMod(Variable)) ;
-         IF IsUnboundedParamAny (Sym, i)
+         Variable := GetNth (ProcedureSym, i) ;
+         location := TokenToLocation (GetDeclaredMod (Variable)) ;
+         IF IsUnboundedParamAny (ProcedureSym, i)
          THEN
             GccParam := BuildParameterDeclaration(location,
                                                   KeyToCharStar(GetSymName(Variable)),
@@ -2527,34 +2682,34 @@ BEGIN
             GccParam := BuildParameterDeclaration(location,
                                                   KeyToCharStar(GetSymName(Variable)),
                                                   Mod2Gcc(GetLType(Variable)),
-                                                  IsVarParamAny (Sym, i))
+                                                  IsVarParamAny (ProcedureSym, i))
          END ;
          PreAddModGcc(Variable, GccParam) ;
          WatchRemoveList(Variable, todolist) ;
          WatchIncludeList(Variable, fullydeclared) ;
          DEC(i)
       END ;
-      GetProcedureBeginEnd(Sym, b, e) ;
+      GetProcedureBeginEnd(ProcedureSym, b, e) ;
       begin := TokenToLocation(b) ;
       end := TokenToLocation(e) ;
-      scope := GetScope(Sym) ;
+      scope := GetScope(ProcedureSym) ;
       PushBinding(scope) ;
-      IF GetSType(Sym)=NulSym
+      IF GetSType(ProcedureSym)=NulSym
       THEN
          returnType := NIL
       ELSE
-         returnType := Mod2Gcc(GetSType(Sym))
+         returnType := Mod2Gcc(GetSType(ProcedureSym))
       END ;
-      PreAddModGcc(Sym, BuildEndFunctionDeclaration(begin, end,
-                                                    KeyToCharStar(GetFullSymName(Sym)),
-                                                    returnType,
-                                                    IsExternalToWholeProgram(Sym),
-                                                    IsProcedureGccNested(Sym),
-                                                    IsExported(GetModuleWhereDeclared(Sym), Sym),
-                                                    IsProcedureAnyNoReturn(Sym))) ;
+      PreAddModGcc(ProcedureSym, BuildEndFunctionDeclaration(begin, end,
+                                                             KeyToCharStar(GetFullSymName(ProcedureSym)),
+                                                             returnType,
+                                                             IsExternalToWholeProgram(ProcedureSym),
+                                                             IsProcedureGccNested(ProcedureSym),
+                                                             IsExported(GetModuleWhereDeclared(ProcedureSym), ProcedureSym),
+                                                             IsProcedureAnyNoReturn(ProcedureSym))) ;
       PopBinding(scope) ;
-      WatchRemoveList(Sym, todolist) ;
-      WatchIncludeList(Sym, fullydeclared)
+      WatchRemoveList(ProcedureSym, todolist) ;
+      WatchIncludeList(ProcedureSym, fullydeclared)
    END
 END DeclareProcedureToGccWholeProgram ;
 
@@ -2563,7 +2718,7 @@ END DeclareProcedureToGccWholeProgram ;
    DeclareProcedureToGccSeparateProgram -
 *)
 
-PROCEDURE DeclareProcedureToGccSeparateProgram (Sym: CARDINAL) ;
+PROCEDURE DeclareProcedureToGccSeparateProgram (ProcedureSym: CARDINAL) ;
 VAR
    returnType,
    GccParam  : tree ;
@@ -2575,64 +2730,76 @@ VAR
    location  : location_t ;
    tok       : CARDINAL ;
 BEGIN
-   tok := GetDeclaredMod(Sym) ;
-   IF (NOT GccKnowsAbout(Sym)) AND (NOT IsPseudoProcFunc(Sym)) AND
-      (IsEffectivelyImported(GetMainModule(), Sym) OR
-       (GetModuleWhereDeclared (Sym) = GetMainModule()) OR
-       IsNeededAtRunTime (tok, Sym) OR
-       IsImported (GetBaseModule (), Sym) OR
-       IsExported(GetModuleWhereDeclared (Sym), Sym) OR
-       IsExtern (Sym))
-   THEN
-      BuildStartFunctionDeclaration(UsesVarArgs(Sym)) ;
-      p := NoOfParamAny (Sym) ;
+   Assert (IsProcedure (ProcedureSym)) ;
+   tok := GetDeclaredMod (ProcedureSym) ;
+   IF (NOT GccKnowsAbout (ProcedureSym)) AND (NOT IsPseudoProcFunc (ProcedureSym)) AND
+      (IsEffectivelyImported (GetMainModule (), ProcedureSym) OR
+       (GetModuleWhereDeclared (ProcedureSym) = GetMainModule ()) OR
+       IsNeededAtRunTime (tok, ProcedureSym) OR
+       IsImported (GetBaseModule (), ProcedureSym) OR
+       IsExported(GetModuleWhereDeclared (ProcedureSym), ProcedureSym) OR
+       IsExtern (ProcedureSym))
+   THEN
+      BuildStartFunctionDeclaration (UsesVarArgs (ProcedureSym)) ;
+      p := NoOfParamAny (ProcedureSym) ;
       i := p ;
-      WHILE i>0 DO
+      WHILE i > 0 DO
          (* Note we dont use GetNthParamAny as we want the parameter that is seen by
             the procedure block remember that this is treated exactly the same as
             a variable, just its position on the activation record is special (ie
             a parameter).  *)
-         Variable := GetNth(Sym, i) ;
-         location := TokenToLocation(GetDeclaredMod(Variable)) ;
-         IF IsUnboundedParamAny (Sym, i)
+         Variable := GetNth (ProcedureSym, i) ;
+         location := TokenToLocation (GetDeclaredMod (Variable)) ;
+         IF GetSType (Variable) = NulSym
          THEN
-            GccParam := BuildParameterDeclaration(location,
-                                                  KeyToCharStar(GetSymName(Variable)),
-                                                  Mod2Gcc(GetLType(Variable)),
-                                                  FALSE)
+            MetaError1 ('internal error: the type of parameter {%1Ead} is nulsym', Variable) ;
+            FlushErrors
+         END ;
+         IF Mod2Gcc (GetSType (Variable)) = NIL
+         THEN
+            MetaError2 ('internal error: the type of parameter {%1Ead} in procedure {%2ad} has not been declared to GCC', Variable, ProcedureSym) ;
+            FlushErrors ;
+            Assert (AllDependantsFullyDeclared (ProcedureSym))
+         END ;
+         IF IsUnboundedParamAny (ProcedureSym, i)
+         THEN
+            GccParam := BuildParameterDeclaration (location,
+                                                   KeyToCharStar (GetSymName (Variable)),
+                                                   Mod2Gcc (GetLType (Variable)),
+                                                   FALSE)
          ELSE
-            GccParam := BuildParameterDeclaration(location,
-                                                  KeyToCharStar(GetSymName(Variable)),
-                                                  Mod2Gcc(GetLType(Variable)),
-                                                  IsVarParamAny (Sym, i))
+            GccParam := BuildParameterDeclaration (location,
+                                                   KeyToCharStar (GetSymName (Variable)),
+                                                   Mod2Gcc (GetLType (Variable)),
+                                                   IsVarParamAny (ProcedureSym, i))
          END ;
-         PreAddModGcc(Variable, GccParam) ;
-         WatchRemoveList(Variable, todolist) ;
-         WatchIncludeList(Variable, fullydeclared) ;
-         DEC(i)
+         PreAddModGcc (Variable, GccParam) ;
+         WatchRemoveList (Variable, todolist) ;
+         WatchIncludeList (Variable, fullydeclared) ;
+         DEC (i)
       END ;
-      GetProcedureBeginEnd(Sym, b, e) ;
-      begin := TokenToLocation(b) ;
-      end := TokenToLocation(e) ;
-      scope := GetScope(Sym) ;
-      PushBinding(scope) ;
-      IF GetSType(Sym)=NulSym
+      GetProcedureBeginEnd (ProcedureSym, b, e) ;
+      begin := TokenToLocation (b) ;
+      end := TokenToLocation (e) ;
+      scope := GetScope (ProcedureSym) ;
+      PushBinding (scope) ;
+      IF GetSType (ProcedureSym) = NulSym
       THEN
          returnType := NIL
       ELSE
-         returnType := Mod2Gcc(GetSType(Sym))
+         returnType := Mod2Gcc (GetSType (ProcedureSym))
       END ;
-      PreAddModGcc (Sym, BuildEndFunctionDeclaration (begin, end,
-                                                      KeyToCharStar (GetFullSymName (Sym)),
-                                                      returnType,
-                                                      IsExternal (Sym),  (* Extern relative to the main module.  *)
-                                                      IsProcedureGccNested (Sym),
-                                                      (* Exported from the module where it was declared.  *)
-                                                      IsExported (GetModuleWhereDeclared (Sym), Sym) OR IsExtern (Sym),
-                                                      IsProcedureAnyNoReturn(Sym))) ;
-      PopBinding(scope) ;
-      WatchRemoveList(Sym, todolist) ;
-      WatchIncludeList(Sym, fullydeclared)
+      PreAddModGcc (ProcedureSym, BuildEndFunctionDeclaration (begin, end,
+                                                               KeyToCharStar (GetFullSymName (ProcedureSym)),
+                                                               returnType,
+                                                               IsExternal (ProcedureSym),  (* Extern relative to the main module.  *)
+                                                               IsProcedureGccNested (ProcedureSym),
+                                                               (* Exported from the module where it was declared.  *)
+                                                               IsExported (GetModuleWhereDeclared (ProcedureSym), ProcedureSym) OR IsExtern (ProcedureSym),
+                                                               IsProcedureAnyNoReturn (ProcedureSym))) ;
+      PopBinding (scope) ;
+      WatchRemoveList (ProcedureSym, todolist) ;
+      WatchIncludeList (ProcedureSym, fullydeclared)
    END
 END DeclareProcedureToGccSeparateProgram ;
 
@@ -2741,6 +2908,7 @@ BEGIN
    THEN
       DisplayQuadRange (scope, start, end)
    END ;
+   EnterDiagnostic (DeclareTypesConstantsProceduresInRangeDiag) ;
    loop := 0 ;
    copy := NIL ;
    sb := InitScopeBlock (scope) ;
@@ -2772,7 +2940,8 @@ BEGIN
    KillGroup (copy) ;
    bb := InitBasicBlocks (sb) ;
    KillBasicBlocks (bb) ;
-   KillScopeBlock (sb)
+   KillScopeBlock (sb) ;
+   ExitDiagnostic (DeclareTypesConstantsProceduresInRangeDiag)
 END DeclareTypesConstantsProceduresInRange ;
 
 
@@ -2839,6 +3008,7 @@ BEGIN
    THEN
       printf0 ("declaring types constants in: ") ; PrintTerse (scope)
    END ;
+   EnterDiagnostic (DeclareTypesConstantsProceduresDiag) ;
    copy := NIL ;
    sb := InitScopeBlock (scope) ;
    PushBinding (scope) ;
@@ -2848,7 +3018,8 @@ BEGIN
    UNTIL EqualGroup (copy, GlobalGroup) ;
    KillGroup (copy) ;
    PopBinding (scope) ;
-   KillScopeBlock (sb)
+   KillScopeBlock (sb) ;
+   ExitDiagnostic (DeclareTypesConstantsProceduresDiag)
 END DeclareTypesConstantsProcedures ;
 
 
@@ -2902,16 +3073,16 @@ END DeclareModuleInit ;
 
 PROCEDURE StartDeclareProcedureScope (scope: CARDINAL) ;
 BEGIN
-   WalkTypesInProcedure(scope) ;
-   DeclareProcedure(scope) ;
-   ForeachInnerModuleDo(scope, WalkTypesInModule) ;
+   WalkTypesInProcedure (scope) ;
+   DeclareProcedure (scope) ;
+   ForeachInnerModuleDo (scope, WalkTypesInModule) ;
    DeclareTypesConstantsProcedures (scope) ;
-   ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
-   DeclareLocalVariables(scope) ;
-   ForeachInnerModuleDo(scope, DeclareModuleVariables) ;
-   AssertAllTypesDeclared(scope) ;
-   ForeachProcedureDo(scope, DeclareProcedure) ;
-   ForeachInnerModuleDo(scope, StartDeclareScope)
+   ForeachInnerModuleDo (scope, DeclareTypesConstantsProcedures) ;
+   DeclareLocalVariables (scope) ;
+   ForeachInnerModuleDo (scope, DeclareModuleVariables) ;
+   AssertAllTypesDeclared (scope) ;
+   ForeachProcedureDo (scope, DeclareProcedure) ;
+   ForeachInnerModuleDo (scope, StartDeclareScope)
 END StartDeclareProcedureScope ;
 
 
@@ -3122,20 +3293,20 @@ END PreAddModGcc ;
 PROCEDURE DeclareDefaultType (sym: CARDINAL; name: ARRAY OF CHAR; gcctype: tree) ;
 VAR
    t        : tree ;
+   array,
    high, low: CARDINAL ;
    location : location_t ;
 BEGIN
-   (* DeclareDefaultType will declare a new identifier as a type of, gcctype, if it has not already been
-      declared by gccgm2.c *)
+   (* DeclareDefaultType will declare a new identifier as a type of gcctype
+      if it has not already been declared.  *)
    location := BuiltinsLocation () ;
    t := GetDefaultType(location, KeyToCharStar(MakeKey(name)), gcctype) ;
-   AddModGcc(sym, t) ;
-   IncludeElementIntoSet(GlobalGroup^.FullyDeclared, sym) ;
-   WalkAssociatedUnbounded(sym, TraverseDependants) ;
-   (*
-      this is very simplistic and assumes that the caller only uses Subranges, Sets and GCC types.
-      We need to declare any constants with the types so that AllDependantsFullyDeclared works.
-   *)
+   AddModGcc (sym, t) ;
+   IncludeElementIntoSet (GlobalGroup^.FullyDeclared, sym) ;
+   WalkAssociatedUnbounded (sym, TraverseDependants) ;
+   (* This is very simplistic and assumes that the caller only uses Subranges,
+      Sets and GCC types.  We need to declare any constants with the types so
+      that AllDependantsFullyDeclared works.  *)
    IF IsSubrange(sym)
    THEN
       GetSubrange(sym, high, low) ;
@@ -3147,17 +3318,20 @@ BEGIN
       THEN
          IF NOT GccKnowsAbout(GetSType(sym))
          THEN
-            (* only true for internal types of course *)
+            (* Only true for internal types of course.  *)
             InternalError ('subrange type within the set type must be declared before the set type')
          END ;
          GetSubrange(GetSType(sym), high, low) ;
          DeclareConstant(GetDeclaredMod(sym), high) ;
-         DeclareConstant(GetDeclaredMod(sym), low)
+         DeclareConstant(GetDeclaredMod(sym), low) ;
+         array := DeclareSetArray (sym, low, high) ;
+         (* IncludeElementIntoSet (FullyDeclared, array) ; *)
+         PutSetArray (sym, array)
       ELSIF IsEnumeration(GetSType(sym))
       THEN
          IF NOT GccKnowsAbout(GetSType(sym))
          THEN
-            (* only true for internal types of course *)
+            (* Only true for internal types of course.  *)
             InternalError ('enumeration type within the set type must be declared before the set type')
          END
       END
@@ -3473,7 +3647,7 @@ BEGIN
               We do not add an extra pointer if this is the case.
       *)
       varType := SkipType (GetVarBackEndType (var)) ;
-      IF varType=NulSym
+      IF varType = NulSym
       THEN
          (* We have not explicity told back end the type, so build it.  *)
          varType := GetSType (var) ;
@@ -3590,7 +3764,7 @@ BEGIN
       INC (n) ;
       Variable := GetNth (ModSym, n)
    END ;
-   ForeachInnerModuleDo(ModSym, DeclareGlobalVariablesWholeProgram)
+   ForeachInnerModuleDo (ModSym, DeclareGlobalVariablesWholeProgram)
 END DeclareGlobalVariablesWholeProgram ;
 
 
@@ -4002,7 +4176,8 @@ PROCEDURE PrintAlignment (sym: CARDINAL) ;
 VAR
    align: CARDINAL ;
 BEGIN
-   IF IsRecord(sym) OR IsType(sym) OR IsRecordField(sym) OR IsPointer(sym) OR IsArray(sym)
+   IF IsRecord(sym) OR IsType(sym) OR IsRecordField(sym) OR
+      IsPointer(sym) OR IsArray(sym)
    THEN
       align := GetAlignment(sym) ;
       IF align#NulSym
@@ -4164,7 +4339,7 @@ BEGIN
    PrintDeclared (sym) ;
    fprintf0 (GetDumpFile (), '\n') ;
    FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
-      fprintf0 (GetDumpFile (), 'parameters ') ;
+      fprintf0 (GetDumpFile (), ' parameters ') ;
       PrintKind (kind) ;
       IF GetProcedureParametersDefined (sym, kind)
       THEN
@@ -4271,6 +4446,19 @@ BEGIN
 END PrintString ;
 
 
+(*
+   PrintKnown -
+*)
+
+PROCEDURE PrintKnown (sym: CARDINAL) ;
+BEGIN
+   IF GccKnowsAbout (sym)
+   THEN
+      printf0 ("[gcc]")
+   END
+END PrintKnown ;
+
+
 (*
    PrintVerboseFromList - prints the, i, th element in the list, l.
 *)
@@ -4870,9 +5058,9 @@ VAR
 BEGIN
    location := TokenToLocation(GetDeclaredMod(sym)) ;
    Assert(IsSet(sym)) ;
-   type := GetDType(sym) ;
-   low := GetTypeMin(type) ;
-   high := GetTypeMax(type) ;
+   type := GetDType(sym) ;   (* Was GetSType.  *)
+   low := GetTypeMin (type) ;
+   high := GetTypeMax (type) ;
    highLimit := BuildSub(location, Mod2Gcc(high), Mod2Gcc(low), FALSE) ;
    (* --fixme-- we need to check that low <= WORDLENGTH.  *)
    highLimit := BuildLSL(location, GetIntegerOne(location), highLimit, FALSE) ;
@@ -4918,7 +5106,7 @@ BEGIN
    location := TokenToLocation(GetDeclaredMod(sym)) ;
    gccenum := BuildStartEnumeration(location, KeyToCharStar(GetFullSymName(sym)), TRUE) ;
    ForeachLocalSymDo(sym, DeclarePackedFieldEnumeration) ;
-   enumlist := GetEnumList(equiv) ;
+   enumlist := GetEnumList (equiv) ;
    gccenum := BuildEndEnumeration(location, gccenum, enumlist) ;
    AddModGcc(equiv, gccenum)
 END DeclarePackedEnumeration ;
@@ -5247,11 +5435,12 @@ END DeclareUnbounded ;
    BuildIndex -
 *)
 
-PROCEDURE BuildIndex (tokenno: CARDINAL; array: CARDINAL) : tree ;
+PROCEDURE BuildIndex (tokenno: CARDINAL; array: CARDINAL; isset: BOOLEAN) : tree ;
 VAR
    Subscript: CARDINAL ;
    Type,
    High, Low: CARDINAL ;
+   indexType,
    n,
    low, high: tree ;
    location : location_t ;
@@ -5272,18 +5461,25 @@ BEGIN
       n := BuildConvert (location, GetIntegerType (), BuildSub (location, high, low, FALSE), FALSE) ;
       IF TreeOverflow(n) OR ValueOutOfTypeRange (GetIntegerType (), n)
       THEN
-         MetaError3('implementation restriction, array is too large {%1EDM}, the range {%2ad}..{%3ad} exceeds the integer range',
-                    array, Low, High) ;
-         RETURN BuildArrayIndexType (GetIntegerZero (location), GetIntegerZero (location))
+         IF isset
+         THEN
+            MetaError3('implementation restriction, set is too large {%1EDM}, the range {%2ad}..{%3ad} exceeds the integer range',
+                       array, Low, High)
+         ELSE
+            MetaError3('implementation restriction, array is too large {%1EDM}, the range {%2ad}..{%3ad} exceeds the integer range',
+                       array, Low, High)
+         END ;
+         indexType := BuildArrayIndexType (GetIntegerZero (location), GetIntegerZero (location))
       ELSE
          PutArrayLarge (array) ;
-	 RETURN BuildArrayIndexType (GetIntegerZero (location), n)
+	 indexType := BuildArrayIndexType (GetIntegerZero (location), n)
       END
    ELSE
       low := BuildConvert (location, GetIntegerType (), low, FALSE) ;
       high := BuildConvert (location, GetIntegerType (), high, FALSE) ;
-      RETURN BuildArrayIndexType (low, high)
-   END
+      indexType := BuildArrayIndexType (low, high)
+   END ;
+   RETURN indexType
 END BuildIndex ;
 
 
@@ -5307,24 +5503,24 @@ BEGIN
    location := TokenToLocation(tokenno) ;
 
    Subscript := GetArraySubscript(Sym) ;
-   typeOfArray := GetDType(Sym) ;
+   typeOfArray := GetDType (Sym) ;
    GccArray := Mod2Gcc(typeOfArray) ;
-   GccIndex := BuildIndex(tokenno, Sym) ;
+   GccIndex := BuildIndex (tokenno, Sym, FALSE) ;
 
-   IF GccKnowsAbout(Sym)
+   IF GccKnowsAbout (Sym)
    THEN
-      ArrayType := Mod2Gcc(Sym)
+      ArrayType := Mod2Gcc (Sym)
    ELSE
-      ArrayType := BuildStartArrayType(GccIndex, GccArray, typeOfArray) ;
-      PreAddModGcc(Sym, ArrayType)
+      ArrayType := BuildStartArrayType (GccIndex, GccArray, typeOfArray) ;
+      PreAddModGcc (Sym, ArrayType)
    END ;
 
-   PreAddModGcc(Subscript, GccArray) ;       (* we save the type of this array as the subscript *)
-   PushIntegerTree(BuildSize(location, GccArray, FALSE)) ;  (* and the size of this array so far *)
-   PopSize(Subscript) ;
+   PreAddModGcc (Subscript, GccArray) ;       (* we save the type of this array as the subscript *)
+   PushIntegerTree (BuildSize (location, GccArray, FALSE)) ;  (* and the size of this array so far *)
+   PopSize (Subscript) ;
 
-   GccArray := BuildEndArrayType(ArrayType, GccArray, GccIndex, typeOfArray) ;
-   Assert(GccArray=ArrayType) ;
+   GccArray := BuildEndArrayType (ArrayType, GccArray, GccIndex, typeOfArray) ;
+   Assert (GccArray = ArrayType) ;
 
    RETURN( GccArray )
 END DeclareArray ;
@@ -5408,13 +5604,13 @@ PROCEDURE GetTypeMin (type: CARDINAL) : CARDINAL ;
 VAR
    min, max: CARDINAL ;
 BEGIN
-   IF IsSubrange(type)
+   IF IsSubrange (type)
    THEN
-      GetSubrange(type, max, min) ;
+      GetSubrange (type, max, min) ;
       RETURN( min )
    ELSIF IsSet(type)
    THEN
-      RETURN( GetTypeMin(GetSType(type)) )
+      RETURN( GetTypeMin (GetSType (type)) )
    ELSIF IsEnumeration(type)
    THEN
       MinEnumerationField := NulSym ;
@@ -5423,18 +5619,18 @@ BEGIN
       RETURN( MinEnumerationField )
    ELSIF IsBaseType(type)
    THEN
-      GetBaseTypeMinMax(type, min, max) ;
+      GetBaseTypeMinMax (type, min, max) ;
       RETURN( min )
-   ELSIF IsSystemType(type)
+   ELSIF IsSystemType (type)
    THEN
-      GetSystemTypeMinMax(type, min, max) ;
+      GetSystemTypeMinMax (type, min, max) ;
       RETURN( min )
-   ELSIF GetSType(type)=NulSym
+   ELSIF GetSType (type) = NulSym
    THEN
-      MetaError1('unable to obtain the MIN value for type {%1as}', type) ;
+      MetaError1 ('unable to obtain the MIN value for type {%1as}', type) ;
       RETURN NulSym
    ELSE
-      RETURN( GetTypeMin(GetSType(type)) )
+      RETURN( GetTypeMin (GetSType (type)) )
    END
 END GetTypeMin ;
 
@@ -5447,33 +5643,33 @@ PROCEDURE GetTypeMax (type: CARDINAL) : CARDINAL ;
 VAR
    min, max: CARDINAL ;
 BEGIN
-   IF IsSubrange(type)
+   IF IsSubrange (type)
    THEN
-      GetSubrange(type, max, min) ;
+      GetSubrange (type, max, min) ;
       RETURN( max )
-   ELSIF IsSet(type)
+   ELSIF IsSet (type)
    THEN
-      RETURN( GetTypeMax(GetSType(type)) )
-   ELSIF IsEnumeration(type)
+      RETURN( GetTypeMax (GetSType (type)) )
+   ELSIF IsEnumeration (type)
    THEN
       MinEnumerationField := NulSym ;
       MaxEnumerationField := NulSym ;
       ForeachLocalSymDo (type, FindMinMaxEnum) ;
       RETURN( MaxEnumerationField )
-   ELSIF IsBaseType(type)
+   ELSIF IsBaseType (type)
    THEN
-      GetBaseTypeMinMax(type, min, max) ;
+      GetBaseTypeMinMax (type, min, max) ;
       RETURN( max )
-   ELSIF IsSystemType(type)
+   ELSIF IsSystemType (type)
    THEN
-      GetSystemTypeMinMax(type, min, max) ;
+      GetSystemTypeMinMax (type, min, max) ;
       RETURN( max )
-   ELSIF GetSType(type)=NulSym
+   ELSIF GetSType (type) = NulSym
    THEN
-      MetaError1('unable to obtain the MAX value for type {%1as}', type) ;
+      MetaError1 ('unable to obtain the MAX value for type {%1as}', type) ;
       RETURN NulSym
    ELSE
-      RETURN( GetTypeMax(GetSType(type)) )
+      RETURN( GetTypeMax (GetSType (type)) )
    END
 END GetTypeMax ;
 
@@ -5495,101 +5691,33 @@ END PushNoOfBits ;
 
 
 (*
-   DeclareLargeSet - n is the name of the set.
-                     type is the subrange type (or simple type)
-                     low and high are the limits of the subrange.
-*)
+   DeclareSetArrayOrBitSet - works out whether the set will exceed SIZE (BITSET).
+                             If it does we manufacture a set using:
 
-PROCEDURE DeclareLargeSet (n: Name; type: CARDINAL; low, high: CARDINAL) : tree ;
-VAR
-   lowtree,
-   hightree,
-   BitsInSet,
-   RecordType,
-   GccField,
-   FieldList : tree ;
-   bpw       : CARDINAL ;
-   location  : location_t ;
-BEGIN
-   location   := TokenToLocation(GetDeclaredMod(type)) ;
-   bpw        := GetBitsPerBitset() ;
-   PushValue(low) ;
-   lowtree    := PopIntegerTree() ;
-   PushValue(high) ;
-   hightree   := PopIntegerTree() ;
-   FieldList  := tree(NIL) ;
-   RecordType := BuildStartRecord(location, KeyToCharStar(n)) ;  (* no problem with recursive types here *)
-   PushNoOfBits(type, low, high) ;
-   PushCard(1) ;
-   Addn ;
-   BitsInSet := PopIntegerTree() ;
-   PushIntegerTree(BitsInSet) ;
-   PushCard(0) ;
-   WHILE Gre(GetDeclaredMod(type)) DO
-      PushIntegerTree(BitsInSet) ;
-      PushCard(bpw-1) ;
-      IF GreEqu(GetDeclaredMod(type))
-      THEN
-         PushIntegerTree(lowtree) ;
-         PushCard(bpw-1) ;
-         Addn ;
-         GccField := BuildFieldRecord(location, NIL, BuildSetType(location, NIL, Mod2Gcc(type), lowtree, PopIntegerTree(), FALSE)) ;
-         PushIntegerTree(lowtree) ;
-         PushCard(bpw) ;
-         Addn ;
-         lowtree := PopIntegerTree() ;
-         PushIntegerTree(BitsInSet) ;
-         PushCard(bpw) ;
-         Sub ;
-         BitsInSet := PopIntegerTree()
-      ELSE
-         (* printf2('range is %a..%a\n', GetSymName(low), GetSymName(high)) ; *)
-         GccField := BuildFieldRecord(location, NIL, BuildSetType(location, NIL, Mod2Gcc(type), lowtree, hightree, FALSE)) ;
-         PushCard(0) ;
-         BitsInSet := PopIntegerTree()
-      END ;
-      FieldList := ChainOn(FieldList, GccField) ;
-      PushIntegerTree(BitsInSet) ;
-      PushCard(0)
-   END ;
-   RETURN( BuildEndRecord(location, RecordType, FieldList, FALSE) )
-END DeclareLargeSet ;
-
-
-(*
-   DeclareLargeOrSmallSet - works out whether the set will exceed TSIZE(WORD). If it does
-                            we manufacture a set using:
+                             settype = ARRAY [0..totalBits DIV SIZE (BITSET)] OF BITSET ;
 
-                            settype = RECORD
-                                         w1: SET OF [...]
-                                         w2: SET OF [...]
-                                      END
-
-                            We do this as GCC and GDB (stabs) only knows about WORD sized sets.
-                            If the set will fit into a WORD then we call gccgm2 directly.
+                             When GCC supports dwarf5 set types this code should be revised.
+                             If the set will fit into a WORD then we call gccgm2 directly.
 *)
 
-PROCEDURE DeclareLargeOrSmallSet (sym: CARDINAL;
-                                  n: Name; type: CARDINAL; low, high: CARDINAL) : tree ;
+PROCEDURE DeclareSetArrayOrBitSet (sym: CARDINAL;
+                                   n: Name; type: CARDINAL; low, high: CARDINAL) : tree ;
 VAR
    location: location_t ;
-   packed  : BOOLEAN ;
-BEGIN
-   PushNoOfBits(type, low, high) ;
-   PushCard(GetBitsPerBitset()) ;
-   packed := IsSetPacked (sym) ;
-   IF Less(GetDeclaredMod(type))
-   THEN
-      location := TokenToLocation(GetDeclaredMod(sym)) ;
-      (* small set *)
-      (* PutSetSmall(sym) ; *)
-      RETURN BuildSetType (location, KeyToCharStar(n),
-                           Mod2Gcc(type), Mod2Gcc(low), Mod2Gcc(high), packed)
+BEGIN
+   PushNoOfBits (type, low, high) ;
+   PushCard (GetBitsPerBitset()) ;
+   location := TokenToLocation (GetDeclaredMod (sym)) ;
+   IF Less (GetDeclaredMod (type))
+   THEN
+      PutSetInWord (sym, TRUE) ;
+      RETURN BuildSetType (location, KeyToCharStar (n),
+                           Mod2Gcc (type), Mod2Gcc (low), Mod2Gcc (high), TRUE)
    ELSE
-      (* PutSetLarge(sym) ; *)
-      RETURN DeclareLargeSet (n, type, low, high)   (* --fixme-- finish packed here as well.  *)
+      PutSetInWord (sym, FALSE) ;
+      RETURN DeclareArray (GetSetArray (sym))
    END
-END DeclareLargeOrSmallSet ;
+END DeclareSetArrayOrBitSet ;
 
 
 (*
@@ -5602,15 +5730,17 @@ VAR
    type,
    high, low: CARDINAL ;
 BEGIN
-   type := GetDType(sym) ;
-   IF IsSubrange(type)
+   type := GetSType (sym) ;
+   IF IsSubrange (type)
    THEN
-      GetSubrange(type, high, low) ;
-      gccsym := DeclareLargeOrSmallSet(sym, GetFullSymName(sym), GetSType(type), low, high)
+      GetSubrange (type, high, low) ;
+      gccsym := DeclareSetArrayOrBitSet (sym, GetFullSymName (sym),
+                                         GetSType (type), low, high)
    ELSE
-      gccsym := DeclareLargeOrSmallSet(sym, GetFullSymName(sym), type, GetTypeMin(type), GetTypeMax(type))
+      gccsym := DeclareSetArrayOrBitSet (sym, GetFullSymName (sym),
+                                         type, GetTypeMin (type), GetTypeMax (type))
    END ;
-   RETURN( gccsym )
+   RETURN gccsym
 END DeclareSet ;
 
 
@@ -5696,19 +5826,19 @@ BEGIN
       t := DeclareVarient(sym)
    ELSIF IsPointer(sym)
    THEN
-      t := CheckAlignment(DeclarePointer(sym), sym)
+      t := CheckAlignment (DeclarePointer (sym), sym)
    ELSIF IsUnbounded(sym)
    THEN
       t := DeclareUnbounded(sym)
    ELSIF IsArray(sym)
    THEN
-      t := CheckAlignment(DeclareArray(sym), sym)
+      t := CheckAlignment (DeclareArray (sym), sym)
    ELSIF IsProcType(sym)
    THEN
       t := DeclareProcType(sym)
    ELSIF IsSet(sym)
    THEN
-      t := DeclareSet(sym)
+      t := CheckAlignment (DeclareSet (sym), sym)
    ELSIF IsConst(sym)
    THEN
       IF IsConstructor(sym)
@@ -5981,11 +6111,17 @@ PROCEDURE WalkPointerDependants (sym: CARDINAL; p: WalkAction) ;
 VAR
    align: CARDINAL ;
 BEGIN
-   p(GetSType(sym)) ;
-   align := GetAlignment(sym) ;
-   IF align#NulSym
+   IF GetSType (sym) = NulSym
    THEN
-      p(align)
+      MetaError1 ('pointer type {%1Ua} is unresolved', sym) ;
+      InternalError ('pointer type should have been declared')
+   ELSE
+      p (GetSType (sym)) ;
+      align := GetAlignment (sym) ;
+      IF align # NulSym
+      THEN
+         p (align)
+      END
    END
 END WalkPointerDependants ;
 
@@ -6321,7 +6457,7 @@ END WalkVarientFieldDependants ;
 PROCEDURE IsArrayDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
 VAR
    result   : BOOLEAN ;
-   align    : CARDINAL ;
+   align,
    subscript: CARDINAL ;
    high, low: CARDINAL ;
    type     : CARDINAL ;
@@ -6329,7 +6465,6 @@ BEGIN
    result := TRUE ;
    Assert(IsArray(sym)) ;
    type := GetSType(sym) ;
-
    IF NOT q(type)
    THEN
       result := FALSE
@@ -6339,11 +6474,11 @@ BEGIN
    THEN
       Assert(IsSubscript(subscript)) ;
       type := GetSType(subscript) ;
-      IF NOT q(type)
+      IF NOT q (type)
       THEN
          result := FALSE
       END ;
-      type := SkipType(type) ;
+      type := SkipType (type) ;
       (* the array might be declared as ARRAY type OF foo *)
       low  := GetTypeMin(type) ;
       high := GetTypeMax(type) ;
@@ -6355,8 +6490,8 @@ BEGIN
       THEN
          result := FALSE
       END ;
-      align := GetAlignment(sym) ;
-      IF (align#NulSym) AND (NOT q(align))
+      align := GetAlignment (sym) ;
+      IF (align#NulSym) AND (NOT q (align))
       THEN
          result := FALSE
       END
@@ -6371,7 +6506,7 @@ END IsArrayDependants ;
 
 PROCEDURE WalkArrayDependants (sym: CARDINAL; p: WalkAction) ;
 VAR
-   align    : CARDINAL ;
+   align,
    subscript: CARDINAL ;
    high, low: CARDINAL ;
    type     : CARDINAL ;
@@ -6385,21 +6520,62 @@ BEGIN
       Assert(IsSubscript(subscript)) ;
       type := GetSType(subscript) ;
       p(type) ;
+      align := GetAlignment (sym) ;
+      IF align#NulSym
+      THEN
+         p(align)
+      END ;
       type := SkipType(type) ;
       (* the array might be declared as ARRAY type OF foo *)
       low  := GetTypeMin(type) ;
       high := GetTypeMax(type) ;
       p(low) ;
-      p(high) ;
-      align := GetAlignment (sym) ;
-      IF align#NulSym
-      THEN
-         p(align)
-      END
+      p(high)
    END
 END WalkArrayDependants ;
 
 
+(*
+   DeclareSetArray -
+*)
+
+PROCEDURE DeclareSetArray (sym, low, high: CARDINAL) : CARDINAL ;
+VAR
+   tok     : CARDINAL ;
+   subrange,
+   highbyte: CARDINAL ;
+   bytes   : tree ;
+   name    : Name ;
+BEGIN
+   tok := GetDeclaredMod (sym) ;
+   PushValue (high) ;
+   ConvertToInt ;
+   PushValue (low) ;
+   ConvertToInt ;
+   Sub ;
+   PushCard (8) ;
+   DivTrunc ;
+   bytes := PopIntegerTree () ;
+   subrange := MakeSubrange (tok, NulName) ;
+   INC (tempset) ;
+   name := makekey (string (Sprintf1 (Mark (InitString('_Tset%d')), tempset))) ;
+   highbyte := MakeConstVar (tok, name) ;
+   PutConst (highbyte, Cardinal) ;
+   AddModGcc (highbyte, bytes) ;
+   PushValue (high) ;
+   ConvertToInt ;
+   PushValue (low) ;
+   ConvertToInt ;
+   Sub ;
+   PushCard (GetBitsPerBitset ()) ;
+   PutSetInWord (sym, Less (tok)) ;
+   DeclareConstFully (highbyte) ;
+   PutSubrange (subrange,
+                MakeConstLit (tok, MakeKey ('0'), Cardinal), highbyte, Cardinal) ;
+   RETURN MakeSetArray (tok, subrange)
+END DeclareSetArray ;
+
+
 (*
    IsSetDependants - returns TRUE if the symbol, sym,
                      q(dependants) all return TRUE.
@@ -6407,27 +6583,32 @@ END WalkArrayDependants ;
 
 PROCEDURE IsSetDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
 VAR
-   result         : BOOLEAN ;
-   type, low, high: CARDINAL ;
+   result                : BOOLEAN ;
+   type, low, high, array: CARDINAL ;
 BEGIN
    result := TRUE ;
-   Assert(IsSet(sym)) ;
+   Assert (IsSet (sym)) ;
 
-   type := GetDType(sym) ;
-   IF NOT q(type)
+   type := GetDType (sym) ;
+   IF NOT q (type)
    THEN
       result := FALSE
    END ;
-   low  := GetTypeMin(type) ;
-   high := GetTypeMax(type) ;
-   IF NOT q(low)
+   low  := GetTypeMin (type) ;
+   high := GetTypeMax (type) ;
+   IF NOT q (low)
    THEN
       result := FALSE
    END ;
-   IF NOT q(high)
+   IF NOT q (high)
    THEN
       result := FALSE
    END ;
+   array := GetSetArray (sym) ;
+   IF array = NulSym
+   THEN
+      result := FALSE ;
+   END ;
    RETURN( result )
 END IsSetDependants ;
 
@@ -6438,7 +6619,7 @@ END IsSetDependants ;
 
 PROCEDURE WalkSetDependants (sym: CARDINAL; p: WalkAction) ;
 VAR
-   type, low, high: CARDINAL ;
+   type, low, high, array: CARDINAL ;
 BEGIN
    Assert(IsSet(sym)) ;
 
@@ -6447,7 +6628,12 @@ BEGIN
    low  := GetTypeMin(type) ;
    p(low) ;
    high := GetTypeMax(type) ;
-   p(high)
+   p(high) ;
+   array := GetSetArray (sym) ;
+   IF array # NulSym
+   THEN
+      p (array)
+   END
 END WalkSetDependants ;
 
 
@@ -6524,19 +6710,19 @@ VAR
    result    : BOOLEAN ;
 BEGIN
    result := TRUE ;
-   Assert(IsProcedure(sym)) ;
+   Assert (IsProcedure (sym)) ;
    i := 1 ;
-   ReturnType := GetSType(sym) ;
-   WHILE GetNth(sym, i)#NulSym DO
-      son := GetNth(sym, i) ;
-      type := GetSType(son) ;
-      IF NOT q(type)
+   ReturnType := GetSType (sym) ;
+   WHILE GetNth (sym, i) # NulSym DO
+      son := GetNth (sym, i) ;
+      type := GetSType (son) ;
+      IF NOT q (type)
       THEN
          result := FALSE
       END ;
-      INC(i)
+      INC (i)
    END ;
-   IF (ReturnType=NulSym) OR q(ReturnType)
+   IF (ReturnType = NulSym) OR q (ReturnType)
    THEN
       RETURN( result )
    ELSE
@@ -6555,25 +6741,25 @@ VAR
    type,
    ReturnType: CARDINAL ;
 BEGIN
-   Assert(IsProcedure(sym)) ;
+   Assert (IsProcedure (sym)) ;
    i := 1 ;
-   ReturnType := GetSType(sym) ;
-   WHILE GetNth(sym, i)#NulSym DO
-      son := GetNth(sym, i) ;
-      type := GetSType(son) ;
-      p(type) ;
-      INC(i)
+   ReturnType := GetSType (sym) ;
+   WHILE GetNth (sym, i) # NulSym DO
+      son := GetNth (sym, i) ;
+      type := GetSType (son) ;
+      p (type) ;
+      INC (i)
    END ;
-   IF ReturnType#NulSym
+   IF ReturnType # NulSym
    THEN
-      p(ReturnType)
+      p (ReturnType)
    END
 END WalkProcedureDependants ;
 
 
 (*
    IsUnboundedDependants - returns TRUE if the symbol, sym,
-                           q(dependants) all return TRUE.
+                           q (dependants) all return TRUE.
 *)
 
 PROCEDURE IsUnboundedDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;
@@ -6581,15 +6767,15 @@ VAR
    result: BOOLEAN ;
 BEGIN
    result := TRUE ;
-   IF NOT q(GetUnboundedRecordType(sym))
+   IF NOT q (GetUnboundedRecordType (sym))
    THEN
       result := FALSE
    END ;
-   IF NOT q(Cardinal)
+   IF NOT q (Cardinal)
    THEN
       result := FALSE
    END ;
-   IF NOT q(GetSType(sym))
+   IF NOT q (GetSType (sym))
    THEN
       result := FALSE
    END ;
@@ -6603,9 +6789,9 @@ END IsUnboundedDependants ;
 
 PROCEDURE WalkUnboundedDependants (sym: CARDINAL; p: WalkAction) ;
 BEGIN
-   p(GetUnboundedRecordType(sym)) ;
-   p(Cardinal) ;
-   p(GetSType(sym))
+   p (GetUnboundedRecordType (sym)) ;
+   p (Cardinal) ;
+   p (GetSType (sym))
 END WalkUnboundedDependants ;
 
 
@@ -6644,15 +6830,15 @@ VAR
    align: CARDINAL ;
    type : CARDINAL ;
 BEGIN
-   type := GetSType(sym) ;
-   IF type#NulSym
+   type := GetSType (sym) ;
+   IF type # NulSym
    THEN
-      p(type)
+      p (type)
    END ;
-   align := GetAlignment(sym) ;
-   IF align#NulSym
+   align := GetAlignment (sym) ;
+   IF align # NulSym
    THEN
-      p(align)
+      p (align)
    END
 END WalkTypeDependants ;
 
@@ -6664,9 +6850,9 @@ END WalkTypeDependants ;
 
 PROCEDURE PoisonSymbols (sym: CARDINAL) ;
 BEGIN
-   IF IsProcedure(sym)
+   IF IsProcedure (sym)
    THEN
-      ForeachLocalSymDo(sym, Poison)
+      ForeachLocalSymDo (sym, Poison)
    END
 END PoisonSymbols ;
 
@@ -6677,7 +6863,7 @@ END PoisonSymbols ;
 
 PROCEDURE ConstantKnownAndUsed (sym: CARDINAL; t: tree) ;
 BEGIN
-   DeclareConstantFromTree(sym, RememberConstant(t))
+   DeclareConstantFromTree (sym, RememberConstant (t))
 END ConstantKnownAndUsed ;
 
 
@@ -6692,14 +6878,31 @@ BEGIN
 END InitDeclarations ;
 
 
+VAR
+   DeclaredOutstandingTypesDiag,
+   DeclareTypesConstantsProceduresDiag,
+   DeclareTypesConstantsProceduresInRangeDiag: Diagnostic ;
 BEGIN
+   DeclaredOutstandingTypesDiag
+      := InitTimeDiagnostic
+            ('M2GCCDeclare:DeclaredOutstandingTypes',
+            '{1N} called {1C} times consuming {1T} ({1P})') ;
+   DeclareTypesConstantsProceduresInRangeDiag
+      := InitTimeDiagnostic
+            ('M2GCCDeclare:DeclareTypesConstantsProceduresInRangeDiag',
+            '{1N} called {1C} times consuming {1T} ({1P})') ;
+   DeclareTypesConstantsProceduresDiag
+   := InitTimeDiagnostic
+            ('M2GCCDeclare:DeclareTypesConstantsProceduresDiag',
+            '{1N} called {1C} times consuming {1T} ({1P})') ;
    FreeGroup := NIL ;
    GlobalGroup := InitGroup () ;
+   ChainedList := InitSet (1) ;
    ErrorDepList := InitSet (1) ;
-   ChainedList := InitSet(1) ;
-   WatchList := InitSet(1) ;
+   WatchList := InitSet (1) ;
    VisitedList := NIL ;
-   EnumerationIndex := InitIndex(1) ;
+   EnumerationIndex := InitIndex (1) ;
    HaveInitDefaultTypes := FALSE ;
-   recursionCaught := FALSE
+   recursionCaught := FALSE ;
+   tempset := 0
 END M2GCCDeclare.
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 2440b2acf66..14a4d5d780b 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -35,6 +35,9 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
                         GetLowestType,
                         GetLocalSym, GetVarWritten,
                         GetVarient, GetVarBackEndType, GetModuleCtors,
+                        GetSetInWord, GetDType,
+                        GetNthParamAnyClosest,
+                        GetMainModule, IsUnknown,
                         NoOfVariables,
                         NoOfParamAny, GetParent, GetDimension, IsAModula2Type,
                         IsModule, IsDefImp, IsType, IsModuleWithinProcedure,
@@ -74,16 +77,20 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
                         GetProcedureBuiltin,
                         GetPriority, GetNeedSavePriority,
                         PutConstStringKnown,
+                        GetSetArray,
                         PutConst, PutConstSet, PutConstructor,
 			GetSType, GetTypeMode,
                         HasVarParameters, CopyConstString,
                         GetVarDeclFullTok,
                         NulSym ;
 
-FROM M2Batch IMPORT MakeDefinitionSource ;
+FROM m2tree IMPORT debug_tree, skip_const_decl ;
+FROM gcctypes IMPORT location_t, tree ;
+
+FROM M2Batch IMPORT MakeDefinitionSource, LookupModule ;
 
 FROM M2LexBuf IMPORT FindFileNameFromToken, TokenToLineNo, TokenToLocation,
-                     MakeVirtualTok, UnknownTokenNo, BuiltinTokenNo ;
+                     MakeVirtualTok, MakeVirtual2Tok, UnknownTokenNo, BuiltinTokenNo ;
 
 FROM M2Code IMPORT CodeBlock ;
 FROM M2Debug IMPORT Assert ;
@@ -96,7 +103,8 @@ FROM M2MetaError IMPORT MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3,
 FROM M2Options IMPORT UnboundedByReference, PedanticCast,
                       VerboseUnbounded, Iso, Pim, DebugBuiltins, WholeProgram,
                       StrictTypeChecking, AutoInit, cflag, ScaffoldMain,
-                      ScaffoldDynamic, ScaffoldStatic, GetDebugTraceQuad ;
+                      ScaffoldDynamic, ScaffoldStatic, GetDebugTraceQuad,
+                      OptimizeSets, GetWideset ;
 
 FROM M2Printf IMPORT printf0, printf1, printf2, printf4 ;
 FROM M2Quiet IMPORT qprintf0 ;
@@ -131,6 +139,7 @@ FROM Lists IMPORT List, InitList, KillList,
                   NoOfItemsInList, GetItemFromList ;
 
 FROM M2ALU IMPORT PtrToValue,
+                  KillValue, PopInto,
                   IsValueTypeReal, IsValueTypeSet,
                   IsValueTypeConstructor, IsValueTypeArray,
                   IsValueTypeRecord, IsValueTypeComplex,
@@ -154,7 +163,7 @@ FROM M2GCCDeclare IMPORT WalkAction,
                          PromoteToString, PromoteToCString, DeclareLocalVariable,
                          CompletelyResolved,
                          PoisonSymbols, GetTypeMin, GetTypeMax,
-                         IsProcedureGccNested, DeclareParameters,
+                         IsProcedureGccNested, DeclareParameters, DeclareProcedure,
                          ConstantKnownAndUsed, PrintSym ;
 
 FROM M2Range IMPORT CodeRangeCheck, FoldRangeCheck, CodeErrorCheck, GetMinMax ;
@@ -164,10 +173,11 @@ FROM m2builtins IMPORT BuiltInAlloca,
                        GetBuiltinConst, GetBuiltinTypeInfo,
                        BuiltinExists, BuildBuiltinTree ;
 
-FROM m2expr IMPORT GetIntegerZero, GetIntegerOne,
+FROM m2expr IMPORT GetIntegerZero, GetIntegerOne, GetWordOne,
                    GetCardinalOne,
                    GetPointerZero,
                    GetCardinalZero,
+                   GetBitsetZero,
                    GetSizeOfInBits,
                    TreeOverflow,
                    FoldAndStrip,
@@ -175,6 +185,7 @@ FROM m2expr IMPORT GetIntegerZero, GetIntegerOne,
                    StringLength,
                    AreConstantsEqual,
                    GetCstInteger,
+                   GetRValue,
                    BuildForeachWordInSetDoIfExpr,
                    BuildIfConstInVar,
                    BuildIfVarInVar,
@@ -182,10 +193,10 @@ FROM m2expr IMPORT GetIntegerZero, GetIntegerOne,
                    BuildIfNotVarInVar,
                    BuildBinCheckProcedure, BuildUnaryCheckProcedure,
                    BuildBinProcedure, BuildUnaryProcedure,
-                   BuildSetProcedure, BuildUnarySetFunction,
+                   BuildSetProcedure,
 		   BuildAddCheck, BuildSubCheck, BuildMultCheck, BuildDivTruncCheck,
                    BuildDivM2Check, BuildModM2Check,
-                   BuildAdd, BuildSub, BuildMult, BuildLSL,
+                   BuildAdd, BuildSub, BuildMult, BuildLSL, BuildMask,
 		   BuildDivCeil, BuildModCeil,
                    BuildDivTrunc, BuildModTrunc, BuildDivFloor, BuildModFloor,
 		   BuildDivM2, BuildModM2,
@@ -202,10 +213,9 @@ FROM m2expr IMPORT GetIntegerZero, GetIntegerOne,
                    BuildEqualTo, BuildNotEqualTo,
                    BuildIsSuperset, BuildIsNotSuperset,
                    BuildIsSubset, BuildIsNotSubset,
+                   BuildIfInSet, BuildIfNotInSet,
                    BuildIndirect, BuildArray,
                    BuildTrunc, BuildCoerce,
-                   BuildBinaryForeachWordDo,
-                   BuildBinarySetDo,
                    BuildSetNegate,
                    BuildComponentRef,
                    BuildCap, BuildAbs, BuildIm, BuildRe, BuildCmplx,
@@ -218,10 +228,12 @@ FROM gcctypes IMPORT location_t, tree ;
 FROM m2decl IMPORT BuildStringConstant, BuildCStringConstant,
                    DeclareKnownConstant, GetBitsPerBitset,
                    BuildIntegerConstant,
-                   BuildModuleCtor, DeclareModuleCtor ;
+                   BuildModuleCtor, DeclareModuleCtor,
+                   DeclareKnownVariable ;
 
 FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree, BuildParam, BuildFunctValue,
-                        DoJump, BuildUnaryForeachWordDo, BuildGoto, BuildCall2, BuildCall3,
+                        IfBitInSetJump, IfExprJump,
+                        BuildGoto, BuildCall2, BuildCall3,
                         BuildStart, BuildEnd, BuildCallInner, BuildStartFunctionCode,
                         BuildEndFunctionCode,
                         BuildAssignmentTree, DeclareLabel,
@@ -240,6 +252,7 @@ FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree, BuildParam, BuildFunct
 
 FROM m2type IMPORT ChainOnParamValue, GetPointerType, GetIntegerType, AddStatement,
                    GetCardinalType, GetWordType, GetM2ZType, GetM2RType, GetM2CType,
+                   GetBooleanFalse,
                    BuildCharConstant, AddStringToTreeList, BuildArrayStringConstructor,
                    GetArrayNoOfElements, GetTreeType, IsGccStrictTypeEquivalent ;
 
@@ -250,7 +263,8 @@ FROM m2block IMPORT RememberConstant, pushGlobalScope, popGlobalScope, finishFun
 
 FROM m2misc IMPORT DebugTree ;
 
-FROM m2convert IMPORT BuildConvert, ConvertConstantAndCheck, ToCardinal, ConvertString ;
+FROM m2convert IMPORT BuildConvert, ConvertConstantAndCheck, ToCardinal,
+                      ToBitset, ToWord, ConvertString ;
 
 FROM m2except IMPORT BuildThrow, BuildTryBegin, BuildTryEnd,
                      BuildCatchBegin, BuildCatchEnd ;
@@ -278,19 +292,24 @@ CONST
    CascadedDebugging = FALSE ;
 
 TYPE
-   DoProcedure      = PROCEDURE (CARDINAL) ;
-   DoUnaryProcedure = PROCEDURE (CARDINAL) ;
+   UnaryProcedure = PROCEDURE (CARDINAL) ;
+   ProcedureCardinal = PROCEDURE (CARDINAL) ;
+   BinaryFunction = PROCEDURE (location_t, tree, tree) : tree ;
+   UnaryFunction = PROCEDURE (location_t, tree) : tree ;
 
 VAR
    Memset, Memcpy           : CARDINAL ;
    CurrentQuadToken         : CARDINAL ;
    UnboundedLabelNo         : CARDINAL ;
-   LastLine                 : CARDINAL ;(* The Last Line number emitted with the  *)
-                                        (* generated code.                        *)
+   LastLine                 : CARDINAL ;    (* The Last Line number emitted with  *)
+                                            (* the generated code.                *)
    LastOperator             : QuadOperator ; (* The last operator processed.      *)
-   ScopeStack               : StackOfWord ; (* keeps track of the current scope       *)
-                                            (* under translation.                     *)
-   NoChange                 : BOOLEAN ;     (* has any constant been resolved?        *)
+   ScopeStack               : StackOfWord ; (* keeps track of the current scope   *)
+                                            (* under translation.                 *)
+   NoChange                 : BOOLEAN ;     (* has any constant been resolved?    *)
+   SetTemporaryNo           : CARDINAL ;    (* A unique number for creating set   *)
+                                            (* oarecord parameter names.          *)
+   BreakQuad                : CARDINAL ;    (* Allows interactive debugging.      *)
 
 
 (*
@@ -613,6 +632,7 @@ VAR
 BEGIN
    InitBuiltinSyms (BuiltinTokenNo) ;
    GetQuad(q, op, op1, op2, op3) ;
+   CheckBreak (q) ;
    IF op=StatementNoteOp
    THEN
       FoldStatementNote (op3)  (* Will change CurrentQuadToken using op3.  *)
@@ -663,12 +683,12 @@ BEGIN
    DivFloorOp         : CodeDivFloor (q, op2, op3) |
    ModFloorOp         : CodeModFloor (q, op2, op3) |
    GotoOp             : CodeGoto (op3) |
-   InclOp             : CodeIncl (op1, op3) |
-   ExclOp             : CodeExcl (op1, op3) |
-   NegateOp           : CodeNegateChecked (q, op1, op3) |
+   InclOp             : CodeIncl (q) |
+   ExclOp             : CodeExcl (q) |
+   NegateOp           : CodeNegateChecked (q) |
    LastForIteratorOp  : CodeLastForIterator (q) |
-   LogicalShiftOp     : CodeSetShift (q, op1, op2, op3) |
-   LogicalRotateOp    : CodeSetRotate (q, op1, op2, op3) |
+   LogicalShiftOp     : CodeSetShift (q) |
+   LogicalRotateOp    : CodeSetRotate (q) |
    LogicalOrOp        : CodeSetOr (q) |
    LogicalAndOp       : CodeSetAnd (q) |
    LogicalXorOp       : CodeSetSymmetricDifference (q) |
@@ -923,7 +943,7 @@ BEGIN
                END
             ELSE
                MetaErrorT1 (tok,
-                            'a constraint to the GNU ASM statement must be a constant string and not a {%1Ed}',
+                            'a constraint to the GNU ASM statement must be a constant string and not a {%1Edv}',
                             str)
             END
          END ;
@@ -966,7 +986,7 @@ BEGIN
                END
             ELSE
                MetaErrorT1 (tok,
-                            'a constraint to the GNU ASM statement must be a constant string and not a {%1Ed}',
+                            'a constraint to the GNU ASM statement must be a constant string and not a {%1Edv}',
                             str)
             END
          END ;
@@ -1114,6 +1134,20 @@ BEGIN
 END PopScope ;
 
 
+(*
+   GetActiveScope -
+*)
+
+PROCEDURE GetActiveScope () : CARDINAL ;
+BEGIN
+   IF IsEmptyWord (ScopeStack)
+   THEN
+      InternalError ('not expecting scope stack to be empty')
+   END ;
+   RETURN PeepWord (ScopeStack, 1)
+END GetActiveScope ;
+
+
 (*
    GetCurrentScopeDescription - returns a description of the current scope.
 *)
@@ -1671,9 +1705,9 @@ BEGIN
         goto tLabel
      fi
    *)
-   DoJump(location, BuildGreaterThan(location, ta, td), NIL, string(fLabel)) ;
-   DoJump(location, BuildLessThan(location, tb, tc), NIL, string(fLabel)) ;
-   BuildGoto(location, string(tLabel)) ;
+   IfExprJump (location, BuildGreaterThan (location, ta, td), string (fLabel)) ;
+   IfExprJump (location, BuildLessThan (location, tb, tc), string (fLabel)) ;
+   BuildGoto (location, string (tLabel)) ;
    IF CascadedDebugging
    THEN
       printf1('label used %s\n', tLabel) ;
@@ -1752,15 +1786,7 @@ BEGIN
          END ;
          DeclareLabel(location, string(fLabel)) ;
          INC(j)
-      END ;
-(*
-      nLabel := CreateLabelProcedureN(proc, "fin", UnboundedLabelNo, n+1) ;
-      IF CascadedDebugging
-      THEN
-         printf1('label declared %s\n', nLabel)
-      END ;
-      DeclareLabel(location, string(nLabel))
-*)
+      END
    END
 END BuildCascadedIfThenElsif ;
 
@@ -2548,7 +2574,7 @@ END FoldMakeAdr ;
              procedure, op2.  The number of the parameter is op1.
 *)
 
-PROCEDURE doParam (quad: CARDINAL; paramtok: CARDINAL; op1, op2, op3: CARDINAL) ;
+PROCEDURE doParam (paramtok: CARDINAL; quad: CARDINAL; op1, op2, op3: CARDINAL) ;
 VAR
    location: location_t ;
 BEGIN
@@ -2706,7 +2732,7 @@ BEGIN
                       parameter, procedure)
       ELSIF compatible
       THEN
-         doParam (quad, parampos, nth, procedure, parameter)
+         doParam (parampos, quad, nth, procedure, parameter)
       END
    END
 END CodeParam ;
@@ -2884,17 +2910,6 @@ BEGIN
 END CodeAddr ;
 
 
-PROCEDURE stop ; BEGIN END stop ;
-
-PROCEDURE CheckStop (q: CARDINAL) ;
-BEGIN
-   IF q=3827
-   THEN
-      stop
-   END
-END CheckStop ;
-
-
 (*
 ------------------------------------------------------------------------------
    := Operator
@@ -2906,6 +2921,7 @@ PROCEDURE FoldBecomes (p: WalkAction; bb: BasicBlock; quad: CARDINAL) ;
 BEGIN
    IF DeclaredOperandsBecomes (p, quad)
    THEN
+      CheckBreak (quad) ;
       IF (NOT IsConditionalBooleanQuad (quad)) OR IsBasicBlockFirst (bb)
       THEN
          IF TypeCheckBecomes (p, quad)
@@ -3484,9 +3500,15 @@ END checkBecomes ;
 
 PROCEDURE checkDeclare (sym: CARDINAL) ;
 BEGIN
-   IF IsTemporary (sym) AND IsVariableSSA (sym) AND (NOT GccKnowsAbout (sym))
+   IF (sym # NulSym) AND (NOT GccKnowsAbout (sym))
    THEN
-      DeclareLocalVariable (sym)
+      IF IsTemporary (sym) AND IsVariableSSA (sym)
+      THEN
+         DeclareLocalVariable (sym)
+      ELSIF IsProcedure (sym)
+      THEN
+         DeclareProcedure (sym)
+      END
    END
 END checkDeclare ;
 
@@ -3602,6 +3624,17 @@ BEGIN
 END CodeBecomes ;
 
 
+(*
+   getrvalue -
+*)
+
+PROCEDURE getrvalue (location: location_t;
+                     expr, type: CARDINAL; islvalue: BOOLEAN) : tree ;
+BEGIN
+   RETURN GetRValue (location, Mod2Gcc (expr), Mod2Gcc (type), islvalue)
+END getrvalue ;
+
+
 (*
    LValueToGenericPtr - returns a Tree representing symbol, sym.
                         It coerces a lvalue into an internal pointer type
@@ -3989,7 +4022,7 @@ BEGIN
    IF (righttype = NulSym) OR (NOT IsSet (SkipType (righttype)))
    THEN
       MetaErrorT1 (rightpos,
-                   'an {%kIN} expression is expecting {%1Etad} to be a {%kSET} type',
+                   'the right hand side of an {%kIN} expression is expecting {%1Ead} to be a {%kSET} type and not a {%1Etadv}',
                    right) ;
       NoChange := FALSE ;
       SubQuad (quad) ;
@@ -4000,72 +4033,259 @@ END CheckElementSetTypes ;
 
 
 (*
-   CodeBinarySet - encode a binary set arithmetic operation.
+   CodeBinarySet - encode a binary set AND arithmetic operation.
                    Set operands may be longer than a word.
 *)
 
-PROCEDURE CodeBinarySet (binop: BuildBinProcedure; doOp: DoProcedure;
+PROCEDURE CodeBinarySet (constp: ProcedureCardinal;
+                         binfunc: BinaryFunction;
+                         wideprocname: Name;
                          quad: CARDINAL) ;
 VAR
-   location        : location_t ;
-   constExpr,
-   overflowChecking: BOOLEAN ;
    op              : QuadOperator ;
-   virttoken,
-   virtexpr,
-   des,
-   left,
-   right,
+   operatorpos,
+   combinedpos,
    despos,
    leftpos,
-   rightpos,
-   operatorpos     : CARDINAL ;
+   rightpos        : CARDINAL ;
+   des, left, right: CARDINAL ;
+   overflowChecking,
+   typeChecking,
+   constExpr       : BOOLEAN ;
+   location        : location_t ;
+   settype         : CARDINAL ;
 BEGIN
-   GetQuadOtok (quad, operatorpos, op, des, left, right,
-                overflowChecking, constExpr,
-                despos, leftpos, rightpos) ;
-
+   GetQuadOTypetok (quad, operatorpos, op,
+                    des, left, right,
+                    overflowChecking, typeChecking, constExpr,
+                    despos, leftpos, rightpos) ;
    (* Firstly ensure that constant literals are declared.  *)
    DeclareConstant (rightpos, right) ;
    DeclareConstant (leftpos, left) ;
    DeclareConstructor (rightpos, quad, right) ;
    DeclareConstructor (leftpos, quad, left) ;
-
-   virttoken := MakeVirtualTok (operatorpos, despos, rightpos) ;
-   location := TokenToLocation (virttoken) ;
-   IF CheckBinaryExpressionTypes (quad, NoWalkProcedure)
+   IF IsConst (des)
    THEN
-      IF IsConst (des)
+      combinedpos := MakeVirtual2Tok (leftpos, rightpos) ;
+      IF IsValueSolved (left) AND IsValueSolved (right)
       THEN
-         virtexpr := MakeVirtualTok (operatorpos, leftpos, rightpos) ;
-         IF IsValueSolved (left) AND IsValueSolved (right)
-         THEN
-            Assert (MixTypes (FindType (right), FindType (left), virtexpr) # NulSym) ;
-            PutConst (des, FindType (right)) ;
-            PushValue (left) ;
-            PushValue (right) ;
-            doOp (virttoken) ;
-            PopValue (des) ;
-            PutConstSet (des)
-         ELSE
-            MetaErrorT0 (virtexpr, '{%E}constant expression cannot be evaluated')
-         END
+         Assert (MixTypes (FindType (left), FindType (right), combinedpos) # NulSym) ;
+         PutConst (des, FindType (right)) ;
+         PushValue (left) ;
+         PushValue (right) ;
+         constp (combinedpos) ;
+         PopValue (des) ;
+         PutConstSet (des)
       ELSE
-         checkDeclare (des) ;
-         BuildBinaryForeachWordDo (location,
-                                   Mod2Gcc (SkipType (GetType (des))),
-                                   Mod2Gcc (des), Mod2Gcc (left), Mod2Gcc (right), binop,
-                                   GetMode (des) = LeftValue,
-                                   GetMode (left) = LeftValue,
-                                   GetMode (right) = LeftValue,
-                                   IsConst (des),
-                                   IsConst (left),
-                                   IsConst (right))
+         MetaErrorT0 (combinedpos, '{%E}constant expression cannot be evaluated')
+      END
+   ELSE
+      checkDeclare (des) ;
+      settype := GetLType (des) ;
+      Assert (IsSet (settype)) ;
+      combinedpos := MakeVirtualTok (despos, leftpos, rightpos) ;
+      IF GetSetInWord (settype)
+      THEN
+         location := TokenToLocation (combinedpos) ;
+         SetNarrowBinary (location, binfunc, settype, des, left, right)
+      ELSE
+         SetWideBinary (combinedpos, wideprocname, settype, des, left, right)
       END
    END
 END CodeBinarySet ;
 
 
+(*
+   MakeTemporarySetName - returns a Name using the template _Tset%d.
+*)
+
+PROCEDURE MakeTemporarySetName () : Name ;
+VAR
+   name: Name ;
+   s   : String ;
+BEGIN
+   INC (SetTemporaryNo) ;
+   s := Sprintf1 (Mark (InitString ('_Tset%d')), SetTemporaryNo) ;
+   name := makekey (string (s)) ;
+   s := KillString (s) ;
+   RETURN name
+END MakeTemporarySetName ;
+
+
+(*
+   SetWideBinary -
+*)
+
+PROCEDURE SetWideBinary (tokenno: CARDINAL;
+                         wideprocname: Name;
+                         settype, des, left, right: CARDINAL) ;
+BEGIN
+   IF OptimizeSets
+   THEN
+      IF wideprocname = MakeKey ('And')
+      THEN
+         SetWideBinaryBuiltin (tokenno, BuildLogicalAnd, des, left, right) ;
+         RETURN
+      ELSIF wideprocname = MakeKey ('Or')
+      THEN
+         SetWideBinaryBuiltin (tokenno, BuildLogicalOr, des, left, right) ;
+         RETURN
+      END
+   END ;
+   SetWideBinaryLibrary (tokenno, wideprocname, settype, des, left, right)
+END SetWideBinary ;
+
+
+(*
+   SetWideBinaryLibrary - call wideprocname (des, left, right) passing des, left, right
+                          as an array of byte.
+*)
+
+PROCEDURE SetWideBinaryLibrary (tokenno: CARDINAL;
+                                wideprocname: Name;
+                                settype, des, left, right: CARDINAL) ;
+VAR
+   location : location_t ;
+   procedure,
+   param1,
+   param2,
+   param3   : CARDINAL ;
+   highbit,
+   array1,
+   array2,
+   array3,
+   call     : tree ;
+BEGIN
+   procedure := FromM2WIDESETImport (tokenno, wideprocname) ;
+   checkDeclare (procedure) ;
+   location := TokenToLocation (tokenno) ;
+   param1 := GetNthParamAnyClosest (procedure, 1, GetMainModule ()) ;
+   param2 := GetNthParamAnyClosest (procedure, 2, GetMainModule ()) ;
+   param3 := GetNthParamAnyClosest (procedure, 3, GetMainModule ()) ;
+   array1 := CreateSetArrayParam (location, tokenno, des, param1) ;
+   array2 := CreateSetArrayParam (location, tokenno, left, param2) ;
+   array3 := CreateSetArrayParam (location, tokenno, right, param3) ;
+   highbit := ToCardinal (location, CalcHighSetBit (location, settype)) ;
+   BuildParam (location, highbit) ;  (* Parameter 4.  *)
+   BuildParam (location, array3) ;   (* Parameter 3.  *)
+   BuildParam (location, array2) ;   (* Parameter 2.  *)
+   BuildParam (location, array1) ;   (* Parameter 1.  *)
+   call := BuildProcedureCallTree (location, Mod2Gcc (procedure), NIL) ;
+   SetLastFunction (NIL) ;
+   AddStatement (location, call)
+END SetWideBinaryLibrary ;
+
+
+(*
+   SetWideBinaryBuiltin - build an builtin wideset NOT operation.
+*)
+
+PROCEDURE SetWideBinaryBuiltin (tokenno: CARDINAL;
+                                binfunc: BinaryFunction;
+                                des, left, right: CARDINAL) ;
+VAR
+   location : location_t ;
+   byte,
+   lhs, rhs,
+   dest,
+   index,
+   high     : tree ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   high := ResolveHigh (tokenno, 1, des) ;
+   index := GetIntegerZero (location) ;
+   byte := Mod2Gcc (Byte) ;
+   REPEAT
+      rhs := BuildArray (location, byte,
+                         getrvalue (location, right, GetType (right),
+                                    GetMode (right) = LeftValue),
+                         index, GetIntegerZero (location)) ;
+      lhs := BuildArray (location, byte,
+                         getrvalue (location, left, GetType (left),
+                                    GetMode (left) = LeftValue),
+                         index, GetIntegerZero (location)) ;
+      rhs := binfunc (location, lhs, rhs) ;
+      rhs := BuildConvert (location, byte, rhs, FALSE) ;
+      dest := BuildArray (location, byte,
+                          getrvalue (location, des, GetType (des),
+                                     GetMode (des) = LeftValue),
+                          index, GetIntegerZero (location)) ;
+      BuildAssignmentStatement (location, dest, rhs) ;
+      PushIntegerTree (index) ;
+      PushCard (1) ;
+      Addn ;
+      index := PopIntegerTree ()
+   UNTIL CompareTrees (index, high) > 0
+END SetWideBinaryBuiltin ;
+
+
+(*
+   SetNarrowBinary - create tree consisting of:
+                     result := binfunc (left, right)
+                     result, left and right can be lvalues.
+*)
+
+PROCEDURE SetNarrowBinary (location: location_t; binfunc: BinaryFunction;
+                           settype, result, left, right: CARDINAL) ;
+VAR
+   isResultL,
+   isLeftL,
+   isRightL : BOOLEAN ;
+BEGIN
+   isResultL := GetMode (result) = LeftValue ;
+   isLeftL := GetMode (left) = LeftValue ;
+   isRightL := GetMode (right) = LeftValue ;
+   BuildAssignmentStatement (location,
+                             getrvalue (location, result, settype, isResultL),
+                             binfunc (location,
+                                      getrvalue (location, left, settype, isLeftL),
+                                      getrvalue (location, right, settype, isRightL)))
+END SetNarrowBinary ;
+
+
+(*
+   CreateSetArrayParam - return a gcc tree containing value contained in an unbounded
+                         array parameter.
+*)
+
+PROCEDURE CreateSetArrayParam (location: location_t; tokenno: CARDINAL;
+                               value, param: CARDINAL) : tree ;
+VAR
+   dataAddress,
+   designator,
+   oarecord   : tree ;
+   unbounded,
+   HighField,
+   scope      : CARDINAL ;
+BEGIN
+   unbounded := GetType (param) ;
+   Assert (IsUnbounded (unbounded)) ;
+   scope := GetActiveScope () ;
+   (* Declare oarecord which has a pointer and high field.  This will be passed as
+      a parameter into the runtime set procedure and appear as an ARRAY OF BYTE.  *)
+   oarecord := DeclareKnownVariable (location, KeyToCharStar (MakeTemporarySetName ()),
+                                     Mod2Gcc (unbounded),
+                                     FALSE, FALSE, TRUE, IsProcedure (scope),
+                                     Mod2Gcc (scope), NIL) ;
+   (* Designator is oarecord.address.  *)
+   designator := BuildComponentRef (location, oarecord,
+                                    Mod2Gcc (GetUnboundedAddressOffset (unbounded))) ;
+   IF GetMode (value) = LeftValue
+   THEN
+      (* Already pointing to the data.  *)
+      dataAddress := Mod2Gcc (value)
+   ELSE
+      dataAddress := BuildAddr (location, Mod2Gcc (value), FALSE)
+   END ;
+   BuildAssignmentStatement (location, designator, dataAddress) ;
+   HighField := GetUnboundedHighOffset (unbounded, 1) ;
+   designator := BuildComponentRef (location, oarecord, Mod2Gcc (HighField)) ;
+   BuildAssignmentStatement (location, designator,
+                             ResolveHigh (tokenno, 1, value)) ;
+   RETURN oarecord
+END CreateSetArrayParam ;
+
+
 (*
    CheckUnaryOperand - checks to see whether operand is using a generic type.
 *)
@@ -4367,7 +4587,7 @@ PROCEDURE FoldMult (tokenno: CARDINAL; p: WalkAction;
 BEGIN
    IF BinaryOperands (quad, op2, op3)
    THEN
-      FoldBinary(tokenno, p, BuildMult, quad, op1, op2, op3)
+      FoldBinary (tokenno, p, BuildMult, quad, op1, op2, op3)
    END
 END FoldMult ;
 
@@ -4478,11 +4698,11 @@ END CodeModM2Check ;
 
 PROCEDURE BinaryOperandRealFamily (op: CARDINAL) : BOOLEAN ;
 VAR
-   t: CARDINAL ;
+   type: CARDINAL ;
 BEGIN
-   t := SkipType(GetType(op)) ;
-   RETURN( IsComplexType(t) OR IsComplexN(t) OR
-           IsRealType(t) OR IsRealN(t) )
+   type := GetDType (op) ;
+   RETURN( IsComplexType (type) OR IsComplexN (type) OR
+           IsRealType (type) OR IsRealN (type) )
 END BinaryOperandRealFamily ;
 
 
@@ -4596,7 +4816,7 @@ PROCEDURE FoldModTrunc (tokenno: CARDINAL; p: WalkAction;
 BEGIN
    IF BinaryOperands (quad, op2, op3)
    THEN
-      FoldBinary(tokenno, p, BuildModTrunc, quad, op1, op2, op3)
+      FoldBinary (tokenno, p, BuildModTrunc, quad, op1, op2, op3)
    END
 END FoldModTrunc ;
 
@@ -4802,15 +5022,27 @@ PROCEDURE FoldTBitsize  (tokenno: CARDINAL; p: WalkAction;
 VAR
    location: location_t ;
 BEGIN
-   location := TokenToLocation(tokenno) ;
-   TryDeclareType (type) ;
-   type := GetDType (type) ;
-   IF CompletelyResolved (type)
+   location := TokenToLocation (tokenno) ;
+   IF IsType (type) OR IsVar (type) OR IsConst (type)
    THEN
-      AddModGcc (res, BuildSystemTBitSize (location, Mod2Gcc (type))) ;
-      p (res) ;
-      NoChange := FALSE ;
-      SubQuad (quad)
+      IF GetDType (type) = NulSym
+      THEN
+         MetaErrorT1 (tokenno, 'unknown type in TBITSIZE parameter {%1Ead}', type) ;
+         NoChange := FALSE ;
+         SubQuad (quad)
+      END ;
+      type := GetDType (type)
+   END ;
+   IF type # NulSym
+   THEN
+      TryDeclareType (type) ;
+      IF CompletelyResolved (type)
+      THEN
+         AddModGcc (res, BuildSystemTBitSize (location, Mod2Gcc (type))) ;
+         p (res) ;
+         NoChange := FALSE ;
+         SubQuad (quad)
+      END
    END
 END FoldTBitsize ;
 
@@ -5130,41 +5362,41 @@ END CodeRestorePriority ;
    FoldBinarySet - attempts to fold set arithmetic it removes the quad if successful.
 *)
 
-PROCEDURE FoldBinarySet (tokenno: CARDINAL; p: WalkAction; op: DoProcedure;
+PROCEDURE FoldBinarySet (tokenno: CARDINAL; p: WalkAction; op: ProcedureCardinal;
                          quad: CARDINAL; op1, op2, op3: CARDINAL) ;
 VAR
    location: location_t ;
 BEGIN
    (* firstly try and ensure that constants are declared *)
-   TryDeclareConstant(tokenno, op2) ;
-   TryDeclareConstant(tokenno, op3) ;
-   location := TokenToLocation(tokenno) ;
+   TryDeclareConstant (tokenno, op2) ;
+   TryDeclareConstant (tokenno, op3) ;
+   location := TokenToLocation (tokenno) ;
 
-   IF GccKnowsAbout(op2) AND GccKnowsAbout(op3)
+   IF GccKnowsAbout (op2) AND GccKnowsAbout (op3)
    THEN
       IF CheckBinaryExpressionTypes (quad, p)
       THEN
-         IF IsConst(op2) AND IsConstSet(op2) AND
-            IsConst(op3) AND IsConstSet(op3) AND
-            IsConst(op1)
+         IF IsConst (op2) AND IsConstSet (op2) AND
+            IsConst (op3) AND IsConstSet (op3) AND
+            IsConst (op1)
          THEN
-            IF IsValueSolved(op2) AND IsValueSolved(op3)
+            IF IsValueSolved (op2) AND IsValueSolved (op3)
             THEN
-               Assert(MixTypes(FindType(op3), FindType(op2), tokenno)#NulSym) ;
-               PutConst(op1, MixTypes(FindType(op3), FindType(op2), tokenno)) ;
-               PushValue(op2) ;
-               PushValue(op3) ;
-               op(tokenno) ;
-               PopValue(op1) ;
-               PushValue(op1) ;
-               PutConstSet(op1) ;
-               AddModGcc(op1,
-                         DeclareKnownConstant(location,
-                                              Mod2Gcc(GetType(op3)),
-                                              PopSetTree(tokenno))) ;
-               p(op1) ;
+               Assert (MixTypes (FindType (op3), FindType (op2), tokenno) # NulSym) ;
+               PutConst (op1, MixTypes (FindType (op3), FindType (op2), tokenno)) ;
+               PushValue (op2) ;
+               PushValue (op3) ;
+               op (tokenno) ;
+               PopValue (op1) ;
+               PushValue (op1) ;
+               PutConstSet (op1) ;
+               AddModGcc (op1,
+                          DeclareKnownConstant (location,
+						Mod2Gcc (GetType (op3)),
+						PopSetTree (tokenno))) ;
+               p (op1) ;
                NoChange := FALSE ;
-               SubQuad(quad)
+               SubQuad (quad)
             END
          END
       END
@@ -5189,7 +5421,7 @@ END FoldSetOr ;
 
 PROCEDURE CodeSetOr (quad: CARDINAL) ;
 BEGIN
-   CodeBinarySet (BuildLogicalOr, SetOr, quad)
+   CodeBinarySet (SetOr, BuildLogicalOr, MakeKey ("Or"), quad)
 END CodeSetOr ;
 
 
@@ -5200,7 +5432,7 @@ END CodeSetOr ;
 PROCEDURE FoldSetAnd (tokenno: CARDINAL; p: WalkAction;
                       quad: CARDINAL; op1, op2, op3: CARDINAL) ;
 BEGIN
-   FoldBinarySet(tokenno, p, SetAnd, quad, op1, op2, op3)
+   FoldBinarySet (tokenno, p, SetAnd, quad, op1, op2, op3)
 END FoldSetAnd ;
 
 
@@ -5210,85 +5442,175 @@ END FoldSetAnd ;
 
 PROCEDURE CodeSetAnd (quad: CARDINAL) ;
 BEGIN
-   CodeBinarySet (BuildLogicalAnd, SetAnd, quad)
+   CodeBinarySet (SetAnd, BuildLogicalAnd, MakeKey ("And"), quad)
 END CodeSetAnd ;
 
 
 (*
-   CodeBinarySetShift - encode a binary set arithmetic operation.
-                        The set maybe larger than a machine word
-                        and the value of one word may effect the
-                        values of another - ie shift and rotate.
-                        Set sizes of a word or less are evaluated
-                        with binop, whereas multiword sets are
-                        evaluated by M2RTS.
+   CalcHighSetBit - calculate the most significant bit used in a set starting from bit zero.
+*)
+
+PROCEDURE CalcHighSetBit (location: location_t; settype: CARDINAL) : tree ;
+BEGIN
+   PushValue (GetTypeMax (SkipType (GetType (settype)))) ;
+   PushIntegerTree (BuildConvert (location, GetM2ZType (), PopIntegerTree (), FALSE)) ;
+   PushValue (GetTypeMin (SkipType (GetType (settype)))) ;
+   PushIntegerTree (BuildConvert (location, GetM2ZType (), PopIntegerTree (), FALSE)) ;
+   Sub ;
+   RETURN PopIntegerTree ()
+END CalcHighSetBit ;
+
+
+(*
+   CalcBitsInSet - returns the number of minimum number of bits used to represent a set.
+*)
+
+PROCEDURE CalcBitsInSet (location: location_t; settype: CARDINAL) : tree ;
+BEGIN
+   PushIntegerTree (BuildConvert (location, GetM2ZType (),
+                                  CalcHighSetBit (location, settype), FALSE)) ;
+   PushCard (1) ;
+   PushIntegerTree (BuildConvert (location, GetM2ZType (), PopIntegerTree (), FALSE)) ;
+   Addn ;
+   RETURN PopIntegerTree ()
+END CalcBitsInSet ;
+
+
+(*
+   SetWideSetShiftRotate - generate a call:
+                           M2WIDESET.name (dest, src, HIGHBIT (settype), count).
 *)
 
-PROCEDURE CodeBinarySetShift (binop: BuildSetProcedure;
-                              doOp : DoProcedure;
-                              var, left, right: Name;
-                              quad: CARDINAL;
-                              op1, op2, op3: CARDINAL) ;
+PROCEDURE SetWideSetShiftRotate (tokenno: CARDINAL; name: Name;
+                                 settype, dest, src, count: CARDINAL) ;
 VAR
-   nBits,
-   unbounded,
-   leftproc,
-   rightproc,
-   varproc  : tree ;
+   procedure,
+   param1,
+   param2   : CARDINAL ;
+   array1,
+   array2,
+   call,
+   highbit  : tree ;
    location : location_t ;
 BEGIN
-   (* firstly ensure that constant literals are declared *)
-   DeclareConstant(CurrentQuadToken, op3) ;
-   DeclareConstant(CurrentQuadToken, op2) ;
-   DeclareConstructor(CurrentQuadToken, quad, op3) ;
-   DeclareConstructor(CurrentQuadToken, quad, op2) ;
-   location := TokenToLocation(CurrentQuadToken) ;
+   procedure := FromM2WIDESETImport (tokenno, name) ;
+   location := TokenToLocation (tokenno) ;
+   param1 := GetNthParamAnyClosest (procedure, 1, GetMainModule ()) ;
+   param2 := GetNthParamAnyClosest (procedure, 2, GetMainModule ()) ;
+   array1 := CreateSetArrayParam (location, tokenno, dest, param1) ;
+   array2 := CreateSetArrayParam (location, tokenno, src, param2) ;
+   highbit := CalcHighSetBit (location, settype) ;
+   BuildParam (location, ToCardinal (location, Mod2Gcc (count))) ;  (* Parameter 4.  *)
+   BuildParam (location, ToCardinal (location, highbit)) ;  (* Parameter 3.  *)
+   BuildParam (location, array2) ;  (* Parameter 2.  *)
+   BuildParam (location, array1) ;  (* Parameter 1.  *)
+   call := BuildProcedureCallTree (location, Mod2Gcc (procedure), NIL) ;
+   SetLastFunction (NIL) ;
+   AddStatement (location, call)
+END SetWideSetShiftRotate ;
 
-   IF IsConst(op1)
-   THEN
-      IF IsValueSolved(op2) AND IsValueSolved(op3)
-      THEN
-         Assert(MixTypes(FindType(op3),
-                         FindType(op2), CurrentQuadToken)#NulSym) ;
-         PutConst(op1, FindType(op3)) ;
-         PushValue(op2) ;
-         PushValue(op3) ;
-         doOp(CurrentQuadToken) ;
-         PopValue(op1) ;
-         PutConstSet(op1)
+
+(*
+   CodeNarrowSetShift -
+*)
+
+PROCEDURE CodeNarrowSetShift (tokenno: CARDINAL; settype: CARDINAL;
+                              dest, src, count: CARDINAL) ;
+VAR
+   location: location_t ;
+   nbits   : tree ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   nbits := CalcBitsInSet (location, settype) ;
+   BuildLogicalShift (location, Mod2Gcc (dest), Mod2Gcc (src), Mod2Gcc (count), nbits, FALSE)
+END CodeNarrowSetShift ;
+
+
+(*
+   CodeNarrowSetRotate -
+*)
+
+PROCEDURE CodeNarrowSetRotate (tokenno: CARDINAL; settype: CARDINAL;
+                               dest, src, count: CARDINAL) ;
+VAR
+   location: location_t ;
+   nbits   : tree ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   nbits := CalcBitsInSet (location, settype) ;
+   BuildLogicalRotate (location, Mod2Gcc (dest), Mod2Gcc (src), Mod2Gcc (count), nbits, FALSE)
+END CodeNarrowSetRotate ;
+
+
+(*
+   CodeBinarySetShiftRotate - encode a binary set arithmetic operation.
+*)
+
+PROCEDURE CodeBinarySetShiftRotate (quad: CARDINAL; isshift: BOOLEAN) ;
+VAR
+   op              : QuadOperator ;
+   combined,
+   lastpos, destpos,
+   srcpos, countpos: CARDINAL ;
+   dest, src, count: CARDINAL ;
+   overflowChecking,
+   constExpr       : BOOLEAN ;
+   settype         : CARDINAL ;
+BEGIN
+   GetQuadOtok (quad, lastpos, op, dest, src, count,
+                overflowChecking, constExpr,
+                destpos, srcpos, countpos) ;
+
+   (* Firstly ensure that constant literals are declared.  *)
+   DeclareConstant (countpos, count) ;
+   DeclareConstant (srcpos, src) ;
+   DeclareConstructor (countpos, quad, count) ;
+   DeclareConstructor (srcpos, quad, src) ;
+
+   IF IsConst (dest)
+   THEN
+      combined := MakeVirtual2Tok (srcpos, countpos) ;
+      IF IsValueSolved (src) AND IsValueSolved (count)
+      THEN
+         Assert (MixTypes (FindType (count),
+                           FindType (src), combined) # NulSym) ;
+         PutConst (dest, FindType (count)) ;
+         PushValue (src) ;
+         PushValue (count) ;
+         IF isshift
+         THEN
+            SetShift (combined)
+         ELSE
+            SetRotate (combined)
+         END ;
+         PopValue (dest) ;
+         PutConstSet (dest)
       ELSE
-         MetaErrorT0 (CurrentQuadToken, '{%E}constant expression cannot be evaluated')
+         MetaErrorT0 (combined, '{%E}constant expression cannot be evaluated')
       END
    ELSE
-      varproc := Mod2Gcc(FromModuleGetSym(CurrentQuadToken, var, System)) ;
-      leftproc := Mod2Gcc(FromModuleGetSym(CurrentQuadToken, left, System)) ;
-      rightproc := Mod2Gcc(FromModuleGetSym(CurrentQuadToken, right, System)) ;
-      unbounded := Mod2Gcc(GetType(GetNthParamAny (FromModuleGetSym(CurrentQuadToken,
-                                                                var, System), 1))) ;
-      PushValue(GetTypeMax(SkipType(GetType(op1)))) ;
-      PushIntegerTree(BuildConvert(location, GetM2ZType(), PopIntegerTree(), FALSE)) ;
-
-      PushValue(GetTypeMin(SkipType(GetType(op1)))) ;
-      PushIntegerTree(BuildConvert(location, GetM2ZType(), PopIntegerTree(), FALSE)) ;
-      Sub ;
-      PushCard(1) ;
-      PushIntegerTree(BuildConvert(location, GetM2ZType(), PopIntegerTree(), FALSE)) ;
-      Addn ;
-      nBits := PopIntegerTree() ;
-      BuildBinarySetDo(location,
-                       Mod2Gcc(SkipType(GetType(op1))),
-                       Mod2Gcc(op1),
-                       Mod2Gcc(op2),
-                       Mod2Gcc(op3),
-                       binop,
-                       GetMode(op1)=LeftValue,
-                       GetMode(op2)=LeftValue,
-                       GetMode(op3)=LeftValue,
-                       nBits,
-                       unbounded,
-                       varproc, leftproc, rightproc)
+      combined := MakeVirtualTok (destpos, srcpos, countpos) ;
+      settype := GetDType (dest) ;
+      Assert (IsSet (settype)) ;
+      (* Check for narrow and wide sets and call M2WIDESET if appropriate.  *)
+      IF GetSetInWord (settype)
+      THEN
+         IF isshift
+         THEN
+            CodeNarrowSetShift (combined, settype, dest, src, count)
+         ELSE
+            CodeNarrowSetRotate (combined, settype, dest, src, count)
+         END
+      ELSE
+         IF isshift
+         THEN
+            SetWideSetShiftRotate (combined, MakeKey ('Shift'), settype, dest, src, count)
+         ELSE
+            SetWideSetShiftRotate (combined, MakeKey ('Rotate'), settype, dest, src, count)
+         END
+      END
    END
-END CodeBinarySetShift ;
+END CodeBinarySetShiftRotate ;
 
 
 (*
@@ -5296,9 +5618,9 @@ END CodeBinarySetShift ;
 *)
 
 PROCEDURE FoldSetShift (tokenno: CARDINAL; p: WalkAction;
-                        quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+                        quad: CARDINAL; Dest, Src, ShiftCount: CARDINAL) ;
 BEGIN
-   FoldBinarySet(tokenno, p, SetShift, quad, op1, op2, op3)
+   FoldBinarySet (tokenno, p, SetShift, quad, Dest, Src, ShiftCount)
 END FoldSetShift ;
 
 
@@ -5306,14 +5628,9 @@ END FoldSetShift ;
    CodeSetShift - encode set arithmetic shift.
 *)
 
-PROCEDURE CodeSetShift (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+PROCEDURE CodeSetShift (quad: CARDINAL) ;
 BEGIN
-   CodeBinarySetShift (BuildLogicalShift,
-                       SetShift,
-                       MakeKey('ShiftVal'),
-                       MakeKey('ShiftLeft'),
-                       MakeKey('ShiftRight'),
-                       quad, op1, op2, op3)
+   CodeBinarySetShiftRotate (quad, TRUE)
 END CodeSetShift ;
 
 
@@ -5322,9 +5639,9 @@ END CodeSetShift ;
 *)
 
 PROCEDURE FoldSetRotate (tokenno: CARDINAL; p: WalkAction;
-                        quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+                         quad: CARDINAL; Dest, Src, RotateCount: CARDINAL) ;
 BEGIN
-   FoldBinarySet(tokenno, p, SetRotate, quad, op1, op2, op3)
+   FoldBinarySet (tokenno, p, SetRotate, quad, Dest, Src, RotateCount)
 END FoldSetRotate ;
 
 
@@ -5332,14 +5649,9 @@ END FoldSetRotate ;
    CodeSetRotate - encode set arithmetic rotate.
 *)
 
-PROCEDURE CodeSetRotate (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+PROCEDURE CodeSetRotate (quad: CARDINAL) ;
 BEGIN
-   CodeBinarySetShift (BuildLogicalRotate,
-                       SetRotate,
-                       MakeKey ('RotateVal'),
-                       MakeKey ('RotateLeft'),
-                       MakeKey ('RotateRight'),
-                       quad, op1, op2, op3)
+   CodeBinarySetShiftRotate (quad, FALSE)
 END CodeSetRotate ;
 
 
@@ -5362,7 +5674,8 @@ END FoldSetLogicalDifference ;
 
 PROCEDURE CodeSetLogicalDifference (quad: CARDINAL) ;
 BEGIN
-   CodeBinarySet (BuildLogicalDifference, SetDifference, quad)
+   CodeBinarySet (SetAnd, BuildLogicalDifference,
+                  MakeKey ("LogicalDifference"), quad)
 END CodeSetLogicalDifference ;
 
 
@@ -5379,11 +5692,13 @@ END FoldSymmetricDifference ;
 
 (*
    CodeSetSymmetricDifference - code set difference.
+                                A logical xor expression.
 *)
 
 PROCEDURE CodeSetSymmetricDifference (quad: CARDINAL) ;
 BEGIN
-   CodeBinarySet (BuildSymmetricDifference, SetSymmetricDifference, quad)
+   CodeBinarySet (SetSymmetricDifference, BuildSymmetricDifference,
+                  MakeKey ("SymmetricDifference"), quad)
 END CodeSetSymmetricDifference ;
 
 
@@ -5392,15 +5707,19 @@ END CodeSetSymmetricDifference ;
                   Set operands may be longer than a word.
 *)
 
-PROCEDURE CodeUnarySet (unop: BuildUnarySetFunction; constop: DoUnaryProcedure;
+PROCEDURE CodeUnarySet (constop: ProcedureCardinal;
+                        unfunc: UnaryFunction;
+                        tokenno: CARDINAL;
+                        wideprocname: Name;
                         quad: CARDINAL; result, expr: CARDINAL) ;
 VAR
    location: location_t ;
+   settype : CARDINAL ;
 BEGIN
-   (* firstly ensure that constant literals are declared *)
-   DeclareConstant (CurrentQuadToken, expr) ;
-   DeclareConstructor (CurrentQuadToken, quad, expr) ;
-   location := TokenToLocation (CurrentQuadToken) ;
+   (* Firstly ensure that constant literals are declared.  *)
+   DeclareConstant (tokenno, expr) ;
+   DeclareConstructor (tokenno, quad, expr) ;
+   location := TokenToLocation (tokenno) ;
 
    IF IsConst (result)
    THEN
@@ -5409,68 +5728,201 @@ BEGIN
          Assert (FindType (expr) # NulSym) ;
          PutConst (result, FindType (expr)) ;
          PushValue (expr) ;
-         constop (CurrentQuadToken) ;
+         constop (tokenno) ;
          PopValue (result) ;
          PushValue (result) ;
          PutConstSet (result) ;
          ConstantKnownAndUsed (result,
-                               DeclareKnownConstant(location,
-                                                    Mod2Gcc (GetType (expr)),
-                                                    PopSetTree (CurrentQuadToken)))
+                               DeclareKnownConstant (location,
+                                                     Mod2Gcc (GetType (expr)),
+                                                     PopSetTree (tokenno)))
       ELSE
-         MetaErrorT0 (CurrentQuadToken,
+         MetaErrorT0 (tokenno,
                       '{%E}constant expression cannot be evaluated')
       END
    ELSE
       checkDeclare (result) ;
-      BuildUnaryForeachWordDo (location,
-                               Mod2Gcc (GetType (result)), Mod2Gcc (result), Mod2Gcc (expr), unop,
-                               GetMode(result) = LeftValue, GetMode(expr) = LeftValue,
-                               IsConst (result), IsConst (expr))
+      settype := GetLType (result) ;
+      Assert (IsSet (settype)) ;
+      IF GetSetInWord (settype)
+      THEN
+         SetNarrowUnary (location, unfunc, settype, result, expr)
+      ELSE
+         SetWideUnary (tokenno, wideprocname, settype, result, expr)
+      END
    END
 END CodeUnarySet ;
 
 
 (*
-   FoldIncl - check whether we can fold the InclOp.
-              result := result + (1 << expr)
+   FromM2WIDESETImport - returns M2WIDESET.name.
 *)
 
-PROCEDURE FoldIncl (tokenno: CARDINAL; p: WalkAction;
-                    quad: CARDINAL; result, expr: CARDINAL) ;
+PROCEDURE FromM2WIDESETImport (tokenno: CARDINAL; name: Name) : CARDINAL ;
+VAR
+   sym, module: CARDINAL ;
 BEGIN
-   (* firstly ensure that constant literals are declared *)
-   TryDeclareConstant (tokenno, expr) ;
-   IF IsConst (result) AND IsConst (expr)
+   IF GetWideset ()
    THEN
-      IF GccKnowsAbout (expr) AND IsValueSolved (result)
+      module := MakeDefinitionSource (tokenno, MakeKey ("M2WIDESET")) ;
+      sym := FromModuleGetSym (tokenno, name, module) ;
+      IF IsUnknown (sym)
       THEN
-         (* fine, we can take advantage of this and fold constants *)
-         PushValue (result) ;
-         AddBit (tokenno, expr) ;
-         AddModGcc (result, PopSetTree(tokenno)) ;
-         p (result) ;
-         NoChange := FALSE ;
-         SubQuad (quad)
+         MetaErrorT2 (tokenno, 'procedure function {%1Aad} is not available from {%2ad}',
+                      sym, module)
       END
-   END
-END FoldIncl ;
+   ELSE
+      MetaErrorT0 (tokenno, '{%0A}wideset is not available due to -fno-wideset')
+   END ;
+   RETURN sym
+END FromM2WIDESETImport ;
 
 
 (*
-   FoldIfLess - check to see if it is possible to evaluate
-                if op1 < op2 then goto op3.
+   SetWideUnaryLibrary - call wideprocname (result, expr) passing result and expr
+                         as an array of byte.
 *)
 
-PROCEDURE FoldIfLess (tokenno: CARDINAL;
-                      quad: CARDINAL; left, right, destQuad: CARDINAL) ;
-BEGIN
-   (* Firstly ensure that constant literals are declared.  *)
-   TryDeclareConstant(tokenno, left) ;
-   TryDeclareConstant(tokenno, right) ;
-   IF IsConst (left) AND IsConst (right)
-   THEN
-      IF IsValueSolved (left) AND IsValueSolved (right)
+PROCEDURE SetWideUnaryLibrary (tokenno: CARDINAL;
+                               wideprocname: Name;
+                               settype, result, expr: CARDINAL) ;
+VAR
+   location : location_t ;
+   procedure,
+   param1,
+   param2   : CARDINAL ;
+   highbit,
+   array1,
+   array2,
+   call     : tree ;
+BEGIN
+   procedure := FromM2WIDESETImport (tokenno, wideprocname) ;
+   checkDeclare (procedure) ;
+   location := TokenToLocation (tokenno) ;
+   highbit := ToCardinal (location, CalcBitsInSet (location, settype)) ;
+   param1 := GetNthParamAnyClosest (procedure, 1, GetMainModule ()) ;
+   param2 := GetNthParamAnyClosest (procedure, 2, GetMainModule ()) ;
+   array1 := CreateSetArrayParam (location, tokenno, result, param1) ;
+   array2 := CreateSetArrayParam (location, tokenno, expr, param2) ;
+   BuildParam (location, highbit) ;   (* 3rd Parameter.  *)
+   BuildParam (location, array2) ;    (* 2nd Parameter.  *)
+   BuildParam (location, array1) ;    (* 1st Parameter.  *)
+   call := BuildProcedureCallTree (location, Mod2Gcc (procedure), NIL) ;
+   SetLastFunction (NIL) ;
+   AddStatement (location, call)
+END SetWideUnaryLibrary ;
+
+
+(*
+   SetWideUnaryBuiltinNot - build an builtin wideset NOT operation.
+*)
+
+PROCEDURE SetWideUnaryBuiltinNot (tokenno: CARDINAL; result, expr: CARDINAL) ;
+VAR
+   location : location_t ;
+   byte,
+   lhs, rhs,
+   index,
+   high     : tree ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   high := ResolveHigh (tokenno, 1, result) ;
+   index := GetIntegerZero (location) ;
+   byte := Mod2Gcc (Byte) ;
+   REPEAT
+      rhs := BuildArray (location, byte, Mod2Gcc (expr),
+                         index, GetIntegerZero (location)) ;
+      rhs := BuildSetNegate (location, rhs) ;
+      rhs := BuildConvert (location, byte, rhs, FALSE) ;
+      lhs := BuildArray (location, byte, Mod2Gcc (result),
+                         index, GetIntegerZero (location)) ;
+      BuildAssignmentStatement (location, lhs, rhs) ;
+      PushIntegerTree (index) ;
+      PushCard (1) ;
+      Addn ;
+      index := PopIntegerTree ()
+   UNTIL CompareTrees (index, high) > 0
+END SetWideUnaryBuiltinNot ;
+
+
+(*
+   SetWideUnary - either call the library wideprocname or the builtin
+                  version depending upon the optimization setting.
+*)
+
+PROCEDURE SetWideUnary (tokenno: CARDINAL;
+                        wideprocname: Name;
+                        settype, result, expr: CARDINAL) ;
+BEGIN
+   IF OptimizeSets AND (wideprocname = MakeKey ('Not'))
+   THEN
+      SetWideUnaryBuiltinNot (tokenno, result, expr)
+   ELSE
+      SetWideUnaryLibrary (tokenno, wideprocname, settype, result, expr)
+   END
+END SetWideUnary ;
+
+
+(*
+   SetNarrowUnary - create tree consisting of:
+                    result := unfunc (expr)
+                    result and expr can be lvalues.
+*)
+
+PROCEDURE SetNarrowUnary (location: location_t; unfunc: UnaryFunction;
+                          settype, result, expr: CARDINAL) ;
+VAR
+   isResultL,
+   isExprL   : BOOLEAN ;
+BEGIN
+   isResultL := GetMode (result) = LeftValue ;
+   isExprL := GetMode (expr) = LeftValue ;
+   BuildAssignmentStatement (location, getrvalue (location, result, settype, isResultL),
+                             unfunc (location,
+                                     getrvalue (location, expr, settype, isExprL)))
+END SetNarrowUnary ;
+
+
+(*
+   FoldIncl - check whether we can fold the InclOp.
+              result := result + (1 << expr)
+*)
+
+PROCEDURE FoldIncl (tokenno: CARDINAL; p: WalkAction;
+                    quad: CARDINAL; result, expr: CARDINAL) ;
+BEGIN
+   (* firstly ensure that constant literals are declared *)
+   TryDeclareConstant (tokenno, expr) ;
+   IF IsConst (result) AND IsConst (expr)
+   THEN
+      IF GccKnowsAbout (expr) AND IsValueSolved (result)
+      THEN
+         (* fine, we can take advantage of this and fold constants *)
+         PushValue (result) ;
+         AddBit (tokenno, expr) ;
+         AddModGcc (result, PopSetTree (tokenno)) ;
+         p (result) ;
+         NoChange := FALSE ;
+         SubQuad (quad)
+      END
+   END
+END FoldIncl ;
+
+
+(*
+   FoldIfLess - check to see if it is possible to evaluate
+                if op1 < op2 then goto op3.
+*)
+
+PROCEDURE FoldIfLess (tokenno: CARDINAL;
+                      quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+   (* Firstly ensure that constant literals are declared.  *)
+   TryDeclareConstant(tokenno, left) ;
+   TryDeclareConstant(tokenno, right) ;
+   IF IsConst (left) AND IsConst (right)
+   THEN
+      IF IsValueSolved (left) AND IsValueSolved (right)
       THEN
          (* We can take advantage of the known values and evaluate the condition.  *)
          PushValue (left) ;
@@ -5661,8 +6113,8 @@ PROCEDURE FoldIfEqu (tokenno: CARDINAL;
                      left, right, destQuad: CARDINAL) ;
 BEGIN
    (* Firstly ensure that constant literals are declared.  *)
-   TryDeclareConstant(tokenno, left) ;
-   TryDeclareConstant(tokenno, right) ;
+   TryDeclareConstant (tokenno, left) ;
+   TryDeclareConstant (tokenno, right) ;
    IF IsConst (left) AND IsConst (right)
    THEN
       IF IsValueSolved (left) AND IsValueSolved (right)
@@ -5693,8 +6145,8 @@ PROCEDURE FoldIfNotEqu (tokenno: CARDINAL;
                         left, right, destQuad: CARDINAL) ;
 BEGIN
    (* Firstly ensure that constant literals are declared.  *)
-   TryDeclareConstant(tokenno, left) ;
-   TryDeclareConstant(tokenno, right) ;
+   TryDeclareConstant (tokenno, left) ;
+   TryDeclareConstant (tokenno, right) ;
    IF IsConst (left) AND IsConst (right)
    THEN
       IF IsValueSolved (left) AND IsValueSolved (right)
@@ -5723,93 +6175,256 @@ PROCEDURE GetSetLimits (set: CARDINAL; VAR low, high: CARDINAL) ;
 VAR
    type: CARDINAL ;
 BEGIN
-   type := GetType(set) ;
-   IF IsSubrange(type)
+   type := GetType (set) ;
+   IF IsSubrange (type)
    THEN
-      GetSubrange(type, high, low) ;
+      GetSubrange (type, high, low) ;
    ELSE
-      low := GetTypeMin(type) ;
-      high := GetTypeMax(type)
+      low := GetTypeMin (type) ;
+      high := GetTypeMax (type)
    END
 END GetSetLimits ;
 
 
 (*
-   GetFieldNo - returns the field number in the, set, which contains, element.
+   IsElementInRange - returns TRUE if expr references a bit in setvar
+                      which is in the range [low..high].  If expr is a
+                      variable it returns TRUE.  FALSE is returned if we
+                      know expr to be out of bounds.
 *)
 
-PROCEDURE GetFieldNo (tokenno: CARDINAL; element: CARDINAL; set: CARDINAL; VAR offset: tree) : INTEGER ;
+PROCEDURE IsElementInRange (tokenno: CARDINAL; settype, setvar, expr: CARDINAL) : BOOLEAN ;
 VAR
-   low, high, bpw, c: CARDINAL ;
-   location         : location_t ;
+   low,
+   high: CARDINAL ;
 BEGIN
-   location := TokenToLocation(tokenno) ;
-   bpw := GetBitsPerBitset() ;
-   GetSetLimits(set, low, high) ;
+   IF IsConst (expr)
+   THEN
+      GetSetLimits (settype, low, high) ;
+      PushValue (expr) ;
+      PushValue (high) ;
+      IF Gre (tokenno)
+      THEN
+         MetaErrorT1 (tokenno, 'bit exceeds the range of set {%1Eatd}', setvar) ;
+         RETURN FALSE
+      END ;
+      PushValue (expr) ;
+      PushValue (low) ;
+      IF Less (tokenno)
+      THEN
+         MetaErrorT1 (tokenno, 'bit underflows the range of set {%1Eatd}', setvar) ;
+         RETURN FALSE
+      END
+   END ;
+   RETURN TRUE
+END IsElementInRange ;
 
-   (* check element is legal *)
 
-   PushValue(element) ;
-   PushValue(low) ;
-   IF Less(tokenno)
-   THEN
-      (* out of range *)
-      RETURN( -1 )
+(*
+   SetElementToBit -
+*)
+
+PROCEDURE SetElementToBit (location: location_t; settype, expr: CARDINAL) : tree ;
+VAR
+   lowelement, highelement: CARDINAL ;
+   low                    : tree ;
+BEGIN
+   GetSetLimits (settype, lowelement, highelement) ;
+   PushValue (lowelement) ;
+   low := PopIntegerTree () ;
+   RETURN BuildSub (location, ToCardinal (location, Mod2Gcc (expr)),
+                    ToCardinal (location, low), FALSE)
+END SetElementToBit ;
+
+
+(*
+   CodeNarrowIncl - result |= (1 << expr).
+*)
+
+PROCEDURE CodeNarrowIncl (location: location_t; settype, result, expr: CARDINAL) ;
+VAR
+   bit     : tree ;
+   isLvalue: BOOLEAN ;
+BEGIN
+   bit := SetElementToBit (location, settype, expr) ;
+   isLvalue := GetMode (result) = LeftValue ;
+   BuildAssignmentStatement (location, getrvalue (location, result, settype, isLvalue),
+                             ToBitset (location, BuildLogicalOr (location,
+                                                                 getrvalue (location, result, settype, isLvalue),
+                                                                 BuildLSL (location, GetWordOne (location),
+                                                                           bit, FALSE))))
+END CodeNarrowIncl ;
+
+
+(*
+   CodeNarrowExcl - result &= (~ (1 << expr)).
+*)
+
+PROCEDURE CodeNarrowExcl (location: location_t; settype, result, expr: CARDINAL) ;
+VAR
+   bit, mask: tree ;
+   isLvalue : BOOLEAN ;
+BEGIN
+   bit := SetElementToBit (location, settype, expr) ;
+   mask := BuildSetNegate (location,
+                           BuildLSL (location, GetWordOne (location),
+                                     ToWord (location, bit), FALSE)) ;
+   isLvalue := GetMode (result) = LeftValue ;
+   BuildAssignmentStatement (location, getrvalue (location, result, settype, isLvalue),
+                             ToBitset (location, BuildLogicalAnd (location,
+                                                                  getrvalue (location, result, settype, isLvalue),
+                                                                  mask)))
+END CodeNarrowExcl ;
+
+
+(*
+   SetWideUnaryBuiltinIncl -
+*)
+
+PROCEDURE SetWideUnaryBuiltinIncl (location: location_t; dest, bitno: tree) ;
+BEGIN
+   BuildAssignmentStatement (location, dest,
+                             BuildConvert (location, Mod2Gcc (Byte),
+                                           BuildLogicalOr (location,
+                                                           dest,
+                                                           BuildLSL (location, GetWordOne (location),
+                                                                     bitno, FALSE)),
+                                           FALSE))
+END SetWideUnaryBuiltinIncl ;
+
+
+(*
+   SetWideUnaryBuiltinExcl -
+*)
+
+PROCEDURE SetWideUnaryBuiltinExcl (location: location_t; dest, bitno: tree) ;
+VAR
+   mask: tree ;
+BEGIN
+   mask := BuildSetNegate (location,
+                           BuildLSL (location, GetWordOne (location),
+                                     ToWord (location, bitno), FALSE)) ;
+   BuildAssignmentStatement (location, dest,
+                             BuildConvert (location, Mod2Gcc (Byte),
+                                           BuildLogicalAnd (location, dest, mask),
+                                           FALSE))
+END SetWideUnaryBuiltinExcl ;
+
+
+(*
+   SetWideUnaryBuiltinIncl -
+*)
+
+PROCEDURE SetWideUnaryBuiltinInclExcl (tokenno: CARDINAL;
+                                       settype, des, expr: CARDINAL;
+                                       incl: BOOLEAN) ;
+VAR
+   bitsperbyte,
+   byteno,
+   bitno,
+   dest,
+   bit     : tree ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   bit := ToCardinal (location, SetElementToBit (location, settype, expr)) ;
+   bitsperbyte := ToCardinal (location, GetSizeOfInBits (Mod2Gcc (Byte))) ;
+   byteno := BuildDivFloor (location, bit, bitsperbyte, FALSE) ;
+   bitno := BuildModFloor (location, bit, bitsperbyte, FALSE) ;
+   dest := BuildArray (location, Mod2Gcc (Byte),
+                       getrvalue (location, des, GetType (des),
+                                  GetMode (des) = LeftValue),
+                       byteno, GetIntegerZero (location)) ;
+   IF incl
+   THEN
+      SetWideUnaryBuiltinIncl (location, dest, bitno)
    ELSE
-      PushValue(element) ;
-      PushValue(high) ;
-      IF Gre(tokenno)
+      SetWideUnaryBuiltinExcl (location, dest, bitno)
+   END
+END SetWideUnaryBuiltinInclExcl ;
+
+
+(*
+   SetWideInclExcl - generates M2WIDESET.procedurename (result, expr).
+*)
+
+PROCEDURE SetWideInclExcl (tokenno: CARDINAL; settype, result, expr: CARDINAL;
+                           procedurename: Name) ;
+BEGIN
+   IF OptimizeSets
+   THEN
+      IF procedurename = MakeKey ('Incl')
+      THEN
+         SetWideUnaryBuiltinInclExcl (tokenno, settype, result, expr, TRUE)
+      ELSIF procedurename = MakeKey ('Excl')
       THEN
-         RETURN( -1 )
+         SetWideUnaryBuiltinInclExcl (tokenno, settype, result, expr, FALSE)
+      ELSE
+         InternalError ('expecting Incl or Excl procedure')
       END
-   END ;
+   ELSE
+      SetWideInclExclLibrary (tokenno, settype, result, expr, procedurename)
+   END
+END SetWideInclExcl ;
 
-   (* all legal *)
 
-   PushValue(low) ;
-   offset := PopIntegerTree() ;
-   c := 0 ;
-   PushValue(element) ;
-   PushValue(low) ;
-   PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
-   PushCard(bpw) ;
-   PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
-   Addn ;
-   WHILE GreEqu(tokenno) DO
-      INC(c) ;   (* move onto next field *)
-      PushValue(element) ;
-      PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
-      PushCard((c+1)*bpw) ;
-      PushValue(low) ;
-      PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
-      Addn ;
-      PushIntegerTree(offset) ;
-      PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
-      PushCard(bpw) ;
-      PushIntegerTree(ToCardinal(location, PopIntegerTree())) ;
-      Addn ;
-      offset := PopIntegerTree()
-   END ;
-   RETURN( VAL(INTEGER, c) )
-END GetFieldNo ;
+(*
+   SetWideInclExclLibrary -
+*)
+
+PROCEDURE SetWideInclExclLibrary (tokenno: CARDINAL; settype, result, expr: CARDINAL;
+                                  procedurename: Name) ;
+VAR
+   location : location_t ;
+   procedure,
+   setparam : CARDINAL ;
+   highbit,
+   bit,
+   setarray,
+   call     : tree ;
+BEGIN
+   procedure := FromM2WIDESETImport (tokenno, procedurename) ;
+   location := TokenToLocation (tokenno) ;
+   bit := SetElementToBit (location, settype, expr) ;
+   highbit := ToCardinal (location, CalcBitsInSet (location, settype)) ;
+   setparam := GetNthParamAnyClosest (procedure, 1, GetMainModule ()) ;
+   setarray := CreateSetArrayParam (location, tokenno, result, setparam) ;
+   BuildParam (location, highbit) ;                      (* 3rd Parameter.  *)
+   BuildParam (location, ToCardinal (location, bit)) ;   (* 2nd Parameter.  *)
+   BuildParam (location, setarray) ;                     (* 1st Parameter.  *)
+   call := BuildProcedureCallTree (location, Mod2Gcc (procedure), NIL) ;
+   SetLastFunction (NIL) ;
+   AddStatement (location, call)
+END SetWideInclExclLibrary ;
 
 
 (*
    CodeIncl - encode an InclOp:
-              result := result + (1 << expr)
+              result |= (1 << expr).
 *)
 
-PROCEDURE CodeIncl (result, expr: CARDINAL) ;
+PROCEDURE CodeIncl (quad: CARDINAL) ;
 VAR
-   low,
-   high    : CARDINAL ;
-   offset  : tree ;
-   fieldno : INTEGER ;
-   location: location_t ;
+   overflow,
+   constExpr   : BOOLEAN ;
+   op          : QuadOperator ;
+   tokenno     : CARDINAL;
+   result, expr: CARDINAL;
+   settype     : CARDINAL ;
+   nooperand   : CARDINAL ;
+   nopos       : CARDINAL ;
+   location    : location_t ;
 BEGIN
-   (* firstly ensure that constant literals are declared *)
-   DeclareConstant (CurrentQuadToken, expr) ;
-   location := TokenToLocation (CurrentQuadToken) ;
+   GetQuadOtok (quad, tokenno, op,
+                result, nooperand, expr,
+                overflow, constExpr,
+                nopos, nopos, nopos) ;
+   (* Firstly ensure that constant literals are declared *)
+   DeclareConstant (tokenno, expr) ;
+   location := TokenToLocation (tokenno) ;
+   checkDeclare (result) ;
+   settype := GetLType (result) ;
+   Assert (IsSet (settype)) ;
 
    IF IsConst (result)
    THEN
@@ -5820,27 +6435,14 @@ BEGIN
          InternalError ('should not get to here (why are we generating <incl const, var> ?)')
       END
    ELSE
-      IF IsConst (expr)
+      IF IsElementInRange (tokenno, settype, result, expr)
       THEN
-         fieldno := GetFieldNo (CurrentQuadToken, expr, GetType (result), offset) ;
-         IF fieldno >= 0
+         IF GetSetInWord (settype)
          THEN
-            PushValue (expr) ;
-            PushIntegerTree (offset) ;
-            Sub ;
-            BuildIncludeVarConst (location,
-                                  Mod2Gcc (GetType (result)),
-                                  Mod2Gcc (result),
-                                  PopIntegerTree (),
-                                  GetMode (result) = LeftValue, fieldno)
+            CodeNarrowIncl (location, settype, result, expr)
          ELSE
-            MetaErrorT1 (CurrentQuadToken, 'bit exceeded the range of set {%1Eatd}', result)
+            SetWideInclExcl (tokenno, settype, result, expr, MakeKey ("Incl"))
          END
-      ELSE
-         GetSetLimits (GetType (result), low, high) ;
-         BuildIncludeVarVar (location,
-                             Mod2Gcc (GetType(result)),
-                             Mod2Gcc (result), Mod2Gcc(expr), GetMode(result) = LeftValue, Mod2Gcc (low))
       END
    END
 END CodeIncl ;
@@ -5848,13 +6450,13 @@ END CodeIncl ;
 
 (*
    FoldExcl - check whether we can fold the InclOp.
-              op1 := op1 - (1 << op3)
+              result &= ~ (1 << expr).
 *)
 
 PROCEDURE FoldExcl (tokenno: CARDINAL; p: WalkAction;
                     quad: CARDINAL; result, expr: CARDINAL) ;
 BEGIN
-   (* firstly ensure that constant literals are declared *)
+   (* Firstly ensure that constant literals are declared *)
    TryDeclareConstant (tokenno, expr) ;
    IF IsConst (result) AND IsConst (expr)
    THEN
@@ -5873,45 +6475,49 @@ END FoldExcl ;
 
 (*
    CodeExcl - encode an ExclOp:
-              result := result - (1 << expr)
+              result &= (~ (1 << expr)).
 *)
 
-PROCEDURE CodeExcl (result, expr: CARDINAL) ;
+PROCEDURE CodeExcl (quad: CARDINAL) ;
 VAR
-   low,
-   high    : CARDINAL ;
-   offset  : tree ;
-   fieldno : INTEGER ;
-   location: location_t ;
+   overflow,
+   constExpr   : BOOLEAN ;
+   op          : QuadOperator ;
+   tokenno     : CARDINAL;
+   result, expr: CARDINAL;
+   settype     : CARDINAL ;
+   nooperand   : CARDINAL ;
+   nopos       : CARDINAL ;
+   location    : location_t ;
 BEGIN
-   (* firstly ensure that constant literals are declared *)
-   DeclareConstant (CurrentQuadToken, expr) ;
-   location := TokenToLocation(CurrentQuadToken) ;
+   GetQuadOtok (quad, tokenno, op,
+                result, nooperand, expr,
+                overflow, constExpr,
+                nopos, nopos, nopos) ;
+   (* Firstly ensure that constant literals are declared *)
+   DeclareConstant (tokenno, expr) ;
+   location := TokenToLocation (tokenno) ;
+   checkDeclare (result) ;
+   settype := GetLType (result) ;
+   Assert (IsSet (settype)) ;
 
    IF IsConst (result)
    THEN
-      InternalError ('should not get to here (if we do we should consider calling FoldInclOp)')
-   ELSE
       IF IsConst (expr)
       THEN
-         fieldno := GetFieldNo (CurrentQuadToken, expr, GetType (result), offset) ;
-         IF fieldno >= 0
+         InternalError ('this quadruple should have been removed by FoldExcl')
+      ELSE
+         InternalError ('should not get to here (why are we generating <excl const, var> ?)')
+      END
+   ELSE
+      IF IsElementInRange (tokenno, settype, result, expr)
+      THEN
+         IF GetSetInWord (settype)
          THEN
-            PushValue (expr) ;
-            PushIntegerTree (offset) ;
-            Sub ;
-            BuildExcludeVarConst (location,
-                                  Mod2Gcc (GetType (result)),
-                                  Mod2Gcc (result), PopIntegerTree (),
-                                  GetMode (result)=LeftValue, fieldno)
+            CodeNarrowExcl (location, settype, result, expr)
          ELSE
-            MetaErrorT1 (CurrentQuadToken, 'bit exceeded the range of set {%1Eatd}', result)
+            SetWideInclExcl (tokenno, settype, result, expr, MakeKey ("Excl"))
          END
-      ELSE
-         GetSetLimits (GetType (result), low, high) ;
-         BuildExcludeVarVar (location,
-                             Mod2Gcc (GetType(result)),
-                             Mod2Gcc (result), Mod2Gcc(expr), GetMode(result) = LeftValue, Mod2Gcc (low))
       END
    END
 END CodeExcl ;
@@ -5978,7 +6584,7 @@ END FoldUnary ;
    FoldUnarySet - check whether we can fold the doOp operation.
 *)
 
-PROCEDURE FoldUnarySet (tokenno: CARDINAL; p: WalkAction; doOp: DoUnaryProcedure;
+PROCEDURE FoldUnarySet (tokenno: CARDINAL; p: WalkAction; doOp: ProcedureCardinal;
                         quad: CARDINAL; result, expr: CARDINAL) ;
 VAR
    location: location_t ;
@@ -6120,18 +6726,32 @@ END FoldNegate ;
                        is required.
 *)
 
-PROCEDURE CodeNegateChecked (quad: CARDINAL; op1, op3: CARDINAL) ;
+PROCEDURE CodeNegateChecked (quad: CARDINAL) ;
+VAR
+   operatorpos,
+   resultpos,
+   nopos, exprpos,
+   result, noop,
+   expr            : CARDINAL ;
+   typeChecking,
+   constExpr,
+   overflowChecking: BOOLEAN ;
+   op              : QuadOperator ;
 BEGIN
-   IF IsConstSet (op3) OR IsSet (GetType (op3))
+   GetQuadOTypetok (quad, operatorpos, op,
+                    result, noop, expr,
+                    overflowChecking, typeChecking, constExpr,
+                    resultpos, nopos, exprpos) ;
+   IF IsConstSet (expr) OR IsSet (GetType (expr))
    THEN
-      CodeUnarySet (BuildSetNegate, SetNegate, quad, op1, op3)
-   ELSIF UnaryOperand (quad, op3)
+      CodeUnarySet (SetNegate, BuildSetNegate, operatorpos, MakeKey ('Not'), quad, result, expr)
+   ELSIF UnaryOperand (quad, expr)
    THEN
       IF MustCheckOverflow (quad)
       THEN
-         CodeUnaryCheck (BuildNegateCheck, NIL, quad, op1, op3)
+         CodeUnaryCheck (BuildNegateCheck, NIL, quad, result, expr)
       ELSE
-         CodeUnary (BuildNegate, NIL, quad, op1, op3)
+         CodeUnary (BuildNegate, NIL, quad, result, expr)
       END
    END
 END CodeNegateChecked ;
@@ -6345,6 +6965,19 @@ BEGIN
 END BuildHighFromArray ;
 
 
+(*
+   BuildHighFromSetArray -
+*)
+
+PROCEDURE BuildHighFromSetArray (tokenno: CARDINAL; settype: CARDINAL) : tree ;
+VAR
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   RETURN BuildHighFromStaticArray (location, GetSetArray (settype))
+END BuildHighFromSetArray ;
+
+
 (*
    BuildHighFromStaticArray -
 *)
@@ -6414,26 +7047,29 @@ VAR
    Type    : CARDINAL ;
    location: location_t ;
 BEGIN
-   Type := SkipType(GetType(operand)) ;
-   location := TokenToLocation(tokenno) ;
+   Type := SkipType (GetType (operand)) ;
+   location := TokenToLocation (tokenno) ;
 
    IF (Type=Char) AND (dim=1)
    THEN
-      RETURN( BuildHighFromChar(operand) )
+      RETURN( BuildHighFromChar (operand) )
    ELSIF IsConstString(operand) AND (dim=1)
    THEN
-      RETURN( BuildHighFromString(operand) )
+      RETURN( BuildHighFromString (operand) )
    ELSIF IsArray(Type)
    THEN
-      RETURN( BuildHighFromArray(tokenno, dim, operand) )
-   ELSIF IsUnbounded(Type)
+      RETURN( BuildHighFromArray (tokenno, dim, operand) )
+   ELSIF IsSet (Type)
+   THEN
+      RETURN( BuildHighFromSetArray (tokenno, Type) )
+   ELSIF IsUnbounded (Type)
    THEN
-      RETURN( GetHighFromUnbounded(location, dim, operand) )
+      RETURN( GetHighFromUnbounded (location, dim, operand) )
    ELSE
       MetaErrorT1 (tokenno,
                    'base procedure HIGH expects a variable of type array or a constant string or CHAR as its parameter, rather than {%1Etad}',
                    operand) ;
-      RETURN( GetIntegerZero(location) )
+      RETURN( GetIntegerZero (location) )
    END
 END ResolveHigh ;
 
@@ -6500,11 +7136,11 @@ VAR
 BEGIN
    location := TokenToLocation (CurrentQuadToken) ;
 
-   (* firstly ensure that any constant literal is declared *)
+   (* Firstly ensure that any constant literal is declared.  *)
    DeclareConstant (CurrentQuadToken, array) ;
    IF IsConst (result)
    THEN
-      (* still have a constant which was not resolved, pass it to gcc *)
+      (* Still have a constant which was not resolved, pass it to gcc.  *)
       ConstantKnownAndUsed (result,
                             DeclareKnownConstant(location,
                                                  GetM2ZType (),
@@ -6522,7 +7158,7 @@ END CodeHigh ;
 
 (*
    CodeUnbounded - codes the creation of an unbounded parameter variable.
-                   places the address of op3 into *op1
+                   result = &array.  array can be an lvalue or rvalue.
 *)
 
 PROCEDURE CodeUnbounded (result, array: CARDINAL) ;
@@ -6535,23 +7171,31 @@ BEGIN
    DeclareConstant (CurrentQuadToken, array) ;
    IF IsConstString (array) OR (IsConst (array) AND (GetSType (array) = Char))
    THEN
-      BuildAssignmentStatement (location, Mod2Gcc (result), BuildAddr (location, PromoteToString (CurrentQuadToken, array), FALSE))
+      BuildAssignmentStatement (location, Mod2Gcc (result),
+                                BuildAddr (location, PromoteToString (CurrentQuadToken, array), FALSE))
    ELSIF IsConstructor (array)
    THEN
-      BuildAssignmentStatement (location, Mod2Gcc (result), BuildAddr (location, Mod2Gcc (array), TRUE))
+      BuildAssignmentStatement (location, Mod2Gcc (result),
+                                BuildAddr (location, Mod2Gcc (array), TRUE))
    ELSIF IsUnbounded (GetType (array))
    THEN
       IF GetMode(array) = LeftValue
       THEN
+         (* We already have the address of the array, convert it to type of result.  *)
          Addr := BuildConvert (location, Mod2Gcc (GetType (result)), Mod2Gcc (array), FALSE)
       ELSE
+         (* Access the address field from the unbounded record.  *)
          Addr := BuildComponentRef (location, Mod2Gcc (array), Mod2Gcc (GetUnboundedAddressOffset (GetType (array))))
       END ;
+      (* Store address in result.  *)
       BuildAssignmentStatement (location, Mod2Gcc (result), Addr)
-   ELSIF GetMode(array) = RightValue
+   ELSIF GetMode (array) = RightValue
    THEN
-      BuildAssignmentStatement (location, Mod2Gcc (result), BuildAddr (location, Mod2Gcc (array), FALSE))
+      (* Static array, get the address and store into result.  *)
+      BuildAssignmentStatement (location, Mod2Gcc (result),
+                                BuildAddr (location, Mod2Gcc (array), FALSE))
    ELSE
+      (* Static array which is a left value, just copy the address into result.  *)
       BuildAssignmentStatement (location, Mod2Gcc (result), Mod2Gcc (array))
    END
 END CodeUnbounded ;
@@ -6866,9 +7510,7 @@ VAR
    tl, tr  : tree ;
    location: location_t ;
 BEGIN
-   CheckStop(quad) ;
-
-   (* firstly ensure that constant literals are declared *)
+   (* Firstly ensure that constant literals are declared.  *)
    DeclareConstant(CurrentQuadToken, rhs) ;
    DeclareConstructor(CurrentQuadToken, quad, rhs) ;
    location := TokenToLocation(CurrentQuadToken) ;
@@ -6876,20 +7518,20 @@ BEGIN
    tl := LValueToGenericPtr(location, type) ;
    IF IsProcedure(rhs)
    THEN
-      tr := BuildAddr(location, Mod2Gcc(rhs), FALSE)
+      tr := BuildAddr (location, Mod2Gcc (rhs), FALSE)
    ELSE
       tr := LValueToGenericPtr(location, rhs) ;
       tr := ConvertRHS(tr, type, rhs)
    END ;
    IF IsConst(lhs)
    THEN
-      (* fine, we can take advantage of this and fold constant *)
+      (* Fine, we can take advantage of this and fold constant.  *)
       PutConst(lhs, type) ;
       tl := Mod2Gcc(SkipType(type)) ;
       ConstantKnownAndUsed (lhs,
                             BuildConvert (location, tl, Mod2Gcc (rhs), TRUE))
    ELSE
-      BuildAssignmentStatement (location, Mod2Gcc (lhs), BuildConvert (location, tl, tr, TRUE)) ;
+      BuildAssignmentStatement (location, Mod2Gcc (lhs), BuildConvert (location, tl, tr, TRUE))
    END
 END CodeConvert ;
 
@@ -7115,7 +7757,7 @@ END CreateLabelProcedureN ;
 
 PROCEDURE CreateLabelName (q: CARDINAL) : String ;
 BEGIN
-   (* prefixed by . to ensure that no Modula-2 identifiers clash *)
+   (* Prefixed by . to ensure that no Modula-2 identifiers clash *)
    RETURN( Sprintf1(Mark(InitString('.L%d')), q) )
 END CreateLabelName ;
 
@@ -7142,86 +7784,120 @@ VAR
    location: location_t ;
 BEGIN
    location := TokenToLocation(CurrentQuadToken) ;
-
-   (* we do not create labels for procedure entries *)
-   IF (op#ProcedureScopeOp) AND (op#NewLocalVarOp) AND IsReferenced(quad)
+   (* We do not create labels for procedure entries.  *)
+   IF (op # ProcedureScopeOp) AND (op # NewLocalVarOp) AND IsReferenced (quad)
    THEN
-      DeclareLabel(location, string(CreateLabelName(quad)))
+      DeclareLabel (location, string (CreateLabelName (quad)))
    END
 END CheckReferenced ;
 
 
 (*
-   CodeIfSetLess -
+   CodeIfSetCondition - code IF left cond right then destquad for set types.
 *)
 
-PROCEDURE CodeIfSetLess (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+PROCEDURE CodeIfSetCondition (tokenno: CARDINAL;
+                              left, right, destquad: CARDINAL;
+                              cond: BinaryFunction; procedurename: Name) ;
 VAR
-   settype   : CARDINAL ;
-   falselabel: ADDRESS ;
-   location  : location_t ;
+   settype : CARDINAL ;
+   location: location_t ;
+   expr    : tree ;
 BEGIN
-   location := TokenToLocation(CurrentQuadToken) ;
-
-   IF IsConst(op1) AND IsConst(op2)
+   location := TokenToLocation (tokenno) ;
+   IF IsConst (left) AND IsConst (right)
    THEN
       InternalError ('this should have been folded in the calling procedure')
-   ELSIF IsConst(op1)
+   ELSIF IsConst(left)
    THEN
-      settype := SkipType(GetType(op2))
+      settype := SkipType (GetType (right))
    ELSE
-      settype := SkipType(GetType(op1))
+      settype := SkipType (GetType (left))
    END ;
-   IF CompareTrees(FindSize(CurrentQuadToken, settype), FindSize(CurrentQuadToken, Word)) <= 0
-   THEN
-      (* word size sets *)
-      DoJump(location,
-             BuildIsNotSuperset(location,
-                                BuildConvert(location, GetWordType(), Mod2Gcc(op1), FALSE),
-                                BuildConvert(location, GetWordType(), Mod2Gcc(op2), FALSE)),
-             NIL, string(CreateLabelName(op3)))
+   IF GetSetInWord (settype)
+   THEN
+      (* WORD size sets.  *)
+      expr := cond (location,
+                    BuildConvert (location, GetWordType (),
+                                  Mod2Gcc (left), FALSE),
+                    BuildConvert (location, GetWordType (),
+                                  Mod2Gcc (right), FALSE))
    ELSE
-      falselabel := string(Sprintf1(Mark(InitString('.Lset%dcomp')), quad)) ;
+      expr := CallSetWideBoolFunction (location, tokenno,
+                                       procedurename, settype, left, right)
+   END ;
+   IfExprJump (location, expr, string (CreateLabelName (destquad)))
+END CodeIfSetCondition ;
 
-      BuildForeachWordInSetDoIfExpr(location,
-                                    Mod2Gcc(settype),
-                                    Mod2Gcc(op1), Mod2Gcc(op2),
-                                    GetMode(op1)=LeftValue,
-                                    GetMode(op2)=LeftValue,
-                                    IsConst(op1), IsConst(op2),
-                                    BuildIsSuperset,
-                                    falselabel) ;
 
-      BuildGoto(location, string(CreateLabelName(op3))) ;
-      DeclareLabel(location, falselabel)
-   END
+(*
+   CodeIfSetLess - code IF left < right then destquad for set types.
+*)
+
+PROCEDURE CodeIfSetLess (tokenno: CARDINAL; left, right, destquad: CARDINAL) ;
+BEGIN
+   CodeIfSetCondition (tokenno, left, right, destquad,
+                       BuildIsSubset, MakeKey ("Less"))
 END CodeIfSetLess ;
 
 
 (*
-   PerformCodeIfLess - codes the quadruple if op1 < op2 then goto op3
+   CodeIfSetLessEqu - code IF left <= right then destquad for set types.
 *)
 
-PROCEDURE PerformCodeIfLess (quad: CARDINAL) ;
-VAR
-   tl, tr  : tree ;
-   location                   : location_t ;
-   left, right, dest, combined,
-   leftpos, rightpos, destpos : CARDINAL ;
-   constExpr, overflow        : BOOLEAN ;
-   op                         : QuadOperator ;
+PROCEDURE CodeIfSetLessEqu (tokenno: CARDINAL; left, right, destquad: CARDINAL) ;
 BEGIN
-   GetQuadOtok (quad, combined, op,
-                left, right, dest, overflow,
-                constExpr,
-                leftpos, rightpos, destpos) ;
-   location := TokenToLocation (combined) ;
+   CodeIfSetCondition (tokenno, left, right, destquad,
+                       BuildIsSubset, MakeKey ("LessEqu"))
+END CodeIfSetLessEqu ;
 
-   IF IsConst(left) AND IsConst(right)
-   THEN
-      PushValue(left) ;
-      PushValue(right) ;
-      IF Less(CurrentQuadToken)
+
+(*
+   CodeIfSetGre - code IF left > right then destquad for set types.
+*)
+
+PROCEDURE CodeIfSetGre (tokenno: CARDINAL; left, right, destquad: CARDINAL) ;
+BEGIN
+   CodeIfSetCondition (tokenno, left, right, destquad,
+                       BuildIsNotSubset, MakeKey ("Gre"))
+END CodeIfSetGre ;
+
+
+(*
+   CodeIfSetGreEqu - code IF left >= right then destquad for set types.
+*)
+
+PROCEDURE CodeIfSetGreEqu (tokenno: CARDINAL; left, right, destquad: CARDINAL) ;
+BEGIN
+   CodeIfSetCondition (tokenno, left, right, destquad,
+                       BuildIsNotSubset, MakeKey ("GreEqu"))
+END CodeIfSetGreEqu ;
+
+
+(*
+   PerformCodeIfLess - codes the quadruple if op1 < op2 then goto op3
+*)
+
+PROCEDURE PerformCodeIfLess (quad: CARDINAL) ;
+VAR
+   tl, tr  : tree ;
+   location                   : location_t ;
+   left, right, dest, combined,
+   leftpos, rightpos, destpos : CARDINAL ;
+   constExpr, overflow        : BOOLEAN ;
+   op                         : QuadOperator ;
+BEGIN
+   GetQuadOtok (quad, combined, op,
+                left, right, dest, overflow,
+                constExpr,
+                leftpos, rightpos, destpos) ;
+   location := TokenToLocation (combined) ;
+
+   IF IsConst(left) AND IsConst(right)
+   THEN
+      PushValue(left) ;
+      PushValue(right) ;
+      IF Less(CurrentQuadToken)
       THEN
          BuildGoto(location, string(CreateLabelName(dest)))
       ELSE
@@ -7230,7 +7906,7 @@ BEGIN
    ELSIF IsConstSet(left) OR (IsVar(left) AND IsSet(SkipType(GetType(left)))) OR
          IsConstSet(right) OR (IsVar(right) AND IsSet(SkipType(GetType(right))))
    THEN
-      CodeIfSetLess(quad, left, right, dest)
+      CodeIfSetLess (combined, left, right, dest)
    ELSE
       IF IsComposite(GetType(left)) OR IsComposite(GetType(right))
       THEN
@@ -7245,8 +7921,8 @@ BEGIN
                                                     SkipType (GetType (right)),
                                                     combined),
                                 left, right) ;
-         DoJump (location,
-                 BuildLessThan (location, tl, tr), NIL, string (CreateLabelName (dest)))
+         IfExprJump (location,
+                     BuildLessThan(location, tl, tr), string(CreateLabelName (dest)))
       END
    END
 END PerformCodeIfLess ;
@@ -7266,50 +7942,151 @@ END CodeIfLess ;
 
 
 (*
-   CodeIfSetGre -
+   CodeIfSetEquNarrow -
 *)
 
-PROCEDURE CodeIfSetGre (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
+PROCEDURE CodeIfSetEquNarrow (location: location_t; invertCondition: BOOLEAN;
+                              settype: CARDINAL; left, right: tree;
+                              destQuad: CARDINAL) ;
 VAR
-   settype   : CARDINAL ;
-   falselabel: ADDRESS ;
-   location  : location_t ;
+   condition,
+   mask     : tree ;
 BEGIN
-   location := TokenToLocation(CurrentQuadToken) ;
+   (* The set type fits inside a word, so mask off any unused bits.  *)
+   mask := BuildMask (location, CalcBitsInSet (location, settype), FALSE) ;
+   left := BuildLogicalAnd (location, left, mask) ;
+   right := BuildLogicalAnd (location, right, mask) ;
+   IF invertCondition
+   THEN
+      condition := BuildNotEqualTo (location, left, right)
+   ELSE
+      condition := BuildEqualTo (location, left, right)
+   END ;
+   IfExprJump (location, condition,
+               string (CreateLabelName (destQuad)))
+END CodeIfSetEquNarrow ;
 
-   IF IsConst(op1) AND IsConst(op2)
+
+(*
+   CallSetWideBoolFunction - return a tree containing a call to
+                             M2WIDESET.widefuncname (left, right, HIGHBIT (settype)).
+*)
+
+PROCEDURE CallSetWideBoolFunction (location: location_t; tokenno: CARDINAL;
+                                   widefuncname: Name;
+                                   settype, left, right: CARDINAL) : tree ;
+VAR
+   function,
+   param1,
+   param2  : CARDINAL ;
+   highbit,
+   array1,
+   array2,
+   call    : tree ;
+BEGIN
+   function := FromM2WIDESETImport (tokenno, widefuncname) ;
+   checkDeclare (function) ;
+   location := TokenToLocation (tokenno) ;
+   param1 := GetNthParamAnyClosest (function, 1, GetMainModule ()) ;
+   param2 := GetNthParamAnyClosest (function, 2, GetMainModule ()) ;
+   array1 := CreateSetArrayParam (location, tokenno, left, param1) ;
+   array2 := CreateSetArrayParam (location, tokenno, right, param2) ;
+   highbit := ToCardinal (location, CalcHighSetBit (location, settype)) ;
+   BuildParam (location, highbit) ;  (* Parameter 3.  *)
+   BuildParam (location, array2) ;   (* Parameter 2.  *)
+   BuildParam (location, array1) ;   (* Parameter 1.  *)
+   call := BuildProcedureCallTree (location, Mod2Gcc (function),
+                                   Mod2Gcc (GetType (function))) ;
+   SetLastFunction (NIL) ;
+   RETURN call
+END CallSetWideBoolFunction ;
+
+
+(*
+   CodeIfSetEquWide - creates a statement tree:
+                      if left = right then goto destQuad.  The boolean
+                      invertCondition will check left # right.
+*)
+
+PROCEDURE CodeIfSetEquWide (location: location_t; tokenno: CARDINAL;
+                            invertCondition: BOOLEAN;
+                            settype, left, right: CARDINAL; destQuad: CARDINAL) ;
+VAR
+   call, expr, label: tree ;
+BEGIN
+   call := CallSetWideBoolFunction (location, tokenno, MakeKey ("Equal"),
+                                    settype, left, right) ;
+   label := CreateLabelName (destQuad) ;
+   IF invertCondition
    THEN
-      InternalError ('this should have been folded in the calling procedure')
-   ELSIF IsConst(op1)
+      expr := BuildEqualTo (location, call, GetBooleanFalse ())
+   ELSE
+      expr := BuildNotEqualTo (location, call, GetBooleanFalse ())
+   END ;
+   IfExprJump (location, expr, string (label))
+END CodeIfSetEquWide ;
+
+
+(*
+   CodeIfSetEquLower code a comparison between left and right and if true
+   jump to destQuad.  The invertCondition allows for the inverse test.
+   Note that if op1 and op2 are not both constants as this will have been
+   evaluated in CodeIfNotEqu.
+*)
+
+PROCEDURE CodeIfSetEquLower (tokenno: CARDINAL; invertCondition: BOOLEAN;
+                             left, right, destQuad: CARDINAL) ;
+VAR
+   settype : CARDINAL ;
+   location: location_t ;
+BEGIN
+   location := TokenToLocation (tokenno) ;
+   IF IsConst (left) AND IsConst (right)
    THEN
-      settype := SkipType(GetType(op2))
+      InternalError ('this should have been folded by CodeIfEqu or CodeIfNotEqu')
+   ELSIF IsConst (left)
+   THEN
+      settype := GetLType (right)
    ELSE
-      settype := SkipType(GetType(op1))
+      settype := GetLType (left)
    END ;
-   IF CompareTrees(FindSize(CurrentQuadToken, settype), FindSize(CurrentQuadToken, Word)) <= 0
-   THEN
-      (* word size sets *)
-      DoJump(location,
-             BuildIsNotSubset(location,
-                              BuildConvert(location, GetWordType(), Mod2Gcc(op1), FALSE),
-                              BuildConvert(location, GetWordType(), Mod2Gcc(op2), FALSE)),
-             NIL, string(CreateLabelName(op3)))
+   IF GetLType (left) # GetLType (right)
+   THEN
+      (* This test used to occur after the GetSetInWord (settype) condition.  *)
+      MetaErrorT2 (tokenno,
+                   'set comparison is only allowed between the same set type, the set types used by {%1Eatd} and {%2atd} are different',
+                   left, right)
+   END ;
+   IF GetSetInWord (settype)
+   THEN
+      (* Allow sets to be compared against { } for bitset.  *)
+      CodeIfSetEquNarrow (location, invertCondition, settype,
+                          Mod2Gcc (left), Mod2Gcc (right), destQuad)
    ELSE
-      falselabel := string(Sprintf1(Mark(InitString('.Lset%dcomp')), quad)) ;
+      CodeIfSetEquWide (location, tokenno, invertCondition, settype,
+                        left, right, destQuad)
+   END
+END CodeIfSetEquLower ;
 
-      BuildForeachWordInSetDoIfExpr(location,
-                                    Mod2Gcc(settype),
-                                    Mod2Gcc(op1), Mod2Gcc(op2),
-                                    GetMode(op1)=LeftValue,
-                                    GetMode(op2)=LeftValue,
-                                    IsConst(op1), IsConst(op2),
-                                    BuildIsSubset,
-                                    falselabel) ;
 
-      BuildGoto(location, string(CreateLabelName(op3))) ;
-      DeclareLabel(location, falselabel)
-   END
-END CodeIfSetGre ;
+(*
+   CodeIfSetNotEqu - codes if op1 # op2 then goto op3
+*)
+
+PROCEDURE CodeIfSetNotEqu (tokenno: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+   CodeIfSetEquLower (tokenno, TRUE, left, right, destQuad)
+END CodeIfSetNotEqu ;
+
+
+(*
+   CodeIfSetEqu - codes if op1 = op2 then goto op3
+*)
+
+PROCEDURE CodeIfSetEqu (tokenno: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+   CodeIfSetEquLower (tokenno, FALSE, left, right, destQuad)
+END CodeIfSetEqu ;
 
 
 (*
@@ -7318,7 +8095,7 @@ END CodeIfSetGre ;
 
 PROCEDURE PerformCodeIfGre (quad: CARDINAL) ;
 VAR
-   tl, tr  : tree ;
+   tl, tr, condition          : tree ;
    location                   : location_t ;
    left, right, dest, combined,
    leftpos, rightpos, destpos : CARDINAL ;
@@ -7342,22 +8119,23 @@ BEGIN
    ELSIF IsConstSet(left) OR (IsVar(left) AND IsSet(SkipType(GetType(left)))) OR
          IsConstSet(right) OR (IsVar(right) AND IsSet(SkipType(GetType(right))))
    THEN
-      CodeIfSetGre(quad, left, right, dest)
+      CodeIfSetGre (combined, left, right, dest)
    ELSE
-      IF IsComposite(GetType(left)) OR IsComposite(GetType(right))
+      IF IsComposite (GetType (left)) OR IsComposite (GetType (right))
       THEN
          MetaErrorT2 (combined,
                       'comparison tests between composite types not allowed {%1Eatd} and {%2atd}',
                       left, right)
       ELSE
-         ConvertBinaryOperands(location,
-                               tl, tr,
-                               ComparisonMixTypes (left, right,
-                                                   SkipType (GetType (left)),
-                                                   SkipType (GetType (right)),
-                                                   combined),
-                               left, right) ;
-         DoJump(location, BuildGreaterThan(location, tl, tr), NIL, string(CreateLabelName(dest)))
+         ConvertBinaryOperands (location,
+                                tl, tr,
+                                ComparisonMixTypes (left, right,
+                                                    SkipType (GetType (left)),
+                                                    SkipType (GetType (right)),
+                                                    combined),
+                                left, right) ;
+         condition := BuildGreaterThan (location, tl, tr) ;
+         IfExprJump (location, condition, string (CreateLabelName (dest)))
       END
    END
 END PerformCodeIfGre ;
@@ -7376,60 +8154,13 @@ BEGIN
 END CodeIfGre ;
 
 
-(*
-   CodeIfSetLessEqu -
-*)
-
-PROCEDURE CodeIfSetLessEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
-VAR
-   settype   : CARDINAL ;
-   falselabel: ADDRESS ;
-   location  : location_t ;
-BEGIN
-   location := TokenToLocation(CurrentQuadToken) ;
-
-   IF IsConst(op1) AND IsConst(op2)
-   THEN
-      InternalError ('this should have been folded in the calling procedure')
-   ELSIF IsConst(op1)
-   THEN
-      settype := SkipType(GetType(op2))
-   ELSE
-      settype := SkipType(GetType(op1))
-   END ;
-   IF CompareTrees(FindSize(CurrentQuadToken, settype), FindSize(CurrentQuadToken, Word)) <= 0
-   THEN
-      (* word size sets *)
-      DoJump(location,
-             BuildIsSubset(location,
-                           BuildConvert(location, GetWordType(), Mod2Gcc(op1), FALSE),
-                           BuildConvert(location, GetWordType(), Mod2Gcc(op2), FALSE)),
-             NIL, string(CreateLabelName(op3)))
-   ELSE
-      falselabel := string(Sprintf1(Mark(InitString('.Lset%dcomp')), quad)) ;
-
-      BuildForeachWordInSetDoIfExpr(location,
-                                    Mod2Gcc(settype),
-                                    Mod2Gcc(op1), Mod2Gcc(op2),
-                                    GetMode(op1)=LeftValue,
-                                    GetMode(op2)=LeftValue,
-                                    IsConst(op1), IsConst(op2),
-                                    BuildIsNotSubset,
-                                    falselabel) ;
-
-      BuildGoto(location, string(CreateLabelName(op3))) ;
-      DeclareLabel(location, falselabel)
-   END
-END CodeIfSetLessEqu ;
-
-
 (*
    PerformCodeIfLessEqu - codes the quadruple if op1 <= op2 then goto op3
 *)
 
 PROCEDURE PerformCodeIfLessEqu (quad: CARDINAL) ;
 VAR
-   tl, tr  : tree ;
+   tl, tr, condition          : tree ;
    location                   : location_t ;
    left, right, dest, combined,
    leftpos, rightpos, destpos : CARDINAL ;
@@ -7454,7 +8185,7 @@ BEGIN
    ELSIF IsConstSet (left) OR (IsVar (left) AND IsSet (SkipType (GetType (left)))) OR
          IsConstSet (right) OR (IsVar (right) AND IsSet (SkipType (GetType (right))))
    THEN
-      CodeIfSetLessEqu (quad, left, right, dest)
+      CodeIfSetLessEqu (combined, left, right, dest)
    ELSE
       IF IsComposite (GetType (left)) OR IsComposite (GetType (right))
       THEN
@@ -7469,8 +8200,8 @@ BEGIN
                                                     SkipType (GetType (right)),
                                                     combined),
                                 left, right) ;
-         DoJump (location, BuildLessThanOrEqual (location, tl, tr),
-                 NIL, string (CreateLabelName (dest)))
+         condition := BuildLessThanOrEqual (location, tl, tr) ;
+         IfExprJump (location, condition, string (CreateLabelName (dest)))
       END
    END
 END PerformCodeIfLessEqu ;
@@ -7489,60 +8220,13 @@ BEGIN
 END CodeIfLessEqu ;
 
 
-(*
-   CodeIfSetGreEqu -
-*)
-
-PROCEDURE CodeIfSetGreEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
-VAR
-   settype   : CARDINAL ;
-   falselabel: ADDRESS ;
-   location: location_t ;
-BEGIN
-   location := TokenToLocation(CurrentQuadToken) ;
-
-   IF IsConst(op1) AND IsConst(op2)
-   THEN
-      InternalError ('this should have been folded in the calling procedure')
-   ELSIF IsConst(op1)
-   THEN
-      settype := SkipType(GetType(op2))
-   ELSE
-      settype := SkipType(GetType(op1))
-   END ;
-   IF CompareTrees(FindSize(CurrentQuadToken, settype), FindSize(CurrentQuadToken, Word)) <= 0
-   THEN
-      (* word size sets *)
-      DoJump(location,
-             BuildIsSuperset(location,
-                             BuildConvert(location, GetWordType(), Mod2Gcc(op1), FALSE),
-                             BuildConvert(location, GetWordType(), Mod2Gcc(op2), FALSE)),
-             NIL, string(CreateLabelName(op3)))
-   ELSE
-      falselabel := string(Sprintf1(Mark(InitString('.Lset%dcomp')), quad)) ;
-
-      BuildForeachWordInSetDoIfExpr(location,
-                                    Mod2Gcc(settype),
-                                    Mod2Gcc(op1), Mod2Gcc(op2),
-                                    GetMode(op1)=LeftValue,
-                                    GetMode(op2)=LeftValue,
-                                    IsConst(op1), IsConst(op2),
-                                    BuildIsNotSuperset,
-                                    falselabel) ;
-
-      BuildGoto(location, string(CreateLabelName(op3))) ;
-      DeclareLabel(location, falselabel)
-   END
-END CodeIfSetGreEqu ;
-
-
 (*
    PerformCodeIfGreEqu - codes the quadruple if op1 >= op2 then goto op3
 *)
 
 PROCEDURE PerformCodeIfGreEqu (quad: CARDINAL) ;
 VAR
-   tl, tr: tree ;
+   tl, tr, condition          : tree ;
    location                   : location_t ;
    left, right, dest, combined,
    leftpos, rightpos, destpos : CARDINAL ;
@@ -7567,7 +8251,7 @@ BEGIN
    ELSIF IsConstSet(left) OR (IsVar(left) AND IsSet(SkipType(GetType(left)))) OR
          IsConstSet(right) OR (IsVar(right) AND IsSet(SkipType(GetType(right))))
    THEN
-      CodeIfSetGreEqu(quad, left, right, dest)
+      CodeIfSetGreEqu (combined, left, right, dest)
    ELSE
       IF IsComposite(GetType(left)) OR IsComposite(GetType(right))
       THEN
@@ -7582,7 +8266,8 @@ BEGIN
                                                    SkipType (GetType (right)),
                                                    combined),
                                left, right) ;
-         DoJump(location, BuildGreaterThanOrEqual(location, tl, tr), NIL, string(CreateLabelName(dest)))
+         condition := BuildGreaterThanOrEqual(location, tl, tr) ;
+         IfExprJump (location, condition, string (CreateLabelName (dest)))
       END
    END
 END PerformCodeIfGreEqu ;
@@ -7601,111 +8286,6 @@ BEGIN
 END CodeIfGreEqu ;
 
 
-(*
-   CodeIfSetEqu - codes if op1 = op2 then goto op3
-                  Note that if op1 and op2 are not both constants
-                  since this will have been evaluated in CodeIfEqu.
-*)
-
-PROCEDURE CodeIfSetEqu (quad: CARDINAL; op1, op2, op3: CARDINAL) ;
-VAR
-   settype   : CARDINAL ;
-   falselabel: ADDRESS ;
-   location  : location_t ;
-BEGIN
-   location := TokenToLocation(CurrentQuadToken) ;
-
-   IF IsConst(op1) AND IsConst(op2)
-   THEN
-      InternalError ('this should have been folded in the calling procedure')
-   ELSIF IsConst(op1)
-   THEN
-      settype := SkipType(GetType(op2))
-   ELSE
-      settype := SkipType(GetType(op1))
-   END ;
-   IF CompareTrees(FindSize(CurrentQuadToken, settype), FindSize(CurrentQuadToken, Word)) <= 0
-   THEN
-      (* word size sets *)
-      DoJump(location,
-             BuildEqualTo(location,
-                          BuildConvert(location, GetWordType(), Mod2Gcc(op1), FALSE),
-                          BuildConvert(location, GetWordType(), Mod2Gcc(op2), FALSE)),
-             NIL, string(CreateLabelName(op3)))
-   ELSIF GetSType(op1)=GetSType(op2)
-   THEN
-      falselabel := string(Sprintf1(Mark(InitString('.Lset%dcomp')), quad)) ;
-
-      BuildForeachWordInSetDoIfExpr(location,
-                                    Mod2Gcc(settype),
-                                    Mod2Gcc(op1), Mod2Gcc(op2),
-                                    GetMode(op1)=LeftValue,
-                                    GetMode(op2)=LeftValue,
-                                    IsConst(op1), IsConst(op2),
-                                    BuildNotEqualTo,
-                                    falselabel) ;
-
-      BuildGoto(location, string(CreateLabelName(op3))) ;
-      DeclareLabel(location, falselabel)
-   ELSE
-      MetaErrorT2 (CurrentQuadToken,
-                   'set comparison is only allowed between the same set type, the set types used by {%1Eatd} and {%2atd} are different',
-                   op1, op2)
-   END
-END CodeIfSetEqu ;
-
-
-(*
-   CodeIfSetNotEqu - codes if op1 # op2 then goto op3
-                     Note that if op1 and op2 are not both constants
-                     since this will have been evaluated in CodeIfNotEqu.
-*)
-
-PROCEDURE CodeIfSetNotEqu (left, right, destQuad: CARDINAL) ;
-VAR
-   settype  : CARDINAL ;
-   truelabel: ADDRESS ;
-   location  : location_t ;
-BEGIN
-   location := TokenToLocation(CurrentQuadToken) ;
-
-   IF IsConst (left) AND IsConst (right)
-   THEN
-      InternalError ('this should have been folded in the calling procedure')
-   ELSIF IsConst (left)
-   THEN
-      settype := SkipType (GetType (right))
-   ELSE
-      settype := SkipType (GetType (left))
-   END ;
-   IF CompareTrees (FindSize (CurrentQuadToken, settype), FindSize (CurrentQuadToken, Word)) <= 0
-   THEN
-      (* word size sets *)
-      DoJump (location,
-              BuildNotEqualTo(location,
-                              BuildConvert (location, GetWordType (), Mod2Gcc (left), FALSE),
-                              BuildConvert (location, GetWordType (), Mod2Gcc (right), FALSE)),
-              NIL, string (CreateLabelName (destQuad)))
-   ELSIF GetSType (left) = GetSType (right)
-   THEN
-      truelabel := string (CreateLabelName (destQuad)) ;
-
-      BuildForeachWordInSetDoIfExpr (location,
-                                     Mod2Gcc (settype),
-                                     Mod2Gcc (left), Mod2Gcc (right),
-                                     GetMode (left) = LeftValue,
-                                     GetMode (right) = LeftValue,
-                                     IsConst (left), IsConst (right),
-                                     BuildNotEqualTo,
-                                     truelabel)
-   ELSE
-      MetaErrorT2 (CurrentQuadToken,
-                   'set comparison is only allowed between the same set type, the set types used by {%1Eatd} and {%2atd} are different',
-                   left, right)
-   END
-END CodeIfSetNotEqu ;
-
-
 (*
    ComparisonMixTypes -
 *)
@@ -7730,7 +8310,7 @@ END ComparisonMixTypes ;
 
 PROCEDURE PerformCodeIfEqu (quad: CARDINAL) ;
 VAR
-   tl, tr                     : tree ;
+   tl, tr, condition          : tree ;
    location                   : location_t ;
    left, right, dest, combined,
    leftpos, rightpos, destpos : CARDINAL ;
@@ -7770,8 +8350,8 @@ BEGIN
                                                     SkipType (GetType (right)),
                                                     combined),
                                left, right) ;
-         DoJump (location, BuildEqualTo (location, tl, tr), NIL,
-                 string (CreateLabelName (dest)))
+         condition := BuildEqualTo (location, tl, tr) ;
+         IfExprJump (location, condition, string (CreateLabelName (dest)))
       END
    END
 END PerformCodeIfEqu ;
@@ -7783,7 +8363,7 @@ END PerformCodeIfEqu ;
 
 PROCEDURE PerformCodeIfNotEqu (quad: CARDINAL) ;
 VAR
-   tl, tr                     : tree ;
+   tl, tr, condition          : tree ;
    location                   : location_t ;
    left, right, dest, combined,
    leftpos, rightpos, destpos : CARDINAL ;
@@ -7809,7 +8389,7 @@ BEGIN
    ELSIF IsConstSet (left) OR (IsVar (left) AND IsSet (SkipType (GetType (left)))) OR
          IsConstSet (right) OR (IsVar (right) AND IsSet (SkipType (GetType (right))))
    THEN
-      CodeIfSetNotEqu (left, right, dest)
+      CodeIfSetNotEqu (combined, left, right, dest)
    ELSE
       IF IsComposite (GetType (left)) OR IsComposite (GetType (right))
       THEN
@@ -7824,8 +8404,8 @@ BEGIN
                                                     SkipType (GetType (right)),
                                                     combined),
                                 left, right) ;
-         DoJump (location, BuildNotEqualTo (location, tl, tr), NIL,
-                 string (CreateLabelName (dest)))
+         condition := BuildNotEqualTo (location, tl, tr) ;
+         IfExprJump (location, condition, string (CreateLabelName (dest)))
       END
    END
 END PerformCodeIfNotEqu ;
@@ -7938,207 +8518,205 @@ END BuildIfVarInConstValue ;
    BuildIfNotVarInConstValue - if not (var in constsetvalue) then goto trueexit
 *)
 
-PROCEDURE BuildIfNotVarInConstValue (quad: CARDINAL; constsetvalue: PtrToValue; var, trueexit: CARDINAL) ;
+PROCEDURE BuildIfNotVarInConstValue (location: location_t; tokenno: CARDINAL;
+                                     quad: CARDINAL;
+                                     constsetvalue: PtrToValue;
+                                     var, trueexit: CARDINAL) ;
 VAR
-   vt, lt, ht  : tree ;
+   vt, lt, ht   : tree ;
    type,
-   low, high, n: CARDINAL ;
+   low, high, n : CARDINAL ;
    falselabel,
-   truelabel   : String ;
-   location    : location_t ;
+   truelabel    : String ;
 BEGIN
-   location := TokenToLocation(CurrentQuadToken) ;
-
-   truelabel := string(CreateLabelName(trueexit)) ;
+   truelabel := string (CreateLabelName (trueexit)) ;
    n := 1 ;
-   WHILE GetRange(constsetvalue, n, low, high) DO
-      INC(n)
+   WHILE GetRange (constsetvalue, n, low, high) DO
+      INC (n)
    END ;
    IF n=2
    THEN
-      (* actually only one set range, so we invert it *)
-      type := MixTypes3(low, high, var, CurrentQuadToken) ;
-      ConvertBinaryOperands(location, vt, lt, type, var, low) ;
-      ConvertBinaryOperands(location, ht, lt, type, high, low) ;
-      BuildIfNotInRangeGoto(location, vt, lt, ht, truelabel)
+      (* Only one set range, so we invert it *)
+      type := MixTypes3 (low, high, var, tokenno) ;
+      ConvertBinaryOperands (location, vt, lt, type, var, low) ;
+      ConvertBinaryOperands (location, ht, lt, type, high, low) ;
+      BuildIfNotInRangeGoto (location, vt, lt, ht, truelabel)
    ELSE
       n := 1 ;
-      falselabel := string(Sprintf1(Mark(InitString('.Lset%d')), quad)) ;
-      WHILE GetRange(constsetvalue, n, low, high) DO
-         type := MixTypes3(low, high, var, CurrentQuadToken) ;
-         ConvertBinaryOperands(location, vt, lt, type, var, low) ;
-         ConvertBinaryOperands(location, ht, lt, type, high, low) ;
-         BuildIfInRangeGoto(location, vt, lt, ht, falselabel) ;
-         INC(n)
+      falselabel := string (Sprintf1 (Mark (InitString ('.Lset%d')), quad)) ;
+      WHILE GetRange (constsetvalue, n, low, high) DO
+         type := MixTypes3 (low, high, var, tokenno) ;
+         ConvertBinaryOperands (location, vt, lt, type, var, low) ;
+         ConvertBinaryOperands (location, ht, lt, type, high, low) ;
+         BuildIfInRangeGoto (location, vt, lt, ht, falselabel) ;
+         INC (n)
       END ;
-      BuildGoto(location, truelabel) ;
-      DeclareLabel(location, falselabel)
+      BuildGoto (location, truelabel) ;
+      DeclareLabel (location, falselabel)
    END
 END BuildIfNotVarInConstValue ;
 
 
 (*
-   PerformCodeIfIn - code the quadruple: if op1 in op2 then goto op3
+    SetWideIfIn - if M2WIDESET.In (set, element) then goto branch end.
 *)
 
-PROCEDURE PerformCodeIfIn (quad: CARDINAL) ;
+PROCEDURE SetWideIfIn (location: location_t; tokenno: CARDINAL;
+                       invertCondition: BOOLEAN;
+                       settype, element, set: CARDINAL; branch: CARDINAL) ;
 VAR
-   low,
-   high    : CARDINAL ;
-   lowtree,
-   hightree,
-   offset  : tree ;
-   fieldno : INTEGER ;
-   location                   : location_t ;
-   left, right, dest, combined,
-   leftpos, rightpos, destpos : CARDINAL ;
-   constExpr, overflow        : BOOLEAN ;
-   op                         : QuadOperator ;
+   label    : String ;
+   bit, call,
+   expr,
+   setarray : tree ;
+   setparam,
+   procedure: CARDINAL ;
 BEGIN
-   (* Ensure that any remaining undeclared constant literal is declared.  *)
-   GetQuadOtok (quad, combined, op,
-                left, right, dest,
-                constExpr, overflow,
-                leftpos, rightpos, destpos) ;
-   location := TokenToLocation (combined) ;
-   IF IsConst(left) AND IsConst(right)
+   procedure := FromM2WIDESETImport (tokenno, MakeKey ("In")) ;
+   setparam := GetNthParamAnyClosest (procedure, 1, GetMainModule ()) ;
+   setarray := CreateSetArrayParam (location, tokenno, set, setparam) ;
+   bit := SetElementToBit (location, settype, element) ;
+   BuildParam (location, ToCardinal (location, bit)) ;
+   BuildParam (location, setarray) ;
+   call := BuildProcedureCallTree (location,
+                                   Mod2Gcc (procedure),
+                                   Mod2Gcc (GetType (procedure))) ;
+   SetLastFunction (NIL) ;
+   label := CreateLabelName (branch) ;
+   IF invertCondition
    THEN
-      InternalError ('should not get to here (if we do we should consider calling FoldIfIn)')
-   ELSIF CheckElementSetTypes (quad)
+      expr := BuildEqualTo (location, call, GetBooleanFalse ())
+   ELSE
+      expr := BuildNotEqualTo (location, call, GetBooleanFalse ())
+   END ;
+   IfExprJump (location, expr, string (label))
+END SetWideIfIn ;
+
+
+(*
+   CodeNarrowIfIn -
+*)
+
+PROCEDURE CodeNarrowIfIn (location: location_t;
+                          settype: CARDINAL; invertCondition: BOOLEAN;
+                          element, set: CARDINAL; branch: CARDINAL) ;
+VAR
+   label, cond,
+   bit, mask, bitset: tree ;
+BEGIN
+   bit := ToBitset (location, SetElementToBit (location, settype, element)) ;
+   mask := BuildMask (location, CalcBitsInSet (location, settype), FALSE) ;
+   (* Mask off only the bits we need.  *)
+   bitset := ToBitset (location, BuildLogicalAnd (location, Mod2Gcc (set), mask)) ;
+   IF invertCondition
    THEN
-      IF IsConst(left)
-      THEN
-         fieldno := GetFieldNo(combined, left, GetType(right), offset) ;
-         IF fieldno>=0
-         THEN
-            PushValue(left) ;
-            PushIntegerTree(offset) ;
-            ConvertToType(GetType(left)) ;
-            Sub ;
-            BuildIfConstInVar(location,
-                              Mod2Gcc(SkipType(GetType(right))),
-                              Mod2Gcc(right), PopIntegerTree(),
-                              GetMode(right)=LeftValue, fieldno,
-                              string(CreateLabelName(dest)))
-         ELSE
-            MetaErrorT1 (combined, 'bit exceeded the range of set {%1Eatd}', left)
-         END
-      ELSIF IsConst(right)
-      THEN
-         (* builds a cascaded list of if statements *)
-         PushValue(right) ;
-         BuildIfVarInConstValue(location, combined, GetValue(combined), left, dest)
-      ELSE
-         GetSetLimits(SkipType(GetType(right)), low, high) ;
-
-         PushValue(low) ;
-         lowtree := PopIntegerTree() ;
-         PushValue(high) ;
-         hightree := PopIntegerTree() ;
-
-         BuildIfVarInVar(location,
-                         Mod2Gcc(SkipType(GetType(right))),
-                         Mod2Gcc(right), Mod2Gcc(left),
-                         GetMode(right)=LeftValue,
-                         lowtree, hightree,
-                         string(CreateLabelName(dest)))
-      END
-   END
-END PerformCodeIfIn ;
+      cond := BuildIfNotInSet (location, bitset, bit)
+   ELSE
+      cond := BuildIfInSet (location, bitset, bit)
+   END ;
+   label := CreateLabelName (branch) ;
+   IfExprJump (location, cond, string (label))
+END CodeNarrowIfIn ;
 
 
 (*
-   PerformCodeIfNotIn - code the quadruple: if not (op1 in op2) then goto op3
+   CodeIfInLower - code the quadruple: if element in set then goto branch.
+                   The invertCondition can be set to TRUE to handle CodeIfNotIn.
 *)
 
-PROCEDURE PerformCodeIfNotIn (quad: CARDINAL) ;
+PROCEDURE CodeIfInLower (tokenno: CARDINAL; quad: CARDINAL;
+                         invertCondition: BOOLEAN;
+                         element, set, branch: CARDINAL) ;
 VAR
-   low,
-   high    : CARDINAL ;
-   lowtree,
-   hightree,
-   offset  : tree ;
-   fieldno : INTEGER ;
-   location                   : location_t ;
-   left, right, dest, combined,
-   leftpos, rightpos, destpos : CARDINAL ;
-   constExpr, overflow        : BOOLEAN ;
-   op                         : QuadOperator ;
+   settype      : CARDINAL ;
+   location     : location_t ;
+   constsetvalue: PtrToValue ;
 BEGIN
-   (* Ensure that any remaining undeclared constant literal is declared.  *)
-   GetQuadOtok (quad, combined, op,
-                left, right, dest,
-                overflow, constExpr,
-                leftpos, rightpos, destpos) ;
-   location := TokenToLocation (combined) ;
-   IF IsConst(left) AND IsConst(right)
+   location := TokenToLocation (tokenno) ;
+   (* Firstly ensure that any constant literal is declared.  *)
+   DeclareConstant (tokenno, set) ;
+   DeclareConstant (tokenno, element) ;
+   DeclareConstructor (tokenno, quad, set) ;
+   DeclareConstructor (tokenno, quad, element) ;
+   checkDeclare (set) ;
+   checkDeclare (element) ;
+   settype := GetLType (set) ;
+
+   IF IsConst (element) AND IsConst (set)
    THEN
       InternalError ('should not get to here (if we do we should consider calling FoldIfIn)')
    ELSIF CheckElementSetTypes (quad)
    THEN
-      IF IsConst(left)
+      IF IsConst (set)
       THEN
-         fieldno := GetFieldNo(combined, left, SkipType(GetType(right)), offset) ;
-         IF fieldno>=0
+         PushValue (set) ;
+         constsetvalue := GetValue (tokenno) ;
+         IF invertCondition
          THEN
-            PushValue(left) ;
-            PushIntegerTree(offset) ;
-            ConvertToType(GetType(left)) ;
-            Sub ;
-            BuildIfNotConstInVar(location,
-                                 Mod2Gcc(SkipType(GetType(right))),
-                                 Mod2Gcc(right), PopIntegerTree(),
-                                 GetMode(right)=LeftValue, fieldno,
-                                 string(CreateLabelName(dest)))
+            (* Builds a cascaded list of if statements.  *)
+            BuildIfNotVarInConstValue (location, tokenno, quad, constsetvalue, element, branch)
          ELSE
-            MetaErrorT1 (combined, 'bit exceeded the range of set {%1Eatd}', right)
+            (* Builds a very different cascaded list of if statements.  *)
+            BuildIfVarInConstValue (location, tokenno, constsetvalue, element, branch)
          END
-      ELSIF IsConst(right)
-      THEN
-         (* builds a cascaded list of if statements *)
-         PushValue(right) ;
-         BuildIfNotVarInConstValue(quad, GetValue(combined), left, dest)
       ELSE
-         GetSetLimits(SkipType(GetType(right)), low, high) ;
-
-         PushValue(low) ;
-         lowtree := PopIntegerTree() ;
-         PushValue(high) ;
-         hightree := PopIntegerTree() ;
-
-         BuildIfNotVarInVar(location,
-                            Mod2Gcc(SkipType(GetType(right))),
-                            Mod2Gcc(right), Mod2Gcc(left),
-                            GetMode(right)=LeftValue,
-                            lowtree, hightree,
-                            string(CreateLabelName(dest)))
+         Assert (IsVar (set)) ;
+         IF IsElementInRange (tokenno, settype, set, element)
+         THEN
+            (* Check for narrow and wide sets and call M2WIDESET if appropriate.  *)
+            IF GetSetInWord (settype)
+            THEN
+               CodeNarrowIfIn (location, settype, invertCondition, element, set, branch)
+            ELSE
+               SetWideIfIn (location, tokenno, invertCondition, settype, element, set, branch)
+            END
+         END
       END
    END
-END PerformCodeIfNotIn ;
+END CodeIfInLower ;
+
+
+(*
+   PerformCodeIfIn -
+*)
+
+PROCEDURE PerformCodeIfIn (quad: CARDINAL; invert: BOOLEAN) ;
+VAR
+   op                            : QuadOperator ;
+   element, set, branch, combined,
+   elementpos, setpos, destpos   : CARDINAL ;
+   constExpr, overflow           : BOOLEAN ;
+BEGIN
+   GetQuadOtok (quad, combined, op,
+                element, set, branch,
+                overflow, constExpr,
+                elementpos, setpos, destpos) ;
+   CodeIfInLower (combined, quad, invert, element, set, branch)
+END PerformCodeIfIn ;
 
 
 (*
-   CodeIfIn - code the quadruple: if op1 in op2 then goto op3
+   CodeIfIn - code the quadruple: if element in set then goto branch.
 *)
 
 PROCEDURE CodeIfIn (quad: CARDINAL) ;
 BEGIN
    IF IsValidExpressionRelOp (quad, TRUE)
    THEN
-      PerformCodeIfIn (quad)
+      PerformCodeIfIn (quad, FALSE)
    END
 END CodeIfIn ;
 
 
 (*
-   CodeIfNotIn - code the quadruple: if not (op1 in op2) then goto op3
+   CodeIfNotIn - code the quadruple: if not (element in set) then goto branch.
 *)
 
 PROCEDURE CodeIfNotIn (quad: CARDINAL) ;
 BEGIN
    IF IsValidExpressionRelOp (quad, TRUE)
    THEN
-      PerformCodeIfNotIn (quad)
+      PerformCodeIfIn (quad, TRUE)
    END
 END CodeIfNotIn ;
 
@@ -8293,10 +8871,66 @@ BEGIN
 END InitBuiltinSyms ;
 
 
+(*
+   gdbhook - a debugger convenience hook.
+*)
+
+PROCEDURE gdbhook ;
+END gdbhook ;
+
+
+(*
+   BreakWhenQuadTranslated - to be called interactively by gdb.
+*)
+
+PROCEDURE BreakWhenQuadTranslated (quad: CARDINAL) ;
+BEGIN
+   BreakQuad := quad
+END BreakWhenQuadTranslated ;
+
+
+(*
+   CheckBreak - if quad = BreakQuad then call gdbhook.
+*)
+
+PROCEDURE CheckBreak (quad: CARDINAL) ;
 BEGIN
+   IF quad = BreakQuad
+   THEN
+      gdbhook
+   END
+END CheckBreak ;
+
+
+(*
+   Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+   (* You might want to add the option -fm2-debug-trace=quad to cc1gm2 if
+      contenplating interactively debugging cc1gm2 using the scheme below.  *)
+   BreakWhenQuadTranslated (0) ;  (* Disable the interactive quad watch.  *)
+   (* To examine when a quad is about to be converted into a gimple tree
+      run cc1gm2 from gdb and set a break point on gdbhook.
+      (gdb) break gdbhook
+      (gdb) run
+      Now below interactively call BreakWhenQuadTranslated with the quad
+      under investigation.  *)
+   gdbhook ;
+   (* Now is the time to interactively call gdb, for example:
+      (gdb) print BreakWhenQuadTranslated (1234)
+      (gdb) cont
+      and you will arrive at gdbhook when this quad is about to be translated.  *)
    Memset := NulSym ;
    Memcpy := NulSym ;
    UnboundedLabelNo := 0 ;
    CurrentQuadToken := 0 ;
+   SetTemporaryNo := 0 ;
    ScopeStack := InitStackWord ()
+END Init ;
+
+
+BEGIN
+   Init
 END M2GenGCC.
diff --git a/gcc/m2/gm2-compiler/M2MetaError.def b/gcc/m2/gm2-compiler/M2MetaError.def
index 3dfe9fa01b4..8c660ad7cea 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.def
+++ b/gcc/m2/gm2-compiler/M2MetaError.def
@@ -43,7 +43,8 @@ FROM NameKey IMPORT Name ;
     {%1Td}    get the type of the first symbol and describe it.
     {%1Sd}    skip the type pseudonyms of the first symbol and describe it.
     {%1ua}    force no quotes after substituting the text.
-
+    {%1av}    check name for starting with a vowel and if so append n to the
+              previous word.
     {%1D}     sets the error message to where symbol 1 was declared.
               The declaration will choose the definition module, then
               implementation (or program) module.
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod
index 3aa7543231d..5b8aafec4aa 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -44,7 +44,8 @@ FROM Indexing IMPORT Index, InitIndex, KillIndex, GetIndice, PutIndice,
 
 FROM DynamicStrings IMPORT String, InitString, InitStringCharStar,
                            ConCat, ConCatChar, Mark, string, KillString,
-                           Dup, char, Length, Mult, EqualArray, Equal ;
+                           Dup, char, Length, Mult, EqualArray, Equal,
+                           RemoveWhitePostfix ;
 
 FROM SymbolTable IMPORT NulSym,
                         IsDefImp, IsModule, IsInnerModule,
@@ -88,6 +89,7 @@ TYPE
                    highplus1 : CARDINAL ;
                    len,
                    ini       : INTEGER ;
+                   vowel,
                    glyph,
                    chain,
                    root,
@@ -507,13 +509,14 @@ BEGIN
    WITH eb DO
       useError   := TRUE ;
       e          := NIL ;
-      type       := error ;  (* default to the error color.  *)
+      type       := error ;  (* Default to the error color.  *)
       out        := InitString ('') ;
       in         := input ;
       highplus1  := HIGH (sym) + 1 ;
       len        := Length (input) ;
       ini        := 0 ;
-      glyph      := FALSE ;  (* nothing to output yet.  *)
+      glyph      := FALSE ;  (* Nothing to output yet.  *)
+      vowel      := FALSE ;  (* Check for a vowel when outputing string?  *)
       quotes     := TRUE ;
       positive   := TRUE ;
       root       := FALSE ;
@@ -542,7 +545,7 @@ END push ;
 
 
 (*
-   pop - copies contents of oldblock into newblock.  It only copies the error
+   pop - copies contents of fromblock into toblock.  It only copies the error
          handle if the toblock.e is NIL.
 *)
 
@@ -550,6 +553,7 @@ PROCEDURE pop (VAR toblock, fromblock: errorBlock) ;
 VAR
    c: colorType ;
 BEGIN
+   checkVowel (toblock, fromblock) ;
    IF empty (fromblock)
    THEN
       toblock.stackPtr := fromblock.stackPtr ;
@@ -708,7 +712,7 @@ END killErrorBlock ;
                        )
                  =:
 
-   op := {'a'|'q'|'t'|'d'|'n'|'s'|'B'|'D'|'F'|'G'|'H'|'M'|'U'|'E'|'V'|'W'|'A'} then =:
+   op := {'a'|'q'|'t'|'d'|'n'|'s'|'v'|'B'|'D'|'F'|'G'|'H'|'M'|'U'|'E'|'V'|'W'|'A'} then =:
 
    then := [ ':' ebnf ] =:
 *)
@@ -972,6 +976,38 @@ BEGIN
 END empty ;
 
 
+(*
+   checkVowel - checks to see if the from block word starts with
+                a vowel and if so adds an n to the to block output.
+*)
+
+PROCEDURE checkVowel (VAR to: errorBlock; from: errorBlock) ;
+BEGIN
+   IF from.vowel AND (NOT empty (from))
+   THEN
+      IF isVowel (char (from.out, 0))
+      THEN
+         IF Length (to.out) > 0
+         THEN
+            to.out := RemoveWhitePostfix (Mark (to.out)) ;
+            to.out := ConCat (to.out, Mark (InitString ('n '))) ;
+            from.vowel := FALSE
+         END
+      END
+   END
+END checkVowel ;
+
+
+(*
+   isVowel - returns TRUE if ch is a, e, i, o or u.
+*)
+
+PROCEDURE isVowel (ch: CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch = 'a') OR (ch = 'e') OR (ch = 'i') OR (ch = 'o') OR (ch = 'u')
+END isVowel ;
+
+
 (*
    clear - remove the output string.
 *)
@@ -1624,7 +1660,7 @@ BEGIN
       RETURN InitString('set')
    ELSIF IsUnknown(sym)
    THEN
-      RETURN InitString('an unknown')
+      RETURN InitString('unknown')
    ELSIF IsSubrange(sym)
    THEN
       RETURN InitString('subrange')
@@ -1676,7 +1712,7 @@ END copySym ;
 
 
 (*
-   op := {'!'|'a'|'c'|'d'|'k'|'n'|'p'|'q'|'s'|'t'|'u'|
+   op := {'!'|'a'|'c'|'d'|'k'|'n'|'p'|'q'|'s'|'t'|'u'|'v'|
           'A'|'B'|'C'|'D'|'E'|'F'|'G'|'H'|'K'|'M'|'N'|
           'O'|'P'|'Q'|'R'|'S'|'T'|'U'|'V'|'W'|'X'|'Y'|'Z'} then =:
 *)
@@ -1705,6 +1741,7 @@ BEGIN
       's':  doSkipType (eb, sym, bol) |
       't':  doType (eb, sym, bol) |
       'u':  eb.quotes := FALSE |
+      'v':  eb.vowel := TRUE |
       'A':  eb.type := aborta ;
             seenAbort := TRUE |
       'B':  declaredType (eb, sym, bol) |
diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def
index 4cb7f8f483e..59b59244363 100644
--- a/gcc/m2/gm2-compiler/M2Options.def
+++ b/gcc/m2/gm2-compiler/M2Options.def
@@ -55,9 +55,10 @@ VAR
    StyleChecking,                (* -Wstudents checks for common student errs*)
    UnboundedByReference,         (* -funbounded-by-reference                 *)
    VerboseUnbounded,             (* -Wverbose-unbounded                      *)
-   OptimizeUncalledProcedures,   (* -Ouncalled removes uncalled procedures   *)
-   OptimizeBasicBlock,           (* -Obb create basic blocks and optimize.   *)
-   OptimizeCommonSubExpressions, (* -Ocse optimize common subexpressions     *)
+   OptimizeUncalledProcedures,   (* Removes uncalled procedures?             *)
+   OptimizeBasicBlock,           (* Create basic blocks and optimize?        *)
+   OptimizeCommonSubExpressions, (* Optimize common subexpressions?          *)
+   OptimizeSets,                 (* TRUE if -On when n>0.  False for -Os.    *)
    WholeProgram,                 (* -fwhole-program optimization.            *)
    NilChecking,                  (* -fnil makes compiler test for pointer    *)
                                  (* NIL.                                     *)
@@ -115,6 +116,7 @@ VAR
    SharedFlag,                   (* -fshared indicating this module needs    *)
                                  (* the shared library version of the        *)
                                  (* scaffold.                                *)
+   TimeReport, MemReport,        (* -ftime-report and -fmem-report values.   *)
    ForcedLocation,
    GenerateStatementNote,
    Optimizing,
@@ -1165,6 +1167,34 @@ PROCEDURE SetFileOffsetBits (value: BOOLEAN; bits: CARDINAL) : BOOLEAN ;
 PROCEDURE GetFileOffsetBits () : CARDINAL ;
 
 
+(*
+   SetMemReport - set MemReport to value.
+*)
+
+PROCEDURE SetMemReport (value: BOOLEAN) ;
+
+
+(*
+   SetTimeReport - set TimeReport to value.
+*)
+
+PROCEDURE SetTimeReport (value: BOOLEAN) ;
+
+
+(*
+   SetWideset - set the Wideset flag to value.
+*)
+
+PROCEDURE SetWideset (value: BOOLEAN) ;
+
+
+(*
+   GetWideset - return the Wideset flag value.
+*)
+
+PROCEDURE GetWideset () : BOOLEAN ;
+
+
 (*
    FinaliseOptions - once all options have been parsed we set any inferred
                      values.
diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod
index 542b87b12d2..cde3c36b035 100644
--- a/gcc/m2/gm2-compiler/M2Options.mod
+++ b/gcc/m2/gm2-compiler/M2Options.mod
@@ -85,6 +85,7 @@ VAR
    DumpDecl,         (* -fm2-dump=decl.  *)
    DumpGimple,       (* -fm2-dump=gimple.  *)
    DumpQuad,         (* -fq, -fm2-dump=quad dump quadruples.  *)
+   WidesetFlag,      (* -fwideset.  *)
    MFlag,
    MMFlag,
    MPFlag,
@@ -1326,12 +1327,14 @@ BEGIN
       Optimizing := TRUE ;
       OptimizeBasicBlock := TRUE ;
       OptimizeUncalledProcedures := TRUE ;
-      OptimizeCommonSubExpressions := TRUE
+      OptimizeCommonSubExpressions := TRUE ;
+      OptimizeSets := TRUE
    ELSE
       Optimizing := FALSE ;
       OptimizeBasicBlock := FALSE ;
       OptimizeUncalledProcedures := FALSE ;
-      OptimizeCommonSubExpressions := FALSE
+      OptimizeCommonSubExpressions := FALSE ;
+      OptimizeSets := FALSE
    END
 END SetOptimizing ;
 
@@ -2074,6 +2077,46 @@ BEGIN
 END GetFileOffsetBits ;
 
 
+(*
+   SetMemReport - set MemReport to value.
+*)
+
+PROCEDURE SetMemReport (value: BOOLEAN) ;
+BEGIN
+   MemReport := value
+END SetMemReport ;
+
+
+(*
+   SetTimeReport - set TimeReport to value.
+*)
+
+PROCEDURE SetTimeReport (value: BOOLEAN) ;
+BEGIN
+   TimeReport := value
+END SetTimeReport ;
+
+
+(*
+   SetWideset - set the Wideset flag to value.
+*)
+
+PROCEDURE SetWideset (value: BOOLEAN) ;
+BEGIN
+   WidesetFlag := value
+END SetWideset ;
+
+
+(*
+   GetWideset - return the Wideset flag value.
+*)
+
+PROCEDURE GetWideset () : BOOLEAN ;
+BEGIN
+   RETURN WidesetFlag
+END GetWideset ;
+
+
 BEGIN
    cflag                             := FALSE ;  (* -c.  *)
    RuntimeModuleOverride             := InitString (DefaultRuntimeModuleOverride) ;
@@ -2099,6 +2142,7 @@ BEGIN
    OptimizeBasicBlock                := FALSE ;
    OptimizeUncalledProcedures        := FALSE ;
    OptimizeCommonSubExpressions      := FALSE ;
+   OptimizeSets                      := FALSE ;
    NilChecking                       := FALSE ;
    WholeDivChecking                  := FALSE ;
    WholeValueChecking                := FALSE ;
@@ -2168,6 +2212,9 @@ BEGIN
    DumpGimple                        := FALSE ;
    M2Dump                            := NIL ;
    M2DumpFilter                      := NIL ;
+   TimeReport                        := FALSE ;
+   MemReport                         := FALSE ;
    EnableForward                     := TRUE ;
    OffTBits                          := 0 ;  (* Default to CSSIZE_T.  *)
+   WidesetFlag                       := TRUE ;
 END M2Options.
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 748ce2498db..9489bd8d114 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -57,6 +57,8 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
                         MakeConstString, MakeConstant, MakeConstVar,
                         MakeConstStringM2nul, MakeConstStringCnul,
                         Make2Tuple, IsTuple,
+                        MakeSubrange, PutSubrange,
+                        PutSetArray, MakeSetArray,
                         RequestSym, MakePointer, PutPointer,
                         SkipType,
 			GetDType, GetSType, GetLType,
@@ -109,6 +111,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
                         IsFieldEnumeration,
                         IsVar, IsProcType, IsType, IsSubrange, IsExported,
                         IsConst, IsConstString, IsModule, IsDefImp,
+                        IsConstVar,
                         IsArray, IsUnbounded, IsProcedureNested,
                         IsParameterUnbounded,
                         IsPartialUnbounded, IsProcedureBuiltin,
@@ -150,7 +153,8 @@ FROM M2Batch IMPORT MakeDefinitionSource ;
 FROM M2GCCDeclare IMPORT PutToBeSolvedByQuads ;
 
 FROM FifoQueue IMPORT GetConstFromFifoQueue,
-                      PutConstructorIntoFifoQueue, GetConstructorFromFifoQueue ;
+                      PutConstructorIntoFifoQueue, GetConstructorFromFifoQueue,
+                      GetSetFromFifoQueue ;
 
 FROM M2Comp IMPORT CompilingImplementationModule,
                    CompilingProgramModule ;
@@ -280,6 +284,8 @@ FROM M2CaseList IMPORT PushCase, PopCase, AddRange, BeginCaseList, EndCaseList,
 FROM PCSymBuild IMPORT SkipConst ;
 FROM m2builtins IMPORT GetBuiltinTypeInfoType ;
 FROM M2LangDump IMPORT IsDumpRequired ;
+FROM SymbolConversion IMPORT GccKnowsAbout ;
+FROM M2Diagnostic IMPORT Diagnostic, InitMemDiagnostic, MemIncr, MemSet ;
 
 IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO ;
 
@@ -399,6 +405,7 @@ VAR
                                       (* in order.                               *)
    NoOfQuads            : CARDINAL ;  (* Number of used quadruples.              *)
    Head                 : CARDINAL ;  (* Head of the list of quadruples.         *)
+   QuadMemDiag          : Diagnostic ;  (* Contains memory related statistics.   *)
    BreakQuad            : CARDINAL ;  (* Stop when BreakQuad is created.         *)
 
 
@@ -2063,7 +2070,9 @@ BEGIN
       ELSE
          INC (NoOfQuads) ;
          PutIndice (QuadArray, QuadNo, f) ;
-         f^.NoOfTimesReferenced := 0
+         f^.NoOfTimesReferenced := 0 ;
+         MemSet (QuadMemDiag, 1, NoOfQuads) ;
+         MemIncr (QuadMemDiag, 2, SIZE (f^))
       END
    END ;
    WITH f^ DO
@@ -3404,7 +3413,7 @@ BEGIN
    IF IsPseudoBaseProcedure (expr) OR IsPseudoBaseFunction (expr)
    THEN
       MetaErrorT1 (exprtok,
-                  'an assignment cannot assign a {%1d} {%1a}', expr)
+                  'an assignment cannot assign a {%1dv} {%1a}', expr)
    END
 END CheckCompatibleWithBecomes ;
 
@@ -3812,25 +3821,24 @@ END BuildAssignConstant ;
 
 
 (*
-   doBuildAssignment - subsiduary procedure of BuildAssignment.
-                       It builds the assignment and optionally
-                       checks the types are compatible.
+   BuildAssignmentBoolean - build the quadruples for a boolean variable or constant
+                            which will be assigned to the result of a boolean expression.
+                            For example:
+
+                            foo := a = b ;
+                            foo := a IN b ;
+
+                            The boolean result is contained in the control flow
+                            the true value will emerge from the quad path t.
+                            The false value will emerge from the quad path f.
+                            This procedure terminates both paths by backpatching
+                            and assigns TRUE or FALSE to the variable/constant.
+                            A variable maybe an L value so it will require dereferencing.
 *)
 
-PROCEDURE doBuildAssignment (becomesTokNo: CARDINAL; checkTypes, checkOverflow: BOOLEAN) ;
-VAR
-   r, w,
-   t, f,
-   Array,
-   Des, Exp      : CARDINAL ;
-   combinedtok,
-   destok, exptok: CARDINAL ;
+PROCEDURE BuildAssignmentBoolean (becomesTokNo: CARDINAL; checkTypes, checkOverflow: BOOLEAN;
+                                  t, f: CARDINAL; Des: CARDINAL; destok: CARDINAL) ;
 BEGIN
-   DisplayStack ;
-   IF IsBoolean (1)
-   THEN
-      PopBool (t, f) ;
-      PopTtok (Des, destok) ;
       PutVarConditional (Des, TRUE) ;  (* Des will contain the result of a boolean relop.  *)
       (* Conditional Boolean Assignment.  *)
       BackPatch (t, NextQuad) ;
@@ -3852,6 +3860,36 @@ BEGIN
       ELSE
          GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, False, checkOverflow)
       END
+END BuildAssignmentBoolean ;
+
+
+(*
+   doBuildAssignment - subsiduary procedure of BuildAssignment.
+                       It builds the assignment and optionally
+                       checks the types are compatible.
+*)
+
+PROCEDURE doBuildAssignment (becomesTokNo: CARDINAL; checkTypes, checkOverflow: BOOLEAN) ;
+VAR
+   r, w,
+   t, f,
+   Array,
+   Des, Exp      : CARDINAL ;
+   combinedtok,
+   destok, exptok: CARDINAL ;
+BEGIN
+   DisplayStack ;
+   IF IsBoolean (1)
+   THEN
+      PopBool (t, f) ;
+      PopTtok (Des, destok) ;
+      IF IsVar (Des) OR IsConstVar (Des)
+      THEN
+         BuildAssignmentBoolean (becomesTokNo, checkTypes, checkOverflow,
+                                 t, f, Des, destok)
+      ELSE
+         MetaErrorT1 (destok, 'expecting the designator {%1Ead} to be a constant or a variable and not a {%1dv}', Des)
+      END
    ELSE
       PopTrwtok (Exp, r, exptok) ;
       MarkAsRead (r) ;
@@ -5795,8 +5833,8 @@ BEGIN
          WHILE i<=n DO
             IF IsVarParamAny (ProcType, i) # IsVarParamAny (CheckedProcedure, i)
             THEN
-               MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', ProcType, GetNth (ProcType, i), i) ;
-               MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', call, GetNth (call, i), i)
+            MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2dv}', ProcType, GetNth (ProcType, i), i) ;
+            MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2dv}', call, GetNth (call, i), i)
             END ;
             BuildRange (InitTypesParameterCheck (tokno, CheckedProcedure, i,
                                                  GetNthParamAnyClosest (CheckedProcedure, i, GetCurrentModule ()),
@@ -7863,9 +7901,9 @@ BEGIN
          (* Error issue message and fake return stack.  *)
          IF Iso
          THEN
-            MetaErrorT0 (functok, 'the only functions permissible in a constant expression are: {%kCAP}, {%kCHR}, {%kCMPLX}, {%kFLOAT}, {%kHIGH}, {%kIM}, {%kLENGTH}, {%kMAX}, {%kMIN}, {%kODD}, {%kORD}, {%kRE}, {%kSIZE}, {%kTSIZE}, {%kTRUNC}, {%kVAL} and gcc builtins')
+            MetaErrorT0 (functok, 'the only functions permissible in a constant expression are: {%kCAP}, {%kCHR}, {%kCMPLX}, {%kFLOAT}, {%kHIGH}, {%kIM}, {%kLENGTH}, {%kMAX}, {%kMIN}, {%kODD}, {%kORD}, {%kRE}, {%kSIZE}, {%kTSIZE}, {%kTBITSIZE}, {%kTRUNC}, {%kVAL} and gcc builtins')
          ELSE
-            MetaErrorT0 (functok, 'the only functions permissible in a constant expression are: {%kCAP}, {%kCHR}, {%kFLOAT}, {%kHIGH}, {%kMAX}, {%kMIN}, {%kODD}, {%kORD}, {%kSIZE}, {%kTSIZE}, {%kTRUNC}, {%kVAL} and gcc builtins')
+            MetaErrorT0 (functok, 'the only functions permissible in a constant expression are: {%kCAP}, {%kCHR}, {%kFLOAT}, {%kHIGH}, {%kMAX}, {%kMIN}, {%kODD}, {%kORD}, {%kSIZE}, {%kTSIZE}, {%kTRUNC}, {%kTBITSIZE}, {%kVAL} and gcc builtins')
          END ;
 	 IF NoOfParam > 0
 	 THEN
@@ -8212,7 +8250,7 @@ BEGIN
             PushTFtok (ReturnVar, Address, combinedtok)
          ELSE
             MetaErrorT1 (functok,
-                         'the first parameter to ADDADR {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
+                         'the first parameter to ADDADR {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsdv}',
                          VarSym) ;
             PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address), Address, combinedtok)
          END
@@ -8295,7 +8333,7 @@ BEGIN
             PushTFtok (ReturnVar, Address, combinedtok)
          ELSE
             MetaErrorT1 (functok,
-                         'the first parameter to {%EkSUBADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
+                         'the first parameter to {%EkSUBADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsdv}',
                          VarSym) ;
             PushTFtok (MakeConstLit (vartok, MakeKey('0'), Address), Address, vartok)
          END
@@ -8394,13 +8432,13 @@ BEGIN
                PushT (2) ;          (* Two parameters *)
                BuildConvertFunction (Convert, ConstExpr)
             ELSE
-               MetaError1 ('the second parameter to {%EkDIFADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
+               MetaError1 ('the second parameter to {%EkDIFADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsdv}',
                            OperandSym) ;
                PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Integer), Integer, combinedtok)
             END
          ELSE
             MetaErrorT1 (vartok,
-                         'the first parameter to {%EkDIFADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
+                         'the first parameter to {%EkDIFADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsdv}',
                          VarSym) ;
             PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Integer), Integer, combinedtok)
          END
@@ -8615,7 +8653,7 @@ BEGIN
    IF ConstExpr AND IsVar (Var)
    THEN
       MetaErrorT2 (optok,
-                   'the procedure function {%1Ea} is being called from within a constant expression and therefore the parameter {%2a} must be a constant, seen a {%2da}',
+                   'the procedure function {%1Ea} is being called from within a constant expression and therefore the parameter {%2a} must be a constant, seen a {%2dav}',
                    Func, Var) ;
       RETURN TRUE
    ELSE
@@ -9352,7 +9390,8 @@ BEGIN
       PopTtok (varSet, vartok) ;
       PopT (procSym) ;
       combinedtok := MakeVirtualTok (functok, functok, exptok) ;
-      IF (GetSType (varSet) # NulSym) AND IsSet (GetDType (varSet))
+      IF (GetSType (varSet) # NulSym)
+         AND (IsSet (GetDType (varSet)) OR IsGenericSystemType (GetDType (varSet)))
       THEN
          derefExp := DereferenceLValue (exptok, Exp) ;
          BuildRange (InitShiftCheck (varSet, derefExp)) ;
@@ -9427,7 +9466,8 @@ BEGIN
       MarkAsRead (r) ;
       PopTtok (varSet, vartok) ;
       PopT (procSym) ;
-      IF (GetSType (varSet) # NulSym) AND IsSet (GetDType (varSet))
+      IF (GetSType (varSet) # NulSym)
+         AND (IsSet (GetDType (varSet)) OR IsGenericSystemType (GetDType (varSet)))
       THEN
          combinedtok := MakeVirtualTok (functok, functok, exptok) ;
          derefExp := DereferenceLValue (exptok, Exp) ;
@@ -11609,7 +11649,7 @@ BEGIN
       BuildStaticArray
    ELSE
       MetaErrorT1 (arrayTok,
-                   'can only index static or dynamic arrays, {%1Ead} is not an array but a {%tad}',
+                   'can only index static or dynamic arrays, {%1Ead} is not an array but a {%tadv}',
                    Sym) ;
       BuildDesignatorError ('bad array access')
    END
@@ -11971,7 +12011,7 @@ BEGIN
          MarkAsRead (rw) ;
          BuildDesignatorPointerError (Type1, rw, combinedtok, 'bad opaque pointer dereference')
       ELSE
-         MetaError2 ('{%1Ead} is not a pointer type but a {%2d}', Sym1, Type1) ;
+         MetaError2 ('{%1Ead} is not a pointer type but a {%2dv}', Sym1, Type1) ;
          MarkAsRead (rw) ;
          BuildDesignatorPointerError (Type1, rw, combinedtok, 'bad pointer dereference')
       END
@@ -13065,7 +13105,7 @@ BEGIN
             WarnStringAt (s, OldPos) ;
             s := InitString ('combined') ;
             WarnStringAt (s, OperatorPos) ;
-            (* MetaErrorT1 (GetDeclaredMod (t), 'in binary with a {%1a}', t) *)
+            (* MetaErrorT1 (GetDeclaredMod (t), 'in binary with a {%1av}', t) *)
          END ;
          GenQuadOtok (OperatorPos, MakeOp (NewOp), value, left, right, checkOverflow,
                       OperatorPos, leftpos, rightpos)
@@ -13384,12 +13424,12 @@ BEGIN
    THEN
       MetaErrorsT1 (tokpos,
                     '{%1Ead} expected a variable, procedure, constant or expression',
-                    'and it was declared as a {%1Dd}', sym) ;
+                    'and it was declared as a {%1Ddv}', sym) ;
    ELSIF (type#NulSym) AND IsArray(type)
    THEN
       MetaErrorsT1 (tokpos,
                     '{%1EU} not expecting an array variable as an operand for either comparison or binary operation',
-                    'it was declared as a {%1Dd}', sym)
+                    'it was declared as a {%1Ddv}', sym)
    ELSIF IsConstString (sym) AND IsConstStringKnown (sym) AND (GetStringLength (tokpos, sym) > 1)
    THEN
       MetaErrorT1 (tokpos,
@@ -14014,9 +14054,12 @@ END ds ;
 
 PROCEDURE DisplayQuad (QuadNo: CARDINAL) ;
 BEGIN
+   IF QuadNo # 0
+   THEN
    DSdbEnter ;
    fprintf1 (GetDumpFile (), '%4d  ', QuadNo) ; WriteQuad(QuadNo) ; fprintf0 (GetDumpFile (), '\n') ;
    DSdbExit
+   END
 END DisplayQuad ;
 
 
@@ -14337,7 +14380,11 @@ BEGIN
       THEN
          fprintf0 (GetDumpFile (), '[') ; WriteMode (GetMode (Sym)) ; fprintf0 (GetDumpFile (), ']')
       END ;
-      fprintf1 (GetDumpFile (), '(%d)', Sym)
+      fprintf1 (GetDumpFile (), '(%d)', Sym) ;
+      IF GccKnowsAbout (Sym)
+      THEN
+         fprintf0 (GetDumpFile (), '[gcc]')
+      END
    END
 END WriteOperand ;
 
@@ -16173,6 +16220,10 @@ BEGIN
    InitList(VarientFields) ;
    VarientFieldNo := 0 ;
    NoOfQuads := 0 ;
+   QuadMemDiag
+      := InitMemDiagnostic
+            ('M2Quad:Quadruples',
+            '{0N} total quadruples {1d} consuming {2M} ram {0M} ({2P})')
 END Init ;
 
 
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
index f1516d3a5e5..a51f224727a 100644
--- a/gcc/m2/gm2-compiler/M2Range.mod
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -1978,7 +1978,7 @@ BEGIN
       IF NOT reportedError (r)
       THEN
          MetaErrorT2 (tokenNo,
-                      'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%2tad:of type {%2tad}} are incompatible',
+                      'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1dv}} and expression {%2a} {%2tad:of type {%2tad}} are incompatible',
                       des, expr)
       END ;
       setReported (r)
@@ -2047,7 +2047,7 @@ BEGIN
          ELSE
             MetaErrorT2 (tokenNo,
                          'assignment designator {%1Ea} {%1ta:of type {%1ta}}' +
-                         ' {%1d:is a {%1d}} and expression {%2a}' +
+                         ' {%1d:is a {%1dv}} and expression {%2a}' +
                          ' {%2tad:of type {%2tad}} are incompatible',
                          des, expr)
          END ;
diff --git a/gcc/m2/gm2-compiler/M2Scaffold.mod b/gcc/m2/gm2-compiler/M2Scaffold.mod
index ff8e20f65a3..e337534fcc3 100644
--- a/gcc/m2/gm2-compiler/M2Scaffold.mod
+++ b/gcc/m2/gm2-compiler/M2Scaffold.mod
@@ -580,7 +580,7 @@ BEGIN
    ELSIF ScaffoldDynamic AND (NOT cflag)
    THEN
       MetaErrorT0 (tokenno,
-                   '{%O}dynamic linking enabled but no module ctor list has been created, hint use -fuse-list=filename or -fgen-module-list=-')
+                   '{%O}dynamic module registration enabled but no module ctor list has been created, hint use -fuse-list=filename or -fgen-module-list=-')
    END ;
 
    initFunction := MakeProcedure (tokenno, MakeKey ("_M2_init")) ;
diff --git a/gcc/m2/gm2-compiler/M2SymInit.mod b/gcc/m2/gm2-compiler/M2SymInit.mod
index 6c8912f2c4c..2740395cf86 100644
--- a/gcc/m2/gm2-compiler/M2SymInit.mod
+++ b/gcc/m2/gm2-compiler/M2SymInit.mod
@@ -155,11 +155,16 @@ BEGIN
    printf (" initialized\n") ;
    IF (desc^.type # NulSym) AND IsRecord (desc^.type)
    THEN
-      i := 1 ;
-      n := Indexing.HighIndice (desc^.rec.fieldDesc) ;
-      WHILE i <= n DO
-         PrintSymInit (Indexing.GetIndice (desc^.rec.fieldDesc, i)) ;
-         INC (i)
+      IF desc^.rec.fieldDesc = NIL
+      THEN
+         printf (" record field descriptor has not been initialized yet\n") ;
+      ELSE
+         i := 1 ;
+         n := Indexing.HighIndice (desc^.rec.fieldDesc) ;
+         WHILE i <= n DO
+            PrintSymInit (Indexing.GetIndice (desc^.rec.fieldDesc, i)) ;
+            INC (i)
+         END
       END
    END
 END PrintSymInit ;
diff --git a/gcc/m2/gm2-compiler/M2System.mod b/gcc/m2/gm2-compiler/M2System.mod
index 68ed9dc52ed..d267df9af5c 100644
--- a/gcc/m2/gm2-compiler/M2System.mod
+++ b/gcc/m2/gm2-compiler/M2System.mod
@@ -509,8 +509,8 @@ END IsPseudoSystemFunction ;
 PROCEDURE IsPseudoSystemFunctionConstExpression (sym: CARDINAL) : BOOLEAN ;
 BEGIN
    RETURN(
-          (sym=Size) OR (sym=TSize) OR (sym=Rotate) OR (sym=Shift) OR
-          (Iso AND ((sym=Cast) OR (sym=MakeAdr)))
+          (sym=Size) OR (sym=TSize) OR (sym=TBitSize) OR (sym=Rotate) OR (sym=Shift) OR
+          (Iso AND ((sym=Cast) OR (sym=MakeAdr) OR (sym=TBitSize)))
          )
 END IsPseudoSystemFunctionConstExpression ;
 
diff --git a/gcc/m2/gm2-compiler/NameKey.mod b/gcc/m2/gm2-compiler/NameKey.mod
index 5d68940dc0e..47c8efbd720 100644
--- a/gcc/m2/gm2-compiler/NameKey.mod
+++ b/gcc/m2/gm2-compiler/NameKey.mod
@@ -31,6 +31,7 @@ FROM NumberIO IMPORT WriteCard ;
 FROM StrLib IMPORT StrLen ;
 FROM libc IMPORT strlen ;
 FROM ASCII IMPORT nul ;
+(* FROM M2Diagnostic IMPORT Diagnostic, InitMemDiagnostic, MemIncr, MemDecr, MemSet ; *)
 
 
 TYPE
@@ -50,6 +51,10 @@ VAR
    BinaryTree: NameNode ;
    KeyIndex  : Index ;
    LastIndice: CARDINAL ;
+(*
+   NameKeyTreeMemDiag,
+   NameKeyWordMemDiag: Diagnostic ;
+*)
 
 
 (*
@@ -144,11 +149,19 @@ BEGIN
       IF result=less
       THEN
          NEW(child) ;
-         father^.Left := child
+         father^.Left := child ;
+         (*
+         MemIncr (NameKeyTreeMemDiag, 1, 1) ;
+         MemIncr (NameKeyTreeMemDiag, 2, SIZE (child^))
+         *)
       ELSIF result=greater
       THEN
          NEW(child) ;
-         father^.Right := child
+         father^.Right := child ;
+         (*
+         MemIncr (NameKeyTreeMemDiag, 1, 1) ;
+         MemIncr (NameKeyTreeMemDiag, 2, SIZE (child^))
+         *)
       END ;
       WITH child^ DO
          Right := NIL ;
@@ -161,7 +174,11 @@ BEGIN
       k := LastIndice
    ELSE
       DEALLOCATE(n, higha+1) ;
-      k := child^.Key
+      k := child^.Key ;
+      (*
+      MemDecr (NameKeyWordMemDiag, 1, 1) ;
+      MemDecr (NameKeyWordMemDiag, 2, higha + 1)
+      *)
    END ;
    RETURN( k )
 END DoMakeKey ;
@@ -182,9 +199,13 @@ VAR
 BEGIN
    higha := StrLen(a) ;
    ALLOCATE(p, higha+1) ;
+   (*
+   MemIncr (NameKeyWordMemDiag, 1, 1) ;
+   MemIncr (NameKeyWordMemDiag, 2, higha + 1) ;
+   *)
    IF p=NIL
    THEN
-      HALT      (* out of memory error *)
+      HALT  (* Out of memory error.  *)
    ELSE
       n := p ;
       i := 0 ;
@@ -194,7 +215,6 @@ BEGIN
          INC(p)
       END ;
       p^ := nul ;
-
       RETURN( DoMakeKey(n, higha) )
    END
 END MakeKey ;
@@ -223,7 +243,7 @@ BEGIN
       ALLOCATE(p, higha+1) ;
       IF p=NIL
       THEN
-         HALT      (* out of memory error *)
+         HALT  (* Out of memory error.  *)
       ELSE
          n  := p ;
          pa := a ;
@@ -413,8 +433,18 @@ END CharKey ;
 
 
 BEGIN
+(*
+   NameKeyWordMemDiag
+      := InitMemDiagnostic
+            ('NameKey:Words',
+            '{0N} total words {1d} consuming {2M} ({2P})') ;
+   NameKeyTreeMemDiag
+      := InitMemDiagnostic
+            ('NameKey:Tree',
+            '{0N} total tree nodes {1d} consuming {2M} ({2P})') ;
+*)
    LastIndice := 0 ;
    KeyIndex := InitIndex(1) ;
    NEW(BinaryTree) ;
-   BinaryTree^.Left := NIL
+   BinaryTree^.Left := NIL ;
 END NameKey.
diff --git a/gcc/m2/gm2-compiler/P1SymBuild.mod b/gcc/m2/gm2-compiler/P1SymBuild.mod
index 08a0fc3f9eb..d6c0f2fcdcf 100644
--- a/gcc/m2/gm2-compiler/P1SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P1SymBuild.mod
@@ -914,7 +914,7 @@ BEGIN
          EndBuildForward.  *)
       PutDeclared (tokno, ProcSym)
    ELSE
-      MetaError1 ('expecting a procedure name and symbol {%1Ea} has been declared as a {%1d}', ProcSym) ;
+      MetaError1 ('expecting a procedure name and symbol {%1Ea} has been declared as a {%1dv}', ProcSym) ;
       PushT (ProcSym) ;
       RETURN
    END ;
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod
index 54e624f6492..8efed994df0 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -2589,7 +2589,7 @@ BEGIN
          Field := PutFieldRecord(Record, OperandT(NoOfPragmas*2+NoOfFields+3-i), Type, Varient) ;
          HandleRecordFieldPragmas(Record, Field, NoOfPragmas)
       ELSE
-         MetaErrors2('record field {%1ad} has already been declared inside a {%2Dd} {%2a}',
+         MetaErrors2('record field {%1ad} has already been declared inside a {%2Ddv} {%2a}',
                      'attempting to declare a duplicate record field', fsym, Parent)
       END ;
       (* adjust the location of declaration to the one on the stack (rather than GetTokenNo).  *)
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index 0033d33e446..89a122b9c13 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -1041,7 +1041,8 @@ SilentExpList := SilentConstExpression { "," SilentConstExpression } =:
 
 -- end of the Silent constant rules
 
-SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
+SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType
+         =:
 
 PointerType := "POINTER" "TO"
                               Type
diff --git a/gcc/m2/gm2-compiler/PathName.def b/gcc/m2/gm2-compiler/PathName.def
index 39d9b15bb3a..efd21c694d9 100644
--- a/gcc/m2/gm2-compiler/PathName.def
+++ b/gcc/m2/gm2-compiler/PathName.def
@@ -1,13 +1,25 @@
-DEFINITION MODULE PathName ;
+(* PathName.def maintains a dictionary of named paths.
 
-(*
-    Title      : PathName
-    Author     : Gaius Mulley
-    System     : GNU Modula-2
-    Date       : Wed Feb  8 09:59:46 2023
-    Revision   : $Version$
-    Description: maintains a dictionary of named paths.
-*)
+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/>.  *)
+
+DEFINITION MODULE PathName ;
 
 FROM DynamicStrings IMPORT String ;
 FROM DynamicPath IMPORT PathList ;
diff --git a/gcc/m2/gm2-compiler/PathName.mod b/gcc/m2/gm2-compiler/PathName.mod
index 0ba90240820..e641a4fea42 100644
--- a/gcc/m2/gm2-compiler/PathName.mod
+++ b/gcc/m2/gm2-compiler/PathName.mod
@@ -1,5 +1,4 @@
 (* M2PathName.mod maintain a dictionary of named paths.
-
 Copyright (C) 2023-2025 Free Software Foundation, Inc.
 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
 
diff --git a/gcc/m2/gm2-compiler/SymbolConversion.mod b/gcc/m2/gm2-compiler/SymbolConversion.mod
index c25fe5735d5..dd83b4fa595 100644
--- a/gcc/m2/gm2-compiler/SymbolConversion.mod
+++ b/gcc/m2/gm2-compiler/SymbolConversion.mod
@@ -39,7 +39,7 @@ FROM SYSTEM IMPORT ADDRESS ;
 
 CONST
    USEPOISON = TRUE ;
-   GGCPOISON = 0A5A5A5A5H ;   (* poisoned memory contains this code *)
+   GGCPOISON = 0A5A5A5A5H ;   (* Poisoned memory contains this code.  *)
 
 TYPE
    PtrToCardinal = POINTER TO CARDINAL ;
@@ -47,6 +47,38 @@ TYPE
 VAR
    mod2gcc       : Index ;
    PoisonedSymbol: ADDRESS ;
+   BookSym       : CARDINAL ;     (* Allows interactive debugging.    *)
+
+
+(*
+   gdbhook - a debugger convenience hook.
+*)
+
+PROCEDURE gdbhook ;
+END gdbhook ;
+
+
+(*
+   BreakWhenSymBooked - to be called interactively by gdb.
+*)
+
+PROCEDURE BreakWhenSymBooked (sym: CARDINAL) ;
+BEGIN
+   BookSym := sym
+END BreakWhenSymBooked ;
+
+
+(*
+   CheckBook - if sym = BookSym then call gdbhook.
+*)
+
+PROCEDURE CheckBook (sym: CARDINAL) ;
+BEGIN
+   IF sym = BookSym
+   THEN
+      gdbhook
+   END
+END CheckBook ;
 
 
 (*
@@ -117,6 +149,7 @@ VAR
    old: tree ;
    t  : PtrToCardinal ;
 BEGIN
+   CheckBook (sym) ;
    IF gcc=GetErrorNode()
    THEN
       InternalError ('error node generated during symbol conversion')
@@ -258,6 +291,18 @@ END Poison ;
 
 PROCEDURE Init ;
 BEGIN
+   BreakWhenSymBooked (NulSym) ;  (* Disable the intereactive sym watch.  *)
+   (* To examine when a symbol is double booked run cc1gm2 from gdb
+      and set a break point on gdbhook.
+      (gdb) break gdbhook
+      (gdb) run
+      Now below interactively call BreakWhenSymBooked with the symbol
+      under investigation.  *)
+   gdbhook ;
+   (* Now is the time to interactively call gdb, for example:
+      (gdb) print BreakWhenSymBooked (1234)
+      (gdb) cont
+      and you will arrive at gdbhook when this symbol is booked.  *)
    mod2gcc := InitIndexTuned (1, 1024*1024 DIV 16, 16) ;
    ALLOCATE (PoisonedSymbol, 1)
 END Init ;
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index 5b93f292381..12a3b3ad97d 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -580,6 +580,41 @@ PROCEDURE MakeSubrange (tok: CARDINAL; SubrangeName: Name) : CARDINAL ;
 PROCEDURE MakeSet (tok: CARDINAL; SetName: Name) : CARDINAL ;
 
 
+(*
+   GetSetArray - return the set array for a large set.
+*)
+
+PROCEDURE GetSetArray (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutSetArray - places array into the setarray field.
+*)
+
+PROCEDURE PutSetArray (Sym: CARDINAL; array: CARDINAL) ;
+
+
+(*
+   MakeSetArray - create an ARRAY simpletype OF BOOLEAN.
+*)
+
+PROCEDURE MakeSetArray (token: CARDINAL; subrangetype: CARDINAL) : CARDINAL ;
+
+
+(*
+   PutSetInWord - set the SetInWord boolean to value.
+*)
+
+PROCEDURE PutSetInWord (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+   GetSetInWord - return SetInWord.
+*)
+
+PROCEDURE GetSetInWord (sym: CARDINAL) : BOOLEAN ;
+
+
 (*
    MakeArray - makes an Array symbol with name ArrayName.
 *)
@@ -3496,4 +3531,20 @@ PROCEDURE GetNthParamAnyClosest (sym: CARDINAL; ParamNo: CARDINAL;
                                  currentmodule: CARDINAL) : CARDINAL ;
 
 
+(*
+   IsConstVar - returns TRUE if sym is a const var.  This is a
+                constant which might be assigned to TRUE or FALSE
+                depending upon the result of the quad stack control flow.
+                Typically used in CONST foo = (a AND b) or similar.
+                This symbol will only be assigned once with a value, but
+                will appear more than once as a designator to an assignment
+                in the quad table.  However as the quad table is reduced
+                only one assignment will remain.  If after reducing quads
+                two or more assignments remain, then there is an error
+                as sym should not have been declared a constant.
+*)
+
+PROCEDURE IsConstVar (sym: CARDINAL) : BOOLEAN ;
+
+
 END SymbolTable.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 00946e52b2e..d610e78821e 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -80,9 +80,9 @@ FROM SymbolKey IMPORT NulKey, SymbolTree, IsSymbol,
                       NoOfNodes ;
 
 FROM M2Base IMPORT MixTypes, MixTypesDecl, InitBase, Char, Integer, LongReal,
-                   Cardinal, LongInt, LongCard, ZType, RType ;
+                   Cardinal, LongInt, LongCard, Boolean, ZType, RType ;
 
-FROM M2System IMPORT Address ;
+FROM M2System IMPORT Address, Byte ;
 FROM m2expr IMPORT OverflowZType ;
 FROM gcctypes IMPORT tree ;
 FROM m2linemap IMPORT BuiltinsLocation ;
@@ -94,6 +94,7 @@ FROM M2Comp IMPORT CompilingDefinitionModule,
 
 FROM FormatStrings IMPORT HandleEscape ;
 FROM M2Scaffold IMPORT DeclareArgEnvParams ;
+FROM M2Diagnostic IMPORT Diagnostic, InitMemDiagnostic, MemIncr, MemSet ;
 
 FROM M2SymInit IMPORT InitDesc, InitSymInit, GetInitialized, ConfigSymInit,
                       SetInitialized, SetFieldInitialized, GetFieldInitialized,
@@ -107,6 +108,7 @@ CONST
    DebugUnknownToken    =  FALSE ;   (* If enabled it will generate a warning every
                                         time a symbol is created with an unknown
                                         location.  *)
+   BreakNew             = 97 ;       (* -1 disables the break.  *)
 
    (*
       The Unbounded is a pseudo type used within the compiler
@@ -653,6 +655,9 @@ TYPE
       	       	     	      	       	      (* (subrange or enumeration).  *)
                 packedInfo: PackedInfo ;      (* the equivalent packed type  *)
                 ispacked : BOOLEAN ;
+                SetInWord: BOOLEAN ;          (* Is the set stored in a word? *)
+                SetArray : CARDINAL ;         (* Array used for large sets.  *)
+                Align    : CARDINAL ;         (* The alignment of this type  *)
                 Size     : PtrToValue ;       (* Runtime size of symbol.     *)
                 oafamily : CARDINAL ;         (* The oafamily for this sym   *)
                 Scope    : CARDINAL ;         (* Scope of declaration.       *)
@@ -933,6 +938,7 @@ VAR
                                       (* errors.                            *)
    ConstLitArray     : Indexing.Index ;
    BreakSym          : CARDINAL ;     (* Allows interactive debugging.      *)
+   SymMemDiag        : Diagnostic ;   (* Contains memory related statistics *)
 
 
 (*
@@ -1080,7 +1086,9 @@ BEGIN
    END ;
    PutIndice(Symbols, sym, pSym) ;
    CheckBreak (sym) ;
-   INC(FreeSymbol)
+   INC (FreeSymbol) ;
+   MemSet (SymMemDiag, 1, FreeSymbol-1) ;
+   MemIncr (SymMemDiag, 2, SIZE (pSym^))
 END NewSym ;
 
 
@@ -1683,6 +1691,10 @@ PROCEDURE Init ;
 VAR
    pCall: PtrToCallFrame ;
 BEGIN
+   SymMemDiag
+      := InitMemDiagnostic
+            ('SymbolTable:Symbols',
+            '{0N} total symbols {1d} consuming {2M} ram {0M} ({2P})') ;
    BreakWhenSymCreated (NulSym) ;  (* Disable the intereactive sym watch.  *)
    (* To examine the symbol table when a symbol is created run cc1gm2 from gdb
       and set a break point on gdbhook.
@@ -5403,6 +5415,28 @@ BEGIN
 END MakeConstVar ;
 
 
+(*
+   IsConstVar - returns TRUE if sym is a const var.  This is a
+                constant which might be assigned to TRUE or FALSE
+                depending upon the result of the quad stack control flow.
+                Typically used in CONST foo = (a AND b) or similar.
+                This symbol will only be assigned once with a value, but
+                will appear more than once as a designator to an assignment
+                in the quad table.  However as the quad table is reduced
+                only one assignment will remain.  If after reducing quads
+                two or more assignments remain, then there is an error
+                as sym should not have been declared a constant.
+*)
+
+PROCEDURE IsConstVar (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym (sym) ;
+   RETURN( pSym^.SymbolType=ConstVarSym )
+END IsConstVar ;
+
+
 (*
    InitConstString - initialize the constant string.
 *)
@@ -5827,7 +5861,7 @@ BEGIN
       VarSym:  RETURN Var.IsSSA
 
       ELSE
-         InternalError ('expecting a variable symbol')
+         RETURN FALSE
       END
    END
 END IsVariableSSA ;
@@ -6391,8 +6425,8 @@ BEGIN
             Size := InitValue() ;   (* Size of array.                      *)
             Offset := InitValue() ; (* Offset of array.                    *)
             Type := NulSym ;        (* The Array Type. ARRAY OF Type.      *)
+            Align := NulSym ;       (* Alignment of this type.     *)
 	    Large := FALSE ;        (* is this array large?                *)
-            Align := NulSym ;       (* The alignment of this type.         *)
             oafamily := oaf ;       (* The unbounded for this array        *)
             Scope := GetCurrentScope() ;        (* Which scope created it  *)
             InitWhereDeclaredTok(tok, At)   (* Declared here               *)
@@ -6992,19 +7026,19 @@ END GetNthParamChoice ;
 
 PROCEDURE GetNthParamOrdered (sym: CARDINAL; ParamNo: CARDINAL;
                               a, b, c: ProcedureKind) : CARDINAL ;
-VAR
-   param: CARDINAL ;
 BEGIN
-   param := GetNthParamChoice (sym, ParamNo, a) ;
-   IF param = NulSym
+   IF GetProcedureParametersDefined (sym, a)
    THEN
-      param := GetNthParamChoice (sym, ParamNo, b) ;
-      IF param = NulSym
+      RETURN GetNthParamChoice (sym, ParamNo, a)
+   ELSIF GetProcedureParametersDefined (sym, b)
+   THEN
+      RETURN GetNthParamChoice (sym, ParamNo, b)
+   ELSIF GetProcedureParametersDefined (sym, c)
       THEN
-         param := GetNthParamChoice (sym, ParamNo, c)
+      RETURN GetNthParamChoice (sym, ParamNo, c)
+   ELSE
+      RETURN NulSym
       END
-   END ;
-   RETURN param
 END GetNthParamOrdered ;
 
 
@@ -7023,6 +7057,10 @@ END GetNthParamOrdered ;
 PROCEDURE GetNthParamAnyClosest (sym: CARDINAL; ParamNo: CARDINAL;
                                  currentmodule: CARDINAL) : CARDINAL ;
 BEGIN
+   IF IsUnknown (sym)
+   THEN
+      InternalError (__FILE__ + ":" + __FUNCTION__ + ":not expecting an unknown symbol")
+   END ;
    IF GetOuterModuleScope (currentmodule) = GetOuterModuleScope (sym)
    THEN
       (* Same module.  *)
@@ -7042,11 +7080,22 @@ END GetNthParamAnyClosest ;
 
 PROCEDURE GetOuterModuleScope (sym: CARDINAL) : CARDINAL ;
 BEGIN
-   WHILE NOT (IsDefImp (sym) OR
-              (IsModule (sym) AND (GetScope (sym) = NulSym))) DO
-      sym := GetScope (sym)
-   END ;
+   REPEAT
+      IF IsDefImp (sym)
+      THEN
+         (* Definition/implementation module.  *)
    RETURN sym
+      ELSIF IsModule (sym)
+      THEN
+         IF GetScope (sym) = NulSym
+         THEN
+            (* Outer module.  *)
+            RETURN sym
+         END
+      END ;
+      sym := GetScope (sym)
+   UNTIL sym = NulSym ;
+   InternalError ('not expecting to reach an outer scope')
 END GetOuterModuleScope ;
 
 
@@ -11857,10 +11906,6 @@ BEGIN
       CASE SymbolType OF
 
       ErrorSym      : n := 0 |
-(*
-      ArraySym      ,
-      UnboundedSym  : n := 1 |   (* Standard language limitation *)
-*)
       EnumerationSym: n := pSym^.Enumeration.NoOfElements |
       InterfaceSym  : n := HighIndice(Interface.Parameters)
 
@@ -11995,6 +12040,10 @@ BEGIN
             InitPacked(packedInfo) ;        (* not packed and no      *)
                                             (* equivalent (yet).      *)
             ispacked := FALSE ;        (* Not yet known to be packed. *)
+            SetInWord := TRUE ;        (* Can the set be stored in a  *)
+                                       (* single word?                *)
+            SetArray := NulSym ;       (* Set used for large sets.    *)
+            Align := NulSym ;
             oafamily := oaf ;          (* The unbounded sym for this  *)
             Scope := GetCurrentScope() ;    (* Which scope created it *)
             InitWhereDeclaredTok(tok, At)   (* Declared here          *)
@@ -12031,6 +12080,46 @@ BEGIN
 END PutSet ;
 
 
+(*
+   PutSetArray - places array into the setarray field.
+*)
+
+PROCEDURE PutSetArray (Sym: CARDINAL; array: CARDINAL) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   pSym := GetPsym(Sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      ErrorSym: |
+      SetSym: WITH Set DO
+                 SetArray := array
+              END
+      ELSE
+         InternalError ('expecting a Set symbol')
+      END
+   END
+END PutSetArray ;
+
+
+(*
+   MakeSetArray - create an ARRAY simpletype OF BOOLEAN.
+*)
+
+PROCEDURE MakeSetArray (token: CARDINAL; subrangetype: CARDINAL) : CARDINAL ;
+VAR
+   array, subscript: CARDINAL ;
+BEGIN
+   array := MakeArray (token, NulSym) ;
+   PutArray (array, Byte) ;
+   subscript := MakeSubscript () ;
+   PutSubscript (subscript, subrangetype) ;
+   PutArraySubscript (array, subscript) ;
+   RETURN array
+END MakeSetArray ;
+
+
 (*
    IsSet - returns TRUE if Sym is a set symbol.
 *)
@@ -12059,6 +12148,77 @@ BEGIN
 END IsSetPacked ;
 
 
+(*
+   GetSetArray - return the set array for a large set.
+*)
+
+PROCEDURE GetSetArray (sym: CARDINAL) : CARDINAL ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   AssertInRange (sym) ;
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      SetSym: RETURN Set.SetArray
+
+      ELSE
+         RETURN NulSym
+      END
+   END
+END GetSetArray ;
+
+
+(*
+   PutSetInWord - set the SetInWord boolean to value.
+*)
+
+PROCEDURE PutSetInWord (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   AssertInRange (sym) ;
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      SetSym: Set.SetInWord := value ;
+              IF value
+              THEN
+                 Set.Align := MakeConstant (GetDeclaredMod (sym), 0) ;
+                 Set.ispacked := TRUE
+              END
+
+      ELSE
+         InternalError ('expecting a set symbol')
+      END
+   END
+END PutSetInWord ;
+
+
+(*
+   GetSetInWord - return SetInWord.
+*)
+
+PROCEDURE GetSetInWord (sym: CARDINAL) : BOOLEAN ;
+VAR
+   pSym: PtrToSymbol ;
+BEGIN
+   AssertInRange (sym) ;
+   pSym := GetPsym (sym) ;
+   WITH pSym^ DO
+      CASE SymbolType OF
+
+      SetSym: RETURN Set.SetInWord
+
+      ELSE
+         InternalError ('expecting a Set symbol')
+      END
+   END
+END GetSetInWord ;
+
+
 (*
    ForeachParameterDo -
 *)
@@ -12742,9 +12902,9 @@ BEGIN
          type := SkipType(GetType(subscript)) ;
          IF IsAModula2Type(type)
          THEN
-            (* ok all is good *)
+            (* Ok all is good.  *)
          ELSE
-            MetaError2('the array {%1Dad} must be declared with a simpletype in the [..] component rather than a {%2d}',
+            MetaError2('the array {%1Dad} must be declared with a simpletype in the [..] component rather than a {%2dv}',
                        sym, type)
          END
       END
@@ -15166,9 +15326,10 @@ BEGIN
       RecordSym     :  Record.Align := align |
       RecordFieldSym:  RecordField.Align := align |
       TypeSym       :  Type.Align := align |
-      ArraySym      :  Array.Align := align |
       PointerSym    :  Pointer.Align := align |
-      SubrangeSym   :  Subrange.Align := align
+      SubrangeSym   :  Subrange.Align := align |
+      SetSym        :  Set.Align := align |
+      ArraySym      :  Array.Align := align
 
       ELSE
          InternalError ('expecting record, field, pointer, type, subrange or an array symbol')
@@ -15193,11 +15354,12 @@ BEGIN
       RecordSym      :  RETURN( Record.Align ) |
       RecordFieldSym :  RETURN( RecordField.Align ) |
       TypeSym        :  RETURN( Type.Align ) |
-      ArraySym       :  RETURN( Array.Align ) |
       PointerSym     :  RETURN( Pointer.Align ) |
       VarientFieldSym:  RETURN( GetAlignment(VarientField.Parent) ) |
       VarientSym     :  RETURN( GetAlignment(Varient.Parent) ) |
-      SubrangeSym    :  RETURN( Subrange.Align )
+      SubrangeSym    :  RETURN( Subrange.Align ) |
+      SetSym         :  RETURN( Set.Align ) |
+      ArraySym       :  RETURN( Array.Align )
 
       ELSE
          InternalError ('expecting record, field, pointer, type, subrange or an array symbol')
diff --git a/gcc/m2/gm2-gcc/init.cc b/gcc/m2/gm2-gcc/init.cc
index 3156c3f2d6c..fefcfd4cfa3 100644
--- a/gcc/m2/gm2-gcc/init.cc
+++ b/gcc/m2/gm2-gcc/init.cc
@@ -107,6 +107,7 @@ EXTERN void _M2_M2SSA_init (int argc, char *argv[], char *envp[]);
 EXTERN void _M2_M2SymInit_init (int argc, char *argv[], char *envp[]);
 EXTERN void _M2_M2StateCheck_init (int argc, char *argv[], char *envp[]);
 EXTERN void _M2_P3Build_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2Diagnostic_init (int argc, char *argv[], char *envp[]);
 EXTERN void exit (int);
 EXTERN void M2Comp_compile (const char *filename);
 EXTERN void RTExceptions_DefaultErrorCatch (void);
@@ -126,6 +127,7 @@ init_FrontEndInit (void)
   _M2_M2Dependent_init (0, NULL, NULL);
   _M2_M2RTS_init (0, NULL, NULL);
   _M2_SysExceptions_init (0, NULL, NULL);
+  _M2_M2Diagnostic_init (0, NULL, NULL);
   _M2_DynamicStrings_init (0, NULL, NULL);
   _M2_Assertion_init (0, NULL, NULL);
   _M2_FormatStrings_init (0, NULL, NULL);
diff --git a/gcc/m2/gm2-gcc/m2block.cc b/gcc/m2/gm2-gcc/m2block.cc
index c4877d1b041..32e3bd10f60 100644
--- a/gcc/m2/gm2-gcc/m2block.cc
+++ b/gcc/m2/gm2-gcc/m2block.cc
@@ -115,6 +115,22 @@ typedef struct stmt_tree_s *stmt_tree_t;
 static location_t pending_location;
 static int pending_statement = false;
 
+/* GetTotalConstants returns the number of global constants.  */
+
+int
+m2block_GetTotalConstants (void)
+{
+  return m2treelib_nCount (global_binding_level->constants);
+}
+
+/* GetGlobalTypes returns the number of global types.  */
+
+int
+m2block_GetGlobalTypes (void)
+{
+  return m2treelib_nCount (global_binding_level->types);
+}
+
 /* assert_global_names asserts that the global_binding_level->names
    can be chained.  */
 
diff --git a/gcc/m2/gm2-gcc/m2block.def b/gcc/m2/gm2-gcc/m2block.def
index 1860379ef23..1986e57a5fa 100644
--- a/gcc/m2/gm2-gcc/m2block.def
+++ b/gcc/m2/gm2-gcc/m2block.def
@@ -220,4 +220,18 @@ PROCEDURE addStmtNote (location: location_t) ;
 PROCEDURE removeStmtNote ;
 
 
+(*
+   GetTotalConstants - returns the number of global constants.
+*)
+
+PROCEDURE GetTotalConstants () : CARDINAL ;
+
+
+(*
+   GetGlobalTypes - returns the number of global types.
+*)
+
+PROCEDURE GetGlobalTypes () : CARDINAL ;
+
+
 END m2block.
diff --git a/gcc/m2/gm2-gcc/m2block.h b/gcc/m2/gm2-gcc/m2block.h
index 0a58940c174..04b6aaadeaa 100644
--- a/gcc/m2/gm2-gcc/m2block.h
+++ b/gcc/m2/gm2-gcc/m2block.h
@@ -72,6 +72,8 @@ EXTERN void m2block_includeDecl (tree);
 EXTERN tree m2block_add_stmt (location_t location, tree t);
 EXTERN void m2block_addStmtNote (location_t location);
 EXTERN void m2block_removeStmtNote (void);
+EXTERN int m2block_GetTotalConstants (void);
+EXTERN int m2block_GetGlobalTypes (void);
 
 EXTERN void m2block_init (void);
 
diff --git a/gcc/m2/gm2-gcc/m2convert.cc b/gcc/m2/gm2-gcc/m2convert.cc
index 8a497e50f6b..785326cac2f 100644
--- a/gcc/m2/gm2-gcc/m2convert.cc
+++ b/gcc/m2/gm2-gcc/m2convert.cc
@@ -344,6 +344,17 @@ same_size_types (location_t location, tree t1, tree t2)
   return m2expr_CompareTrees (n1, n2) == 0;
 }
 
+/* converting_ISO_generic attempts to convert value to type and returns true
+   if successful.  This is a helper function to BuildConvert which will try
+   each generic data type in turn.
+
+   generic_type will be set to any of ISO BYTE, PIM BYTE WORD, etc.
+   If type == generic_type then specific conversion procedures
+   are applied.  A constant will be converted via const_to_ISO_type
+   whereas non constants are converted by *(type *) &value.
+
+   Remember that in ISO M2 BYTE is an ARRAY [0..0] OF LOC.  */
+
 static int
 converting_ISO_generic (location_t location, tree type, tree value,
                         tree generic_type, tree *result)
@@ -354,11 +365,17 @@ converting_ISO_generic (location_t location, tree type, tree value,
     /* We let the caller deal with this.  */
     return false;
 
-  if ((TREE_CODE (value) == INTEGER_CST) && (type == generic_type))
+  if (TREE_CODE (value) == INTEGER_CST)
+    {
+      if (type == generic_type)
     {
       *result = const_to_ISO_type (location, value, generic_type);
       return true;
     }
+      /* We must not attempt to convert a constant by taking its
+	 address below, so we bail out here.  */
+      return false;
+    }
 
   if (same_size_types (location, type, value_type))
     {
@@ -382,8 +399,8 @@ converting_ISO_generic (location_t location, tree type, tree value,
   return false;
 }
 
-/* convert_char_to_array - convert a single char, value, into an
-   type.  The type will be array [..] of char.  The array type
+/* convert_char_to_array convert a single char value into a type.
+   The type will be array [..] of char.  The array type
    returned will have nuls appended to pad the single char to the
    correct array length.  */
 
@@ -638,6 +655,15 @@ m2convert_ToLoc (location_t location, tree expr)
                                  false);
 }
 
+/* ToPIMByte - convert an expression expr to a PIM BYTE.  */
+
+tree
+m2convert_ToPIMByte (location_t location, tree expr)
+{
+  return m2convert_BuildConvert (location, m2type_GetByteType (), expr,
+                                 false);
+}
+
 /* GenericToType - converts, expr, into, type, providing that expr is
    a generic system type (byte, word etc).  Otherwise expr is
    returned unaltered.  */
diff --git a/gcc/m2/gm2-gcc/m2convert.def b/gcc/m2/gm2-gcc/m2convert.def
index 83005ec8cd0..2385c3f6127 100644
--- a/gcc/m2/gm2-gcc/m2convert.def
+++ b/gcc/m2/gm2-gcc/m2convert.def
@@ -53,6 +53,20 @@ PROCEDURE ToInteger (location: location_t; expr: tree) : tree ;
 PROCEDURE ToBitset (location: location_t; expr: tree) : tree ;
 
 
+(*
+   ToLoc - convert an expression, expr, to a LOC.
+*)
+
+PROCEDURE ToLoc (location: location_t; expr: tree) : tree ;
+
+
+(*
+   ToPIMByte - convert an expression expr to a PIM BYTE.
+*)
+
+PROCEDURE ToPIMByte (location: location_t; expr: tree) : tree ;
+
+
 (*
    ConvertToPtr - convert an expression to a void *.
 *)
diff --git a/gcc/m2/gm2-gcc/m2convert.h b/gcc/m2/gm2-gcc/m2convert.h
index 984faf19e4b..37c8f9cff83 100644
--- a/gcc/m2/gm2-gcc/m2convert.h
+++ b/gcc/m2/gm2-gcc/m2convert.h
@@ -47,6 +47,8 @@ EXTERN tree m2convert_ToInteger (location_t location, tree expr);
 EXTERN tree m2convert_ToWord (location_t location, tree expr);
 EXTERN tree m2convert_ToBitset (location_t location, tree expr);
 EXTERN tree m2convert_ToLoc (location_t location, tree expr);
+EXTERN tree m2convert_ToPIMByte (location_t location, tree expr);
+
 EXTERN tree m2convert_GenericToType (location_t location, tree type,
                                      tree expr);
 
diff --git a/gcc/m2/gm2-gcc/m2decl.h b/gcc/m2/gm2-gcc/m2decl.h
index 127c9abafca..eb6569face6 100644
--- a/gcc/m2/gm2-gcc/m2decl.h
+++ b/gcc/m2/gm2-gcc/m2decl.h
@@ -51,7 +51,6 @@ EXTERN tree m2decl_BuildConstLiteralNumber (location_t location,
 					    const char *str,
                                             unsigned int base,
 					    bool issueError);
-EXTERN void m2decl_RememberVariables (tree l);
 
 EXTERN tree m2decl_BuildEndFunctionDeclaration (
     location_t location_begin, location_t location_end, const char *name,
diff --git a/gcc/m2/gm2-gcc/m2expr.cc b/gcc/m2/gm2-gcc/m2expr.cc
index 42ea4fa9f5b..8478e783c20 100644
--- a/gcc/m2/gm2-gcc/m2expr.cc
+++ b/gcc/m2/gm2-gcc/m2expr.cc
@@ -598,7 +598,7 @@ m2expr_BuildLogicalShift (location_t location, tree op1, tree op2, tree op3,
                                            m2convert_ToInteger (location, op3),
                                            m2expr_GetIntegerZero (location));
 
-      m2statement_DoJump (location, is_less, NULL, labelElseName);
+      m2statement_IfExprJump (location, is_less, labelElseName);
       op2 = m2convert_ToWord (location, op2);
       op3 = m2convert_ToWord (location, op3);
       res = m2expr_BuildLSL (location, op2, op3, needconvert);
@@ -673,7 +673,7 @@ m2expr_BuildLRotate (location_t location, tree op1, tree nBits,
 
   op1 = m2expr_FoldAndStrip (op1);
   nBits = m2expr_FoldAndStrip (nBits);
-  nBits = m2convert_BuildConvert (location, TREE_TYPE (op1), nBits, needconvert);  
+  nBits = m2convert_BuildConvert (location, TREE_TYPE (op1), nBits, needconvert);
   t = m2expr_build_binary_op (location, LROTATE_EXPR, op1, nBits, needconvert);
   return m2expr_FoldAndStrip (t);
 }
@@ -724,15 +724,15 @@ m2expr_BuildLRLn (location_t location, tree op1, tree op2, tree nBits,
 
       /* Make absolutely sure there are no high order bits lying around.  */
 
-      op1 = m2expr_BuildLogicalAnd (location, op1, mask, needconvert);
+      op1 = m2expr_BuildLogicalAnd (location, op1, mask);
       left = m2expr_BuildLSL (location, op1, op2min, needconvert);
-      left = m2expr_BuildLogicalAnd (location, left, mask, needconvert);
+      left = m2expr_BuildLogicalAnd (location, left, mask);
       right = m2expr_BuildLSR (
           location, op1,
           m2expr_BuildSub (location, m2convert_ToCardinal (location, nBits),
                            op2min, needconvert),
           needconvert);
-      return m2expr_BuildLogicalOr (location, left, right, needconvert);
+      return m2expr_BuildLogicalOr (location, left, right);
     }
 }
 
@@ -765,15 +765,15 @@ m2expr_BuildLRRn (location_t location, tree op1, tree op2, tree nBits,
 
       /* Make absolutely sure there are no high order bits lying around.  */
 
-      op1 = m2expr_BuildLogicalAnd (location, op1, mask, needconvert);
+      op1 = m2expr_BuildLogicalAnd (location, op1, mask);
       right = m2expr_BuildLSR (location, op1, op2min, needconvert);
       left = m2expr_BuildLSL (
           location, op1,
           m2expr_BuildSub (location, m2convert_ToCardinal (location, nBits),
                            op2min, needconvert),
           needconvert);
-      left = m2expr_BuildLogicalAnd (location, left, mask, needconvert);
-      return m2expr_BuildLogicalOr (location, left, right, needconvert);
+      left = m2expr_BuildLogicalAnd (location, left, mask);
+      return m2expr_BuildLogicalOr (location, left, right);
     }
 }
 
@@ -807,7 +807,7 @@ m2expr_BuildLogicalRotate (location_t location, tree op1, tree op2, tree op3,
       tree is_less = m2expr_BuildLessThan (location, rotateCount,
                                            m2expr_GetIntegerZero (location));
 
-      m2statement_DoJump (location, is_less, NULL, labelElseName);
+      m2statement_IfExprJump (location, is_less, labelElseName);
       res = m2expr_BuildLRLn (location, op2, rotateCount, nBits, needconvert);
       m2statement_BuildAssignmentTree (location, op1, res);
       m2statement_BuildGoto (location, labelEndName);
@@ -819,139 +819,43 @@ m2expr_BuildLogicalRotate (location_t location, tree op1, tree op2, tree op3,
     }
 }
 
-/* buildUnboundedArrayOf construct an unbounded struct and returns
-   the gcc tree.  The two fields of the structure are initialized to
-   contentsPtr and high.  */
+/* BuildIfBitInSetLower returns tree ((set >> bit) & 1).  It converts set and bit to
+   type word prior to the bit test.  */
 
 static tree
-buildUnboundedArrayOf (tree unbounded, tree contentsPtr, tree high)
+BuildIfBitInSetLower (location_t location, enum tree_code code, tree set, tree bit)
 {
-  tree fields = TYPE_FIELDS (unbounded);
-  tree field_list = NULL_TREE;
-  tree constructor;
-
-  field_list = tree_cons (fields, contentsPtr, field_list);
-  fields = TREE_CHAIN (fields);
-
-  field_list = tree_cons (fields, high, field_list);
-
-  constructor = build_constructor_from_list (unbounded, nreverse (field_list));
-  TREE_CONSTANT (constructor) = 0;
-  TREE_STATIC (constructor) = 0;
-
-  return constructor;
+  set = m2convert_ToWord (location, set);
+  bit = m2convert_ToWord (location, bit);
+  set = m2expr_BuildLSR (location, set, bit, false);
+  return m2expr_build_binary_op (location, code,
+				 m2expr_build_binary_op (location,
+							 BIT_AND_EXPR, set,
+							 m2expr_GetWordOne (location), false),
+				 m2expr_GetWordZero (location), FALSE);
 }
 
-/* BuildBinarySetDo if the size of the set is <= TSIZE(WORD) then op1
-   := binop(op2, op3) else call m2rtsprocedure(op1, op2, op3).  */
+/* BuildIfInSet returns tree (bit IN set).  */
 
-void
-m2expr_BuildBinarySetDo (location_t location, tree settype, tree op1, tree op2,
-                         tree op3, void (*binop) (location_t, tree, tree, tree,
-                                                  tree, bool),
-                         bool is_op1lvalue, bool is_op2lvalue, bool is_op3lvalue,
-                         tree nBits, tree unbounded, tree varproc,
-                         tree leftproc, tree rightproc)
+tree
+m2expr_BuildIfInSet (location_t location, tree set, tree bit)
 {
-  tree size = m2expr_GetSizeOf (location, settype);
-  bool is_const = false;
-  bool is_left = false;
-
   m2assert_AssertLocation (location);
 
-  ASSERT_BOOL (is_op1lvalue);
-  ASSERT_BOOL (is_op2lvalue);
-  ASSERT_BOOL (is_op3lvalue);
-
-  if (m2expr_CompareTrees (
-          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
-      <= 0)
-    /* Small set size <= TSIZE(WORD).  */
-    (*binop) (location,
-              m2treelib_get_rvalue (location, op1, settype, is_op1lvalue),
-              m2treelib_get_rvalue (location, op2, settype, is_op2lvalue),
-              m2treelib_get_rvalue (location, op3, settype, is_op3lvalue),
-              nBits, false);
-  else
-    {
-      tree result;
-      tree high = m2expr_BuildSub (
-          location,
-          m2convert_ToCardinal (
-              location,
-              m2expr_BuildDivTrunc (
-                  location, size,
-                  m2expr_GetSizeOf (location, m2type_GetBitsetType ()),
-                  false)),
-          m2expr_GetCardinalOne (location), false);
-
-      /* If op3 is constant then make op3 positive and remember which
-      direction we are shifting.  */
-
-      op3 = m2tree_skip_const_decl (op3);
-      if (TREE_CODE (op3) == INTEGER_CST)
-        {
-          is_const = true;
-          if (tree_int_cst_sgn (op3) < 0)
-            op3 = m2expr_BuildNegate (location, op3, false);
-          else
-            is_left = true;
-          op3 = m2convert_BuildConvert (location, m2type_GetM2CardinalType (),
-                                        op3, false);
-        }
-
-      /* These parameters must match the prototypes of the procedures:
-	 ShiftLeft, ShiftRight, ShiftVal, RotateLeft, RotateRight, RotateVal
-	 inside gm2-iso/SYSTEM.mod.  */
+  return BuildIfBitInSetLower (location, NE_EXPR, set, bit);
+}
 
-      /* Remember we must build the parameters in reverse.  */
+/* BuildIfInSet returns tree (NOT (bit IN set)).  */
 
-      /* Parameter 4 amount.  */
-      m2statement_BuildParam (
-          location,
-          m2convert_BuildConvert (
-              location, m2type_GetM2IntegerType (),
-              m2treelib_get_rvalue (location, op3,
-                                    m2tree_skip_type_decl (TREE_TYPE (op3)),
-                                    is_op3lvalue),
-              false));
+tree
+m2expr_BuildIfNotInSet (location_t location, tree set, tree bit)
+{
+  m2assert_AssertLocation (location);
 
-      /* Parameter 3 nBits.  */
-      m2statement_BuildParam (
-          location,
-          m2convert_BuildConvert (location, m2type_GetM2CardinalType (),
-                                  m2expr_FoldAndStrip (nBits), false));
-
-      /* Parameter 2 destination set.  */
-      m2statement_BuildParam (
-          location,
-          buildUnboundedArrayOf (
-              unbounded,
-              m2treelib_get_set_address (location, op1, is_op1lvalue), high));
-
-      /* Parameter 1 source set.  */
-      m2statement_BuildParam (
-          location,
-          buildUnboundedArrayOf (
-              unbounded,
-              m2treelib_get_set_address (location, op2, is_op2lvalue), high));
-
-      /* Now call the appropriate procedure inside SYSTEM.mod.  */
-      if (is_const)
-        if (is_left)
-          result = m2statement_BuildProcedureCallTree (location, leftproc,
-                                                       NULL_TREE);
-        else
-          result = m2statement_BuildProcedureCallTree (location, rightproc,
-                                                       NULL_TREE);
-      else
-        result = m2statement_BuildProcedureCallTree (location, varproc,
-                                                     NULL_TREE);
-      add_stmt (location, result);
-    }
+  return BuildIfBitInSetLower (location, EQ_EXPR, set, bit);
 }
 
-/* Print a warning if a constant expression had overflow in folding.
+/* Print a warning if a constant expression caused overflow in folding.
    Invoke this function on every expression that the language requires
    to be a constant expression.  */
 
@@ -1463,11 +1367,11 @@ m2expr_Build4LogicalOr (location_t location, tree op1, tree op2, tree op3,
                         tree op4)
 {
   tree t1 = m2expr_FoldAndStrip (
-      m2expr_BuildLogicalOr (location, op1, op2, false));
+      m2expr_BuildLogicalOr (location, op1, op2));
   tree t2
-      = m2expr_FoldAndStrip (m2expr_BuildLogicalOr (location, t1, op3, false));
+      = m2expr_FoldAndStrip (m2expr_BuildLogicalOr (location, t1, op3));
   return m2expr_FoldAndStrip (
-      m2expr_BuildLogicalOr (location, t2, op4, false));
+      m2expr_BuildLogicalOr (location, t2, op4));
 }
 
 /* checkWholeMultOverflow - check to see whether i * j will overflow
@@ -2697,15 +2601,15 @@ m2expr_BuildNegate (location_t location, tree op1, bool needconvert)
 /* BuildSetNegate build a set negate expression and returns the tree.  */
 
 tree
-m2expr_BuildSetNegate (location_t location, tree op1, bool needconvert)
+m2expr_BuildSetNegate (location_t location, tree value)
 {
   m2assert_AssertLocation (location);
 
   return m2expr_build_binary_op (
       location, BIT_XOR_EXPR,
       m2convert_BuildConvert (location, m2type_GetWordType (),
-                              m2expr_FoldAndStrip (op1), false),
-      set_full_complement, needconvert);
+                              m2expr_FoldAndStrip (value), false),
+      set_full_complement, false);
 }
 
 /* BuildMult build a multiplication tree.  */
@@ -2984,73 +2888,67 @@ m2expr_BuildOffset (location_t location, tree record, tree field,
 /* BuildLogicalOrAddress build a logical or expressions and return the tree. */
 
 tree
-m2expr_BuildLogicalOrAddress (location_t location, tree op1, tree op2,
-                              bool needconvert)
+m2expr_BuildLogicalOrAddress (location_t location, tree op1, tree op2)
 {
   m2assert_AssertLocation (location);
-  return m2expr_build_binary_op (location, BIT_IOR_EXPR, op1, op2,
-                                 needconvert);
+  return m2expr_build_binary_op (location, BIT_IOR_EXPR, op1, op2, false);
 }
 
 /* BuildLogicalOr build a logical or expressions and return the tree.  */
 
 tree
-m2expr_BuildLogicalOr (location_t location, tree op1, tree op2,
-                       bool needconvert)
+m2expr_BuildLogicalOr (location_t location, tree op1, tree op2)
 {
   m2assert_AssertLocation (location);
   return m2expr_build_binary_op (
       location, BIT_IOR_EXPR,
       m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
       m2convert_BuildConvert (location, m2type_GetWordType (), op2, false),
-      needconvert);
+      false);
 }
 
 /* BuildLogicalAnd build a logical and expression and return the tree.  */
 
 tree
-m2expr_BuildLogicalAnd (location_t location, tree op1, tree op2,
-                        bool needconvert)
+m2expr_BuildLogicalAnd (location_t location, tree op1, tree op2)
 {
   m2assert_AssertLocation (location);
   return m2expr_build_binary_op (
       location, BIT_AND_EXPR,
       m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
       m2convert_BuildConvert (location, m2type_GetWordType (), op2, false),
-      needconvert);
+      false);
 }
 
 /* BuildSymmetricalDifference build a logical xor expression and return the
- * tree.  */
+   tree.  */
 
 tree
-m2expr_BuildSymmetricDifference (location_t location, tree op1, tree op2,
-                                 bool needconvert)
+m2expr_BuildSymmetricDifference (location_t location, tree left, tree right)
 {
   m2assert_AssertLocation (location);
   return m2expr_build_binary_op (
       location, BIT_XOR_EXPR,
-      m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
-      m2convert_BuildConvert (location, m2type_GetWordType (), op2, false),
-      needconvert);
+      m2convert_BuildConvert (location, m2type_GetWordType (), left, false),
+      m2convert_BuildConvert (location, m2type_GetWordType (), right, false),
+      false);
 }
 
-/* BuildLogicalDifference build a logical difference expression and
-return the tree.  (op1 and (not op2)).  */
+/* BuildLogicalDifference build a logical difference expression tree.
+   Return (left and (not right)).  */
 
 tree
-m2expr_BuildLogicalDifference (location_t location, tree op1, tree op2,
-                               bool needconvert)
+m2expr_BuildLogicalDifference (location_t location, tree left, tree right)
 {
   m2assert_AssertLocation (location);
   return m2expr_build_binary_op (
       location, BIT_AND_EXPR,
-      m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
-      m2expr_BuildSetNegate (location, op2, needconvert), needconvert);
+      m2convert_BuildConvert (location, m2type_GetWordType (), left, false),
+      m2expr_BuildSetNegate (location, right), false);
 }
 
 /* base_type returns the base type of an ordinal subrange, or the
-type itself if it is not a subrange.  */
+   type itself if it is not a subrange.  */
 
 static tree
 base_type (tree type)
@@ -3064,20 +2962,20 @@ base_type (tree type)
   return TYPE_MAIN_VARIANT (type);
 }
 
-/* boolean_enum_to_unsigned convert a BOOLEAN_TYPE, t, or
+/* boolean_enum_to_unsigned convert a BOOLEAN_TYPE value or
    ENUMERAL_TYPE to an unsigned type.  */
 
 static tree
-boolean_enum_to_unsigned (location_t location, tree t)
+boolean_enum_to_unsigned (location_t location, tree value)
 {
-  tree type = TREE_TYPE (t);
+  tree type = TREE_TYPE (value);
 
   if (TREE_CODE (base_type (type)) == BOOLEAN_TYPE)
-    return m2convert_BuildConvert (location, unsigned_type_node, t, false);
+    return m2convert_BuildConvert (location, unsigned_type_node, value, false);
   else if (TREE_CODE (base_type (type)) == ENUMERAL_TYPE)
-    return m2convert_BuildConvert (location, unsigned_type_node, t, false);
+    return m2convert_BuildConvert (location, unsigned_type_node, value, false);
   else
-    return t;
+    return value;
 }
 
 /* check_for_comparison check to see if, op, is of type, badType.  If
@@ -3190,7 +3088,7 @@ m2expr_BuildIsSuperset (location_t location, tree op1, tree op2)
 {
   m2assert_AssertLocation (location);
   return m2expr_BuildEqualTo (
-      location, op2, m2expr_BuildLogicalAnd (location, op1, op2, false));
+      location, op2, m2expr_BuildLogicalAnd (location, op1, op2));
 }
 
 /* BuildIsNotSuperset return a tree which computes: op1 & op2 != op2.  */
@@ -3200,7 +3098,7 @@ m2expr_BuildIsNotSuperset (location_t location, tree op1, tree op2)
 {
   m2assert_AssertLocation (location);
   return m2expr_BuildNotEqualTo (
-      location, op2, m2expr_BuildLogicalAnd (location, op1, op2, false));
+      location, op2, m2expr_BuildLogicalAnd (location, op1, op2));
 }
 
 /* BuildIsSubset return a tree which computes:  op1 & op2 == op1.  */
@@ -3210,7 +3108,7 @@ m2expr_BuildIsSubset (location_t location, tree op1, tree op2)
 {
   m2assert_AssertLocation (location);
   return m2expr_BuildEqualTo (
-      location, op1, m2expr_BuildLogicalAnd (location, op1, op2, false));
+      location, op1, m2expr_BuildLogicalAnd (location, op1, op2));
 }
 
 /* BuildIsNotSubset return a tree which computes: op1 & op2 != op1.  */
@@ -3220,224 +3118,22 @@ m2expr_BuildIsNotSubset (location_t location, tree op1, tree op2)
 {
   m2assert_AssertLocation (location);
   return m2expr_BuildNotEqualTo (
-      location, op1, m2expr_BuildLogicalAnd (location, op1, op2, false));
+      location, op1, m2expr_BuildLogicalAnd (location, op1, op2));
 }
 
-/* BuildIfConstInVar generates: if constel in varset then goto label.  */
+/* BuildIfBitInSetJump build and add a statement tree containing:
+   if (bit in setvalue) goto label.  If invertCondition is true then
+   the tree created will take the form:
+   if not (bit in setvalue) goto label.  */
 
 void
-m2expr_BuildIfConstInVar (location_t location, tree type, tree varset,
-                          tree constel, bool is_lvalue, int fieldno,
-                          char *label)
+m2expr_BuildIfBitInSetJump (location_t location, bool invertCondition,
+			    tree setvalue, tree bit, char *label)
 {
-  tree size = m2expr_GetSizeOf (location, type);
-  m2assert_AssertLocation (location);
-
-  ASSERT_BOOL (is_lvalue);
-  if (m2expr_CompareTrees (
-          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
-      <= 0)
-    /* Small set size <= TSIZE(WORD).  */
-    m2treelib_do_jump_if_bit (
-        location, NE_EXPR,
-        m2treelib_get_rvalue (location, varset, type, is_lvalue), constel,
-        label);
-  else
-    {
-      tree fieldlist = TYPE_FIELDS (type);
-      tree field;
-
-      for (field = fieldlist; (field != NULL) && (fieldno > 0);
-           field = TREE_CHAIN (field))
-        fieldno--;
-
-      m2treelib_do_jump_if_bit (
-          location, NE_EXPR,
-          m2treelib_get_set_field_rhs (location, varset, field), constel,
-          label);
-    }
-}
-
-/* BuildIfConstInVar generates: if not (constel in varset) then goto label.  */
-
-void
-m2expr_BuildIfNotConstInVar (location_t location, tree type, tree varset,
-                             tree constel, bool is_lvalue, int fieldno,
-                             char *label)
-{
-  tree size = m2expr_GetSizeOf (location, type);
-
-  m2assert_AssertLocation (location);
-
-  ASSERT_BOOL (is_lvalue);
-  if (m2expr_CompareTrees (
-          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
-      <= 0)
-    /* Small set size <= TSIZE(WORD).  */
-    m2treelib_do_jump_if_bit (
-        location, EQ_EXPR,
-        m2treelib_get_rvalue (location, varset, type, is_lvalue), constel,
-        label);
+  if (invertCondition)
+    m2treelib_do_jump_if_bit (location, NE_EXPR, setvalue, bit, label);
   else
-    {
-      tree fieldlist = TYPE_FIELDS (type);
-      tree field;
-
-      for (field = fieldlist; (field != NULL) && (fieldno > 0);
-           field = TREE_CHAIN (field))
-        fieldno--;
-
-      m2treelib_do_jump_if_bit (
-          location, EQ_EXPR,
-          m2treelib_get_set_field_rhs (location, varset, field), constel,
-          label);
-    }
-}
-
-/* BuildIfVarInVar generates: if varel in varset then goto label.  */
-
-void
-m2expr_BuildIfVarInVar (location_t location, tree type, tree varset,
-                        tree varel, bool is_lvalue, tree low,
-                        tree high ATTRIBUTE_UNUSED, char *label)
-{
-  tree size = m2expr_GetSizeOf (location, type);
-  /* Calculate the index from the first bit, ie bit 0 represents low value.  */
-  tree index = m2expr_BuildSub (
-      location, m2convert_BuildConvert (location, m2type_GetIntegerType (),
-                                        varel, false),
-      m2convert_BuildConvert (location, m2type_GetIntegerType (), low, false),
-      false);
-
-  m2assert_AssertLocation (location);
-
-  if (m2expr_CompareTrees (
-          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
-      <= 0)
-    /* Small set size <= TSIZE(WORD).  */
-    m2treelib_do_jump_if_bit (
-        location, NE_EXPR,
-        m2treelib_get_rvalue (location, varset, type, is_lvalue), index,
-        label);
-  else
-    {
-      tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
-      /* Which word do we need to fetch?  */
-      tree word_index = m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
-          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
-          false));
-      /* Calculate the bit in this word.  */
-      tree offset_into_word = m2expr_FoldAndStrip (m2expr_BuildModTrunc (
-          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
-          false));
-      tree p2 = m2expr_FoldAndStrip (m2expr_BuildMult (
-          location, word_index,
-          m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT), false));
-
-      /* Calculate the address of the word we are interested in.  */
-      p1 = m2expr_BuildAddAddress (location,
-                                   m2convert_convertToPtr (location, p1), p2);
-
-      /* Fetch the word, extract the bit and test for != 0.  */
-      m2treelib_do_jump_if_bit (
-          location, NE_EXPR,
-          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
-          offset_into_word, label);
-    }
-}
-
-/* BuildIfNotVarInVar generates: if not (varel in varset) then goto label.  */
-
-void
-m2expr_BuildIfNotVarInVar (location_t location, tree type, tree varset,
-                           tree varel, bool is_lvalue, tree low,
-                           tree high ATTRIBUTE_UNUSED, char *label)
-{
-  tree size = m2expr_GetSizeOf (location, type);
-  /* Calculate the index from the first bit, ie bit 0 represents low value.  */
-  tree index = m2expr_BuildSub (
-      location, m2convert_BuildConvert (location, m2type_GetIntegerType (),
-                                        m2expr_FoldAndStrip (varel), false),
-      m2convert_BuildConvert (location, m2type_GetIntegerType (),
-                              m2expr_FoldAndStrip (low), false),
-      false);
-
-  index = m2expr_FoldAndStrip (index);
-  m2assert_AssertLocation (location);
-
-  if (m2expr_CompareTrees (
-          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
-      <= 0)
-    /* Small set size <= TSIZE(WORD).  */
-    m2treelib_do_jump_if_bit (
-        location, EQ_EXPR,
-        m2treelib_get_rvalue (location, varset, type, is_lvalue), index,
-        label);
-  else
-    {
-      tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
-      /* Calculate the index from the first bit.  */
-
-      /* Which word do we need to fetch?  */
-      tree word_index = m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
-          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
-          false));
-      /* Calculate the bit in this word.  */
-      tree offset_into_word = m2expr_FoldAndStrip (m2expr_BuildModTrunc (
-          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
-          false));
-      tree p2 = m2expr_FoldAndStrip (m2expr_BuildMult (
-          location, word_index,
-          m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT), false));
-
-      /* Calculate the address of the word we are interested in.  */
-      p1 = m2expr_BuildAddAddress (location, p1, p2);
-
-      /* Fetch the word, extract the bit and test for == 0.  */
-      m2treelib_do_jump_if_bit (
-          location, EQ_EXPR,
-          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
-          offset_into_word, label);
-    }
-}
-
-/* BuildForeachWordInSetDoIfExpr foreach word in set, type, compute
-   the expression, expr, and if true goto label.  */
-
-void
-m2expr_BuildForeachWordInSetDoIfExpr (location_t location, tree type, tree op1,
-                                      tree op2, bool is_op1lvalue,
-                                      bool is_op2lvalue, bool is_op1const,
-                                      bool is_op2const,
-                                      tree (*expr) (location_t, tree, tree),
-                                      char *label)
-{
-  tree p1 = m2treelib_get_set_address_if_var (location, op1, is_op1lvalue,
-                                              is_op1const);
-  tree p2 = m2treelib_get_set_address_if_var (location, op2, is_op2lvalue,
-                                              is_op2const);
-  unsigned int fieldNo = 0;
-  tree field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
-  tree field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
-
-  m2assert_AssertLocation (location);
-  ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op1)) == RECORD_TYPE);
-  ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op2)) == RECORD_TYPE);
-
-  while (field1 != NULL && field2 != NULL)
-    {
-      m2statement_DoJump (
-          location,
-          (*expr) (location,
-                   m2treelib_get_set_value (location, p1, field1, is_op1const,
-                                            is_op1lvalue, op1, fieldNo),
-                   m2treelib_get_set_value (location, p2, field2, is_op2const,
-                                            is_op2lvalue, op2, fieldNo)),
-          NULL, label);
-      fieldNo++;
-      field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
-      field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
-    }
+    m2treelib_do_jump_if_bit (location, EQ_EXPR, setvalue, bit, label);
 }
 
 /* BuildIfInRangeGoto returns a tree containing if var is in the
@@ -3450,16 +3146,16 @@ m2expr_BuildIfInRangeGoto (location_t location, tree var, tree low, tree high,
   m2assert_AssertLocation (location);
 
   if (m2expr_CompareTrees (low, high) == 0)
-    m2statement_DoJump (location, m2expr_BuildEqualTo (location, var, low),
-                        NULL, label);
+    m2statement_IfExprJump (location, m2expr_BuildEqualTo (location, var, low),
+			    label);
   else
-    m2statement_DoJump (
+    m2statement_IfExprJump (
         location,
         m2expr_build_binary_op (
             location, TRUTH_ANDIF_EXPR,
             m2expr_BuildGreaterThanOrEqual (location, var, low),
             m2expr_BuildLessThanOrEqual (location, var, high), false),
-        NULL, label);
+        label);
 }
 
 /* BuildIfNotInRangeGoto returns a tree containing if var is not in
@@ -3472,15 +3168,15 @@ m2expr_BuildIfNotInRangeGoto (location_t location, tree var, tree low,
   m2assert_AssertLocation (location);
 
   if (m2expr_CompareTrees (low, high) == 0)
-    m2statement_DoJump (location, m2expr_BuildNotEqualTo (location, var, low),
-                        NULL, label);
+    m2statement_IfExprJump (location, m2expr_BuildNotEqualTo (location, var, low),
+			    label);
   else
-    m2statement_DoJump (
+    m2statement_IfExprJump (
         location, m2expr_build_binary_op (
                       location, TRUTH_ORIF_EXPR,
                       m2expr_BuildLessThan (location, var, low),
                       m2expr_BuildGreaterThan (location, var, high), false),
-        NULL, label);
+        label);
 }
 
 /* BuildArray - returns a tree which accesses array[index] given,
@@ -3829,75 +3525,18 @@ m2expr_BuildCmplx (location_t location, tree type, tree real, tree imag)
     return build2 (COMPLEX_EXPR, type, real, imag);
 }
 
-/* BuildBinaryForeachWordDo implements the large set operators.  Each
-   word of the set can be calculated by binop.  This function runs along
-   each word of the large set invoking the binop.  */
-
 void
-m2expr_BuildBinaryForeachWordDo (location_t location, tree type, tree op1,
-                                 tree op2, tree op3,
-                                 tree (*binop) (location_t, tree, tree, bool),
-                                 bool is_op1lvalue, bool is_op2lvalue,
-                                 bool is_op3lvalue, bool is_op1const,
-                                 bool is_op2const, bool is_op3const)
+m2expr_SetAndNarrow (location_t location, tree settype,
+		     tree op1, tree op2, tree op3,
+		     bool is_op1lvalue, bool is_op2lvalue, bool is_op3lvalue)
 {
-  tree size = m2expr_GetSizeOf (location, type);
-
-  m2assert_AssertLocation (location);
-
-  ASSERT_BOOL (is_op1lvalue);
-  ASSERT_BOOL (is_op2lvalue);
-  ASSERT_BOOL (is_op3lvalue);
-  ASSERT_BOOL (is_op1const);
-  ASSERT_BOOL (is_op2const);
-  ASSERT_BOOL (is_op3const);
-  if (m2expr_CompareTrees (
-          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
-      <= 0)
-    /* Small set size <= TSIZE(WORD).  */
-    m2statement_BuildAssignmentTree (
-        location, m2treelib_get_rvalue (location, op1, type, is_op1lvalue),
-        (*binop) (
-            location, m2treelib_get_rvalue (location, op2, type, is_op2lvalue),
-            m2treelib_get_rvalue (location, op3, type, is_op3lvalue), false));
-  else
-    {
-      /* Large set size > TSIZE(WORD).  */
-
-      tree p2 = m2treelib_get_set_address_if_var (location, op2, is_op2lvalue,
-                                                  is_op2const);
-      tree p3 = m2treelib_get_set_address_if_var (location, op3, is_op3lvalue,
-                                                  is_op3const);
-      unsigned int fieldNo = 0;
-      tree field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
-      tree field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
-      tree field3 = m2treelib_get_field_no (type, op3, is_op3const, fieldNo);
-
-      if (is_op1const)
-	m2linemap_internal_error_at (
-            location,
-            "not expecting operand1 to be a constant set");
-
-      while (field1 != NULL && field2 != NULL && field3 != NULL)
-        {
-          m2statement_BuildAssignmentTree (
-              location, m2treelib_get_set_field_des (location, op1, field1),
-              (*binop) (
-                  location,
-                  m2treelib_get_set_value (location, p2, field2, is_op2const,
-                                           is_op2lvalue, op2, fieldNo),
-                  m2treelib_get_set_value (location, p3, field3, is_op3const,
-                                           is_op3lvalue, op3, fieldNo),
-                  false));
-          fieldNo++;
-          field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
-          field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
-          field3 = m2treelib_get_field_no (type, op3, is_op3const, fieldNo);
-        }
-    }
+  m2statement_BuildAssignmentTree (
+     location, m2expr_GetRValue (location, op1, settype, is_op1lvalue),
+     m2expr_BuildLogicalAnd (
+            location, m2expr_GetRValue (location, op2, settype, is_op2lvalue),
+            m2expr_GetRValue (location, op3, settype, is_op3lvalue)));
 }
 
-
 /* OverflowZType returns true if the ZTYPE str will exceed the
    internal representation.  This routine is much faster (at
    least 2 orders of magnitude faster) than the char at a time overflow
@@ -4205,6 +3844,12 @@ m2expr_GetPointerOne (location_t location)
   return m2convert_convertToPtr (location, integer_one_node);
 }
 
+tree
+m2expr_GetBitsetZero (location_t location)
+{
+  return m2convert_ToBitset (location, integer_zero_node);
+}
+
 /* build_set_full_complement return a word size value with all bits
 set to one.  */
 
@@ -4224,12 +3869,23 @@ build_set_full_complement (location_t location)
               location, m2expr_GetWordOne (location),
               m2convert_BuildConvert (location, m2type_GetWordType (),
                                       m2decl_BuildIntegerConstant (i), false),
-              false),
-          false);
+              false));
     }
   return value;
 }
 
+/* GetRValue returns the rvalue of expr.  The type is the object
+   type to be copied upon indirection.  */
+
+tree
+m2expr_GetRValue (location_t location, tree expr, tree type, bool islvalue)
+{
+  if (islvalue)
+    return m2expr_BuildIndirect (location, expr, type);
+  else
+    return expr;
+}
+
 
 /* GetCstInteger return the integer value of the cst tree.  */
 
diff --git a/gcc/m2/gm2-gcc/m2expr.def b/gcc/m2/gm2-gcc/m2expr.def
index a9f5f37280c..6842724ef8c 100644
--- a/gcc/m2/gm2-gcc/m2expr.def
+++ b/gcc/m2/gm2-gcc/m2expr.def
@@ -19,7 +19,7 @@ You should have received a copy of the GNU General Public License
 along with GNU Modula-2; see the file COPYING3.  If not see
 <http://www.gnu.org/licenses/>.  *)
 
-DEFINITION MODULE FOR "C" m2expr  ;
+DEFINITION MODULE m2expr  ;
 
 FROM gcctypes IMPORT location_t, tree ;
 FROM CDataTypes IMPORT CharStar, ConstCharStar ;
@@ -92,6 +92,9 @@ PROCEDURE GetCardinalOne (location: location_t) : tree ;
 PROCEDURE GetCardinalZero (location: location_t) : tree ;
 
 
+PROCEDURE GetBitsetZero (location: location_t) : tree ;
+
+
 PROCEDURE GetSizeOfInBits (type: tree) : tree ;
 
 
@@ -365,7 +368,7 @@ PROCEDURE BuildNegateCheck (location: location_t; arg, lowest, min, max: tree) :
     BuildSetNegate - builds a set negate expression and returns the tree.
 *)
 
-PROCEDURE BuildSetNegate (location: location_t; op1: tree; needconvert: BOOLEAN) : tree ;
+PROCEDURE BuildSetNegate (location: location_t; op1: tree) : tree ;
 
 
 (*
@@ -421,27 +424,32 @@ PROCEDURE BuildLogicalOrAddress (location: location_t; op1: tree; op2: tree; nee
     BuildLogicalOr - build a logical or expressions and return the tree.
 *)
 
-PROCEDURE BuildLogicalOr (location: location_t; op1: tree; op2: tree; needconvert: BOOLEAN) : tree ;
+PROCEDURE BuildLogicalOr (location: location_t; op1: tree; op2: tree) : tree ;
 
 
 (*
     BuildLogicalAnd - build a logical and expression and return the tree.
 *)
 
-PROCEDURE BuildLogicalAnd (location: location_t; op1: tree; op2: tree; needconvert: BOOLEAN) : tree ;
-
+PROCEDURE BuildLogicalAnd (location: location_t; op1: tree; op2: tree) : tree ;
 
 
-PROCEDURE BuildSymmetricDifference (location: location_t; op1: tree; op2: tree; needconvert: BOOLEAN) : tree ;
+PROCEDURE BuildSymmetricDifference (location: location_t; op1: tree; op2: tree) : tree ;
 
 
 (*
-    BuildLogicalDifference - build a logical difference expression and
-                             return the tree.
-                             (op1 and (not op2))
+   BuildLogicalDifference - build a logical difference expression tree.
+                            Return (left and (not right)).
 *)
 
-PROCEDURE BuildLogicalDifference (location: location_t; op1: tree; op2: tree; needconvert: BOOLEAN) : tree ;
+PROCEDURE BuildLogicalDifference (location: location_t;
+                                  left, right: tree) : tree ;
+
+
+PROCEDURE BuildIfInSet (location: location_t; set, bit: tree) : tree ;
+
+
+PROCEDURE BuildIfNotInSet (location: location_t; set, bit: tree) : tree ;
 
 
 (*
@@ -473,14 +481,17 @@ PROCEDURE BuildGreaterThanOrEqual (location: location_t; op1: tree; op2: tree) :
 
 
 (*
-    BuildEqualTo - return a tree which computes =
+    BuildEqualTo - return a tree which computes (left = right).
 *)
 
-PROCEDURE BuildEqualTo (location: location_t; op1: tree; op2: tree) : tree ;
+PROCEDURE BuildEqualTo (location: location_t; left, right: tree) : tree ;
 
 
+(*
+    BuildNotEqualTo - return a tree which computes (left # right).
+*)
 
-PROCEDURE BuildNotEqualTo (location: location_t; op1: tree; op2: tree) : tree ;
+PROCEDURE BuildNotEqualTo (location: location_t; left, right: tree) : tree ;
 
 
 (*
@@ -675,37 +686,6 @@ PROCEDURE BuildIm (op1: tree) : tree ;
 PROCEDURE BuildCmplx (location: location_t; type: tree; real: tree; imag: tree) : tree ;
 
 
-(*
-    BuildBinaryForeachWordDo - provides the large set operators. Each word
-                               (or less) of the set can be calculated by binop.
-                               This procedure runs along each word of the
-                               large set invoking the binop.
-*)
-
-PROCEDURE BuildBinaryForeachWordDo (location: location_t;
-                                    type, op1, op2, op3: tree;
-                                    binop: BuildBinProcedure;
-                                    is_op1lvalue,
-                                    is_op2lvalue,
-                                    is_op3lvalue,
-                                    is_op1_const,
-                                    is_op2_const,
-                                    is_op3_const: BOOLEAN) ;
-
-(*
-   BuildBinarySetDo - if the size of the set is <= TSIZE(WORD) then
-                         op1 := binop(op2, op3)
-                      else
-                         call m2rtsprocedure(op1, op2, op3)
-*)
-
-PROCEDURE BuildBinarySetDo (location: location_t;
-                            settype, op1, op2, op3: tree;
-                            binop: BuildSetProcedure;
-                            is_op1lvalue, is_op2lvalue, is_op3lvalue: BOOLEAN;
-                            nBits, unbounded: tree;
-                            varproc, leftproc, rightproc: tree) ;
-
 (*
    ConstantExpressionWarning - issue a warning if the constant has overflowed.
 *)
@@ -744,6 +724,14 @@ PROCEDURE OverflowZType (location: location_t;
 
 PROCEDURE BuildCondIfExpression (condition, type, left, right: tree) : tree ;
 
+(*
+   GetRValue - returns the rvalue of expr.  The type is the object
+               type to be copied upon indirection.
+*)
+
+PROCEDURE GetRValue (location: location_t; expr, type: tree;
+                     islvalue: BOOLEAN) : tree ;
+
 
 (*
    BuildSystemTBitSize - return the minimum number of bits to represent type.
diff --git a/gcc/m2/gm2-gcc/m2expr.h b/gcc/m2/gm2-gcc/m2expr.h
index d4771e3266f..20bfcea9455 100644
--- a/gcc/m2/gm2-gcc/m2expr.h
+++ b/gcc/m2/gm2-gcc/m2expr.h
@@ -40,11 +40,6 @@ EXTERN char m2expr_CSTIntToChar (tree t);
 EXTERN char *m2expr_CSTIntToString (tree t);
 EXTERN bool m2expr_StrToWideInt (location_t location, const char *str, unsigned int base,
 				 widest_int &wval, bool issueError);
-EXTERN void m2expr_BuildBinaryForeachWordDo (
-    location_t location, tree type, tree op1, tree op2, tree op3,
-    tree (*binop) (location_t, tree, tree, bool), bool is_op1lvalue,
-    bool is_op2lvalue, bool is_op3lvalue, bool is_op1const, bool is_op2const,
-    bool is_op3const);
 EXTERN tree m2expr_BuildCmplx (location_t location, tree type, tree real,
                                tree imag);
 EXTERN tree m2expr_BuildIm (tree op1);
@@ -65,25 +60,6 @@ EXTERN void m2expr_BuildIfNotInRangeGoto (location_t location, tree var,
                                           tree low, tree high, char *label);
 EXTERN void m2expr_BuildIfInRangeGoto (location_t location, tree var, tree low,
                                        tree high, char *label);
-EXTERN void m2expr_BuildForeachWordInSetDoIfExpr (
-    location_t location, tree type, tree op1, tree op2, bool is_op1lvalue,
-    bool is_op2lvalue, bool is_op1const, bool is_op2const,
-    tree (*expr) (location_t, tree, tree), char *label);
-EXTERN void m2expr_BuildIfNotVarInVar (location_t location, tree type,
-                                       tree varset, tree varel, bool is_lvalue,
-                                       tree low, tree high ATTRIBUTE_UNUSED,
-                                       char *label);
-EXTERN void m2expr_BuildIfVarInVar (location_t location, tree type,
-                                    tree varset, tree varel, bool is_lvalue,
-                                    tree low, tree high ATTRIBUTE_UNUSED,
-                                    char *label);
-EXTERN void m2expr_BuildIfNotConstInVar (location_t location, tree type,
-                                         tree varset, tree constel,
-                                         bool is_lvalue, int fieldno,
-                                         char *label);
-EXTERN void m2expr_BuildIfConstInVar (location_t location, tree type,
-                                      tree varset, tree constel, bool is_lvalue,
-                                      int fieldno, char *label);
 EXTERN tree m2expr_BuildIsNotSubset (location_t location, tree op1, tree op2);
 EXTERN tree m2expr_BuildIsSubset (location_t location, tree op1, tree op2);
 EXTERN tree m2expr_BuildIsNotSuperset (location_t location, tree op1,
@@ -97,16 +73,11 @@ EXTERN tree m2expr_BuildLessThanOrEqual (location_t location, tree op1,
                                          tree op2);
 EXTERN tree m2expr_BuildGreaterThan (location_t location, tree op1, tree op2);
 EXTERN tree m2expr_BuildLessThan (location_t location, tree op1, tree op2);
-EXTERN tree m2expr_BuildLogicalDifference (location_t location, tree op1,
-                                           tree op2, bool needconvert);
-EXTERN tree m2expr_BuildSymmetricDifference (location_t location, tree op1,
-                                             tree op2, bool needconvert);
-EXTERN tree m2expr_BuildLogicalAnd (location_t location, tree op1, tree op2,
-                                    bool needconvert);
-EXTERN tree m2expr_BuildLogicalOr (location_t location, tree op1, tree op2,
-                                   bool needconvert);
-EXTERN tree m2expr_BuildLogicalOrAddress (location_t location, tree op1,
-                                          tree op2, bool needconvert);
+EXTERN tree m2expr_BuildLogicalDifference (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildSymmetricDifference (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildLogicalAnd (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildLogicalOr (location_t location, tree op1, tree op2);
+EXTERN tree m2expr_BuildLogicalOrAddress (location_t location, tree op1, tree op2);
 EXTERN tree m2expr_BuildOffset (location_t location, tree record, tree field,
                                 bool needconvert ATTRIBUTE_UNUSED);
 EXTERN tree m2expr_BuildOffset1 (location_t location, tree field,
@@ -115,8 +86,7 @@ EXTERN tree m2expr_BuildAddr (location_t location, tree op1, bool needconvert);
 EXTERN tree m2expr_BuildSize (location_t location, tree op1,
                               bool needconvert ATTRIBUTE_UNUSED);
 EXTERN tree m2expr_BuildTBitSize (location_t location, tree type);
-EXTERN tree m2expr_BuildSetNegate (location_t location, tree op1,
-                                   bool needconvert);
+EXTERN tree m2expr_BuildSetNegate (location_t location, tree value);
 EXTERN tree m2expr_BuildNegate (location_t location, tree op1,
                                 bool needconvert);
 EXTERN tree m2expr_BuildNegateCheck (location_t location, tree arg,
@@ -224,6 +194,7 @@ EXTERN tree m2expr_GetWordZero (location_t location);
 EXTERN tree m2expr_GetWordOne (location_t location);
 EXTERN tree m2expr_GetPointerZero (location_t location);
 EXTERN tree m2expr_GetPointerOne (location_t location);
+EXTERN tree m2expr_GetBitsetZero (location_t location);
 
 EXTERN int m2expr_CompareTrees (tree e1, tree e2);
 EXTERN tree m2expr_build_unary_op (location_t location ATTRIBUTE_UNUSED,
@@ -246,6 +217,10 @@ EXTERN tree m2expr_calcNbits (location_t location, tree min, tree max);
 EXTERN bool m2expr_OverflowZType (location_t location, const char *str,
 				  unsigned int base, bool issueError);
 EXTERN tree m2expr_BuildSystemTBitSize (location_t location, tree type);
+EXTERN tree m2expr_GetRValue (location_t location, tree expr, tree type, bool islvalue);
+EXTERN tree m2expr_BuildIfInSet (location_t location, tree set, tree bit);
+EXTERN tree m2expr_BuildIfNotInSet (location_t location, tree set, tree bit);
+
 EXTERN void m2expr_init (location_t location);
 
 #undef EXTERN
diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h
index 041de26cf8d..273906baba6 100644
--- a/gcc/m2/gm2-gcc/m2options.h
+++ b/gcc/m2/gm2-gcc/m2options.h
@@ -168,6 +168,10 @@ EXTERN char *M2Options_GetM2DumpFilter (void);
 EXTERN void M2Options_SetM2DebugTraceFilter (bool value, const char *arg);
 EXTERN bool M2Options_SetM2Dump (bool value, const char *arg);
 EXTERN bool M2Options_GetDumpGimple (void);
+EXTERN void M2Options_SetTimeReport (bool value);
+EXTERN void M2Options_SetMemReport (bool value);
+EXTERN void M2Options_SetWideset (bool value);
+EXTERN bool M2Options_GetWideset (void);
 EXTERN void M2Options_SetStrictTypeAssignment (bool value);
 EXTERN void M2Options_SetStrictTypeReason (bool value);
 
diff --git a/gcc/m2/gm2-gcc/m2pp.cc b/gcc/m2/gm2-gcc/m2pp.cc
index 7d4adb8ff71..e23ad529ab3 100644
--- a/gcc/m2/gm2-gcc/m2pp.cc
+++ b/gcc/m2/gm2-gcc/m2pp.cc
@@ -1961,6 +1961,22 @@ m2pp_binary_function (pretty *s, tree t, const char *funcname)
   m2pp_print (s, ")");
 }
 
+static void
+m2pp_shiftrotate_expr (pretty *s, tree t, const char *op)
+{
+  tree left = TREE_OPERAND (t, 0);
+  tree right = TREE_OPERAND (t, 1);
+  m2pp_print (s, "(");
+  m2pp_expression (s, left);
+  m2pp_print (s, ")");
+  m2pp_needspace (s);
+  m2pp_print (s, op);
+  m2pp_needspace (s);
+  m2pp_print (s, "(");
+  m2pp_expression (s, right);
+  m2pp_print (s, ")");
+}
+
 /* m2pp_simple_expression handle GCC expression tree.  */
 
 static void
@@ -2117,6 +2133,12 @@ m2pp_simple_expression (pretty *s, tree t)
     case TRUTH_ORIF_EXPR:
       m2pp_truth_expr (s, t, "OR");
       break;
+    case LSHIFT_EXPR:
+      m2pp_shiftrotate_expr (s, t, "<<");
+      break;
+    case RSHIFT_EXPR:
+      m2pp_shiftrotate_expr (s, t, ">>");
+      break;
     case LROTATE_EXPR:
       m2pp_binary_function (s, t, "LROTATE");
       break;
diff --git a/gcc/m2/gm2-gcc/m2statement.cc b/gcc/m2/gm2-gcc/m2statement.cc
index 795298435e7..8696bf80616 100644
--- a/gcc/m2/gm2-gcc/m2statement.cc
+++ b/gcc/m2/gm2-gcc/m2statement.cc
@@ -44,7 +44,7 @@ static GTY (()) tree param_list = NULL_TREE; /* Ready for the next time we
 static GTY (()) tree last_function = NULL_TREE;
 
 
-/* BuildStartFunctionCode - generate function entry code.  */
+/* BuildStartFunctionCode generate function entry code.  */
 
 void
 m2statement_BuildStartFunctionCode (location_t location, tree fndecl,
@@ -86,7 +86,7 @@ m2statement_BuildStartFunctionCode (location_t location, tree fndecl,
   DECL_DECLARED_INLINE_P (fndecl) = 0; /* isinline;  */
 }
 
-/* BuildEndFunctionCode - generates the function epilogue.  */
+/* BuildEndFunctionCode generates the function epilogue.  */
 
 void
 m2statement_BuildEndFunctionCode (location_t location, tree fndecl, bool nested)
@@ -123,7 +123,7 @@ m2statement_BuildEndFunctionCode (location_t location, tree fndecl, bool nested)
   current_function_decl = NULL;
 }
 
-/* BuildPushFunctionContext - pushes the current function context.
+/* BuildPushFunctionContext pushes the current function context.
    Maps onto push_function_context in ../function.cc.  */
 
 void
@@ -132,7 +132,7 @@ m2statement_BuildPushFunctionContext (void)
   push_function_context ();
 }
 
-/* BuildPopFunctionContext - pops the current function context.  Maps
+/* BuildPopFunctionContext pops the current function context.  Maps
    onto pop_function_context in ../function.cc.  */
 
 void
@@ -194,7 +194,7 @@ copy_array (location_t location, tree left, tree right)
       idx = m2convert_BuildConvert (location, index_type, idx, false);
       tree array_ref = build4_loc (location, ARRAY_REF, elt_type, left,
 				   idx, low_indice, NULL_TREE);
-      m2statement_CopyByField (location, array_ref, value);      
+      m2statement_CopyByField (location, array_ref, value);
     }
 }
 
@@ -253,7 +253,7 @@ CopyByField_Lower (location_t location,
   else if (right_code == STRING_CST)
     copy_strncpy (location, left, right);
   else
-    m2statement_BuildAssignmentStatement (location, left, right);    
+    m2statement_BuildAssignmentStatement (location, left, right);
 }
 
 /* CopyByField recursively checks each field to ensure GCC
@@ -321,7 +321,7 @@ m2statement_BuildGoto (location_t location, char *name)
   add_stmt (location, build1 (GOTO_EXPR, void_type_node, label));
 }
 
-/* DeclareLabel - create a label, name.  */
+/* DeclareLabel create a label, name.  */
 
 void
 m2statement_DeclareLabel (location_t location, char *name)
@@ -332,7 +332,7 @@ m2statement_DeclareLabel (location_t location, char *name)
   add_stmt (location, build1 (LABEL_EXPR, void_type_node, label));
 }
 
-/* BuildParam - build a list of parameters, ready for a subsequent
+/* BuildParam build a list of parameters, ready for a subsequent
    procedure call.  */
 
 void
@@ -347,7 +347,7 @@ m2statement_BuildParam (location_t location, tree param)
   param_list = chainon (build_tree_list (NULL_TREE, param), param_list);
 }
 
-/* nCount - return the number of chained tree nodes in list, t.  */
+/* nCount return the number of chained tree nodes in list, t.  */
 
 static int
 nCount (tree t)
@@ -362,7 +362,7 @@ nCount (tree t)
   return i;
 }
 
-/* BuildProcedureCallTree - creates a procedure call from a procedure
+/* BuildProcedureCallTree creates a procedure call from a procedure
    and parameter list and the return type, rettype.  */
 
 tree
@@ -419,7 +419,7 @@ m2statement_BuildProcedureCallTree (location_t location, tree procedure,
     }
 }
 
-/* BuildIndirectProcedureCallTree - creates a procedure call from a
+/* BuildIndirectProcedureCallTree creates a procedure call from a
    procedure and parameter list and the return type, rettype.  */
 
 tree
@@ -486,8 +486,8 @@ m2statement_BuildBuiltinCallTree (tree func)
 }
 
 
-/* BuildFunctValue - generates code for value :=
-   last_function(foobar); */
+/* BuildFunctValue generates code for
+   value := last_function (foobar).  */
 
 tree
 m2statement_BuildFunctValue (location_t location, tree value)
@@ -505,10 +505,9 @@ m2statement_BuildFunctValue (location_t location, tree value)
   TREE_USED (value) = true;
   last_function = NULL_TREE;
   return assign;
-  // return m2statement_BuildAssignmentTree (location, value, assign);
 }
 
-/* BuildCall2 - builds a tree representing: function (arg1, arg2).  */
+/* BuildCall2 builds a tree representing: function (arg1, arg2).  */
 
 tree
 m2statement_BuildCall2 (location_t location, tree function, tree rettype,
@@ -522,8 +521,7 @@ m2statement_BuildCall2 (location_t location, tree function, tree rettype,
   return m2statement_BuildProcedureCallTree (location, function, rettype);
 }
 
-/* BuildCall3 - builds a tree representing: function (arg1, arg2,
-   arg3).  */
+/* BuildCall3 builds a tree representing: function (arg1, arg2, arg3).  */
 
 tree
 m2statement_BuildCall3 (location_t location, tree function, tree rettype,
@@ -538,7 +536,7 @@ m2statement_BuildCall3 (location_t location, tree function, tree rettype,
   return m2statement_BuildProcedureCallTree (location, function, rettype);
 }
 
-/* BuildFunctionCallTree - creates a procedure function call from
+/* BuildFunctionCallTree creates a procedure function call from
    a procedure and parameter list and the return type, rettype.
    No tree is returned as the tree is held in the last_function global
    variable.  It is expected the BuildFunctValue is to be called after
@@ -551,7 +549,7 @@ m2statement_BuildFunctionCallTree (location_t location, tree procedure,
   m2statement_BuildProcedureCallTree (location, procedure, rettype);
 }
 
-/* SetLastFunction - assigns last_function to, t.  */
+/* SetLastFunction assigns last_function to, t.  */
 
 void
 m2statement_SetLastFunction (tree t)
@@ -559,7 +557,7 @@ m2statement_SetLastFunction (tree t)
   last_function = t;
 }
 
-/* SetParamList - assigns param_list to, t.  */
+/* SetParamList assigns param_list to, t.  */
 
 void
 m2statement_SetParamList (tree t)
@@ -567,7 +565,7 @@ m2statement_SetParamList (tree t)
   param_list = t;
 }
 
-/* GetLastFunction - returns, last_function.  */
+/* GetLastFunction returns, last_function.  */
 
 tree
 m2statement_GetLastFunction (void)
@@ -575,7 +573,7 @@ m2statement_GetLastFunction (void)
   return last_function;
 }
 
-/* GetParamList - returns, param_list.  */
+/* GetParamList returns, param_list.  */
 
 tree
 m2statement_GetParamList (void)
@@ -583,7 +581,7 @@ m2statement_GetParamList (void)
   return param_list;
 }
 
-/* GetCurrentFunction - returns the current_function.  */
+/* GetCurrentFunction returns the current_function.  */
 
 tree
 m2statement_GetCurrentFunction (void)
@@ -591,7 +589,7 @@ m2statement_GetCurrentFunction (void)
   return current_function_decl;
 }
 
-/* GetParamTree - return parameter, i.  */
+/* GetParamTree return parameter, i.  */
 
 tree
 m2statement_GetParamTree (tree call, unsigned int i)
@@ -599,7 +597,7 @@ m2statement_GetParamTree (tree call, unsigned int i)
   return CALL_EXPR_ARG (call, i);
 }
 
-/* BuildTryFinally - returns a TRY_FINALL_EXPR with the call and
+/* BuildTryFinally returns a TRY_FINALL_EXPR with the call and
    cleanups attached.  */
 
 tree
@@ -608,7 +606,7 @@ m2statement_BuildTryFinally (location_t location, tree call, tree cleanups)
   return build_stmt (location, TRY_FINALLY_EXPR, call, cleanups);
 }
 
-/* BuildCleanUp - return a CLEANUP_POINT_EXPR which will clobber,
+/* BuildCleanUp return a CLEANUP_POINT_EXPR which will clobber,
    param.  */
 
 tree
@@ -619,7 +617,7 @@ m2statement_BuildCleanUp (tree param)
   return build2 (MODIFY_EXPR, TREE_TYPE (param), param, clobber);
 }
 
-/* BuildAsm - generates an inline assembler instruction.  */
+/* BuildAsm generates an inline assembler instruction.  */
 
 void
 m2statement_BuildAsm (location_t location, tree instr, bool isVolatile,
@@ -640,298 +638,7 @@ m2statement_BuildAsm (location_t location, tree instr, bool isVolatile,
   add_stmt (location, args);
 }
 
-/* BuildUnaryForeachWordDo - provides the large set operators.  Each
-   word (or less) of the set can be calculated by unop.  This
-   procedure runs along each word of the large set invoking the unop.  */
-
-void
-m2statement_BuildUnaryForeachWordDo (location_t location, tree type, tree op1,
-                                     tree op2,
-                                     tree (*unop) (location_t, tree, bool),
-                                     bool is_op1lvalue, bool is_op2lvalue,
-                                     bool is_op1const, bool is_op2const)
-{
-  tree size = m2expr_GetSizeOf (location, type);
-
-  m2assert_AssertLocation (location);
-  ASSERT_BOOL (is_op1lvalue);
-  ASSERT_BOOL (is_op2lvalue);
-  ASSERT_BOOL (is_op1const);
-  ASSERT_BOOL (is_op2const);
-  if (m2expr_CompareTrees (
-          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
-      <= 0)
-    /* Small set size <= TSIZE(WORD).  */
-    m2statement_BuildAssignmentTree (
-        location, m2treelib_get_rvalue (location, op1, type, is_op1lvalue),
-        (*unop) (location,
-                 m2treelib_get_rvalue (location, op2, type, is_op2lvalue),
-                 false));
-  else
-    {
-      /* Large set size > TSIZE(WORD).  */
-      unsigned int fieldNo = 0;
-      tree field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
-      tree field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
-
-      if (is_op1const)
-        error ("internal error: not expecting operand1 to be a constant set");
-
-      while (field1 != NULL && field2 != NULL)
-        {
-          m2statement_BuildAssignmentTree (
-              location, m2treelib_get_set_field_des (location, op1, field1),
-              (*unop) (location,
-                       m2treelib_get_set_field_rhs (location, op2, field2),
-                       false));
-          fieldNo++;
-          field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
-          field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
-        }
-    }
-}
-
-/* BuildExcludeVarConst - builds the EXCL(op1, 1<<op2) operation for
-   a small sets.  Large sets call this routine to exclude the bit in
-   the particular word.  op2 is a constant.  */
-
-void
-m2statement_BuildExcludeVarConst (location_t location, tree type, tree op1,
-                                  tree op2, bool is_lvalue, int fieldno)
-{
-  tree size = m2expr_GetSizeOf (location, type);
-
-  m2assert_AssertLocation (location);
-  ASSERT_BOOL (is_lvalue);
-  if (m2expr_CompareTrees (
-          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
-      <= 0)
-    {
-      /* Small set size <= TSIZE(WORD).  */
-      m2statement_BuildAssignmentTree (
-          location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
-          m2expr_BuildLogicalAnd (
-              location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
-              m2expr_BuildSetNegate (
-                  location,
-                  m2expr_BuildLSL (location, m2expr_GetWordOne (location), op2,
-                                   false),
-                  false),
-              false));
-    }
-  else
-    {
-      tree fieldlist = TYPE_FIELDS (type);
-      tree field;
-
-      for (field = fieldlist; (field != NULL) && (fieldno > 0);
-           field = TREE_CHAIN (field))
-        fieldno--;
-
-      m2statement_BuildAssignmentTree (
-          location, m2treelib_get_set_field_des (location, op1, field),
-          m2expr_BuildLogicalAnd (
-              location, m2treelib_get_set_field_rhs (location, op1, field),
-              m2expr_BuildSetNegate (
-                  location,
-                  m2expr_BuildLSL (location, m2expr_GetWordOne (location), op2,
-                                   false),
-                  false),
-              false));
-    }
-}
-
-/* BuildExcludeVarVar - builds the EXCL(varset, 1<<varel) operation
-   for a small and large sets.  varel is a variable.  */
-
-void
-m2statement_BuildExcludeVarVar (location_t location, tree type, tree varset,
-                                tree varel, bool is_lvalue, tree low)
-{
-  tree size = m2expr_GetSizeOf (location, type);
-
-  m2assert_AssertLocation (location);
-  ASSERT_BOOL (is_lvalue);
-  /* Calculate the index from the first bit, ie bit 0 represents low value.  */
-  tree index
-      = m2expr_BuildSub (location, m2convert_ToInteger (location, varel),
-                         m2convert_ToInteger (location, low), false);
-
-  if (m2expr_CompareTrees (
-          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
-      <= 0)
-    /* Small set size <= TSIZE(WORD).  */
-    m2statement_BuildAssignmentTree (
-        location, m2treelib_get_rvalue (location, varset, type, is_lvalue),
-        m2expr_BuildLogicalAnd (
-            location, m2treelib_get_rvalue (location, varset, type, is_lvalue),
-            m2expr_BuildSetNegate (
-                location,
-                m2expr_BuildLSL (location, m2expr_GetWordOne (location),
-                                 m2convert_ToWord (location, index), false),
-                false),
-            false));
-  else
-    {
-      tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
-      /* Calculate the index from the first bit.  */
-
-      /* Which word do we need to fetch?  */
-      tree word_index = m2expr_BuildDivTrunc (
-          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE), false);
-      /* Calculate the bit in this word.  */
-      tree offset_into_word = m2expr_BuildModTrunc (
-          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE), false);
-
-      tree v1;
-
-      /* Calculate the address of the word we are interested in.  */
-      p1 = m2expr_BuildAddAddress (
-          location, m2convert_convertToPtr (location, p1),
-          m2expr_BuildMult (
-              location, word_index,
-              m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT),
-              false));
-
-      v1 = m2expr_BuildLogicalAnd (
-          location,
-          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
-          m2expr_BuildSetNegate (
-              location,
-              m2expr_BuildLSL (location, m2expr_GetWordOne (location),
-                               m2convert_ToWord (location, offset_into_word),
-                               false),
-              false),
-          false);
-
-      /* Set bit offset_into_word within the word pointer at by p1.  */
-      m2statement_BuildAssignmentTree (
-          location,
-          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
-          m2convert_ToBitset (location, v1));
-    }
-}
-
-/* BuildIncludeVarConst - builds the INCL(op1, 1<<op2) operation for
-   a small sets.  Large sets call this routine to include the bit in
-   the particular word.  op2 is a constant.  */
-
-void
-m2statement_BuildIncludeVarConst (location_t location, tree type, tree op1,
-                                  tree op2, bool is_lvalue, int fieldno)
-{
-  tree size = m2expr_GetSizeOf (location, type);
-
-  m2assert_AssertLocation (location);
-  ASSERT_BOOL (is_lvalue);
-  if (m2expr_CompareTrees (
-          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
-      <= 0)
-    {
-      /* Small set size <= TSIZE(WORD).  */
-      m2statement_BuildAssignmentTree (
-          location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
-          m2expr_BuildLogicalOr (
-              location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
-              m2expr_BuildLSL (location, m2expr_GetWordOne (location),
-                               m2convert_ToWord (location, op2), false),
-              false));
-    }
-  else
-    {
-      tree fieldlist = TYPE_FIELDS (type);
-      tree field;
-
-      for (field = fieldlist; (field != NULL) && (fieldno > 0);
-           field = TREE_CHAIN (field))
-        fieldno--;
-
-      m2statement_BuildAssignmentTree (
-          location,
-          /* Would like to use: m2expr_BuildComponentRef (location, p, field)
-             but strangely we have to take the address of the field and
-             dereference it to satify the gimplifier.  See
-             testsuite/gm2/pim/pass/timeio?.mod for testcases.  */
-          m2treelib_get_set_field_des (location, op1, field),
-          m2expr_BuildLogicalOr (
-              location, m2treelib_get_set_field_rhs (location, op1, field),
-              m2expr_BuildLSL (location, m2expr_GetWordOne (location),
-                               m2convert_ToWord (location, op2), false),
-              false));
-    }
-}
-
-/* BuildIncludeVarVar - builds the INCL(varset, 1<<varel) operation
-   for a small and large sets.  op2 is a variable.  */
-
-void
-m2statement_BuildIncludeVarVar (location_t location, tree type, tree varset,
-                                tree varel, bool is_lvalue, tree low)
-{
-  tree size = m2expr_GetSizeOf (location, type);
-
-  m2assert_AssertLocation (location);
-  ASSERT_BOOL (is_lvalue);
-  /* Calculate the index from the first bit, ie bit 0 represents low value.  */
-  tree index
-      = m2expr_BuildSub (location, m2convert_ToInteger (location, varel),
-                         m2convert_ToInteger (location, low), false);
-  tree indexw = m2convert_ToWord (location, index);
-
-  if (m2expr_CompareTrees (
-          size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
-      <= 0)
-    /* Small set size <= TSIZE(WORD).  */
-    m2statement_BuildAssignmentTree (
-        location, m2treelib_get_rvalue (location, varset, type, is_lvalue),
-        m2convert_ToBitset (
-            location,
-            m2expr_BuildLogicalOr (
-                location,
-                m2treelib_get_rvalue (location, varset, type, is_lvalue),
-                m2expr_BuildLSL (location, m2expr_GetWordOne (location),
-                                 indexw, false),
-                false)));
-  else
-    {
-      tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
-      /* Which word do we need to fetch?  */
-      tree word_index = m2expr_BuildDivTrunc (
-          location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE), false);
-      /* Calculate the bit in this word.  */
-      tree offset_into_word = m2convert_BuildConvert (
-          location, m2type_GetWordType (),
-          m2expr_BuildModTrunc (location, index,
-                                m2decl_BuildIntegerConstant (SET_WORD_SIZE),
-                                false),
-          false);
-      tree v1;
-
-      /* Calculate the address of the word we are interested in.  */
-      p1 = m2expr_BuildAddAddress (
-          location, m2convert_convertToPtr (location, p1),
-          m2expr_BuildMult (
-              location, word_index,
-              m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT),
-              false));
-      v1 = m2expr_BuildLogicalOr (
-          location,
-          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
-          m2convert_ToBitset (location,
-                              m2expr_BuildLSL (location,
-                                               m2expr_GetWordOne (location),
-                                               offset_into_word, false)),
-          false);
-
-      /* Set bit offset_into_word within the word pointer at by p1.  */
-      m2statement_BuildAssignmentTree (
-          location,
-          m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
-          m2convert_ToBitset (location, v1));
-    }
-}
-
-/* BuildStart - creates a module initialization function.  We make
+/* BuildStart creates a module initialization function.  We make
    this function public if it is not an inner module.  The linker
    will create a call list for all linked modules which determines
    the initialization sequence for all modules.  */
@@ -967,7 +674,7 @@ m2statement_BuildStart (location_t location, char *name, bool inner_module)
   return fndecl;
 }
 
-/* BuildEnd - complete the initialization function for this module.  */
+/* BuildEnd complete the initialization function for this module.  */
 
 void
 m2statement_BuildEnd (location_t location, tree fndecl, bool nested)
@@ -977,7 +684,7 @@ m2statement_BuildEnd (location_t location, tree fndecl, bool nested)
   set_cfun (NULL);
 }
 
-/* BuildCallInner - call the inner module function.  It has no
+/* BuildCallInner call the inner module function.  It has no
    parameters and no return value.  */
 
 void
@@ -990,7 +697,7 @@ m2statement_BuildCallInner (location_t location, tree fndecl)
 }
 
 
-/* BuildIfThenDoEnd - returns a tree which will only execute
+/* BuildIfThenDoEnd returns a tree which will only execute
    statement, s, if, condition, is true.  */
 
 tree
@@ -1003,7 +710,7 @@ m2statement_BuildIfThenDoEnd (tree condition, tree then_block)
                         alloc_stmt_list ());
 }
 
-/* BuildIfThenElseEnd - returns a tree which will execute then_block
+/* BuildIfThenElseEnd returns a tree which will execute then_block
    or else_block depending upon, condition.  */
 
 tree
@@ -1017,8 +724,8 @@ m2statement_BuildIfThenElseEnd (tree condition, tree then_block,
                         else_block);
 }
 
-/* BuildReturnValueCode - generates the code associated with: RETURN(
-   value ) */
+/* BuildReturnValueCode generates the code associated with:
+   RETURN ( value ).  */
 
 void
 m2statement_BuildReturnValueCode (location_t location, tree fndecl, tree value)
@@ -1037,41 +744,45 @@ m2statement_BuildReturnValueCode (location_t location, tree fndecl, tree value)
   add_stmt (location, ret_stmt);
 }
 
-/* DoJump - jump to the appropriate label depending whether result of
-   the expression is true or false.  */
+/* IfExprJump if expr then jump to the label.  */
 
 void
-m2statement_DoJump (location_t location, tree exp, char *falselabel,
-                    char *truelabel)
+m2statement_IfExprJump (location_t location, tree exp, char *label)
 {
-  tree c = NULL_TREE;
+  tree if_jump;
 
   m2assert_AssertLocation (location);
   if (TREE_CODE (TREE_TYPE (exp)) != BOOLEAN_TYPE)
     exp = convert_loc (location, m2type_GetBooleanType (), exp);
 
-  if ((falselabel != NULL) && (truelabel == NULL))
-    {
-      m2block_push_statement_list (m2block_begin_statement_list ());
+  m2block_push_statement_list (m2block_begin_statement_list ());
+  m2statement_BuildGoto (location, label);
+  if_jump = build3 (COND_EXPR, void_type_node, exp,
+		    m2block_pop_statement_list (),
+		    alloc_stmt_list ());
+  add_stmt (location, if_jump);
+}
 
-      m2statement_BuildGoto (location, falselabel);
-      c = build3 (COND_EXPR, void_type_node, exp,
-                  m2block_pop_statement_list (),
-                  alloc_stmt_list ());
-    }
-  else if ((falselabel == NULL) && (truelabel != NULL))
-    {
-      m2block_push_statement_list (m2block_begin_statement_list ());
 
-      m2statement_BuildGoto (location, truelabel);
-      c = build3 (COND_EXPR, void_type_node, exp,
-                  m2block_pop_statement_list (),
-                  alloc_stmt_list ());
-    }
-  else
-    error_at (location, "expecting one and only one label to be declared");
-  if (c != NULL_TREE)
-    add_stmt (location, c);
+/* IfBitInSetJump if bit in set jump to label.  */
+
+void
+m2statement_IfBitInSetJump (location_t location, bool invertCondition,
+			    tree setvalue, tree bit, char *label)
+{
+  tree condition;
+
+  condition = m2expr_BuildNotEqualTo (location,
+				      m2expr_BuildLogicalAnd (location,
+							      m2expr_BuildLSL (location,
+									       m2expr_GetWordOne (location),
+									       bit, false),
+							      setvalue),
+				      m2expr_GetWordZero (location)) ;
+  if (invertCondition)
+    condition = m2expr_BuildEqualTo (location, condition,
+				     m2type_GetBooleanFalse ());
+  m2statement_IfExprJump (location, condition, label);
 }
 
 #include "gt-m2-m2statement.h"
diff --git a/gcc/m2/gm2-gcc/m2statement.def b/gcc/m2/gm2-gcc/m2statement.def
index ffaf69784ee..fbb578f40aa 100644
--- a/gcc/m2/gm2-gcc/m2statement.def
+++ b/gcc/m2/gm2-gcc/m2statement.def
@@ -24,14 +24,14 @@ DEFINITION MODULE FOR "C" m2statement ;
 FROM gcctypes IMPORT location_t, tree ;
 FROM CDataTypes IMPORT CharStar ;
 FROM m2expr IMPORT BuildUnarySetFunction ;
+FROM SYSTEM IMPORT ADDRESS ;
 
 
 (*
-   DoJump - jump to the appropriate label depending whether
-            result of the expression is TRUE or FALSE.
+   IfExprJump - if expr then jump to the label.
 *)
 
-PROCEDURE DoJump (location: location_t; exp: tree; falselabel, truelabel: CharStar) ;
+PROCEDURE IfExprJump (location: location_t; exp: tree; label: ADDRESS) ;
 
 
 (*
@@ -221,19 +221,6 @@ PROCEDURE BuildAsm (location: location_t; instr: tree;
                     inputs: tree; outputs: tree; trash: tree; labels: tree) ;
 
 
-(*
-    BuildUnaryForeachWordDo - provides the large set operators.
-                              Each word (or less) of the set can be
-                              calculated by unop.
-                              This procedure iterates over each word
-                              of the large set invoking the unop.
-*)
-
-PROCEDURE BuildUnaryForeachWordDo (location: location_t; type: tree; op1: tree; op2: tree;
-                                   unop: BuildUnarySetFunction;
-                                   is_op1lvalue, is_op2lvalue, is_op1const, is_op2const: BOOLEAN) ;
-
-
 (*
     BuildExcludeVarConst - builds the EXCL(op1, 1<<op2) operation for a small sets. Large
                            sets call this routine to exclude the bit in the particular word.
@@ -326,4 +313,12 @@ PROCEDURE BuildBuiltinCallTree (func: tree) : tree ;
 PROCEDURE CopyByField (location: location_t; des, expr: tree) ;
 
 
+(*
+   IfBitInSetJump - if bit in set jump to label.
+*)
+
+PROCEDURE IfBitInSetJump (location: location_t; invertCondition: BOOLEAN;
+                          setvalue, bit: tree; label: ADDRESS) ;
+
+
 END m2statement.
diff --git a/gcc/m2/gm2-gcc/m2statement.h b/gcc/m2/gm2-gcc/m2statement.h
index 0076b32dc8e..4cb6a67c655 100644
--- a/gcc/m2/gm2-gcc/m2statement.h
+++ b/gcc/m2/gm2-gcc/m2statement.h
@@ -52,10 +52,6 @@ EXTERN void m2statement_BuildExcludeVarVar (location_t location, tree type,
 EXTERN void m2statement_BuildExcludeVarConst (location_t location, tree type,
                                               tree op1, tree op2,
                                               bool is_lvalue, int fieldno);
-EXTERN void m2statement_BuildUnaryForeachWordDo (
-    location_t location, tree type, tree op1, tree op2,
-    tree (*unop) (location_t, tree, bool), bool is_op1lvalue, bool is_op2lvalue,
-    bool is_op1const, bool is_op2const);
 EXTERN void m2statement_BuildAsm (location_t location, tree instr,
                                   bool isVolatile, bool isSimple, tree inputs,
                                   tree outputs, tree trash, tree labels);
@@ -88,8 +84,7 @@ EXTERN void m2statement_BuildEndFunctionCode (location_t location, tree fndecl,
 EXTERN void m2statement_BuildStartFunctionCode (location_t location,
                                                 tree fndecl, bool isexported,
                                                 bool isinline);
-EXTERN void m2statement_DoJump (location_t location, tree exp,
-                                char *falselabel, char *truelabel);
+EXTERN void m2statement_IfExprJump (location_t location, tree exp, char *label);
 EXTERN tree m2statement_BuildCall2 (location_t location, tree function,
                                     tree rettype, tree arg1, tree arg2);
 EXTERN tree m2statement_BuildCall3 (location_t location, tree function,
@@ -108,6 +103,8 @@ EXTERN tree m2statement_BuildBuiltinCallTree (tree func);
 EXTERN tree m2statement_BuildTryFinally (location_t location, tree call,
                                          tree cleanups);
 EXTERN tree m2statement_BuildCleanUp (tree param);
+EXTERN void m2statement_IfBitInSetJump (location_t location, bool invertCondition,
+					tree setvalue, tree bit, char *label);
 EXTERN void m2statement_CopyByField (location_t location, tree des, tree expr);
 
 #undef EXTERN
diff --git a/gcc/m2/gm2-gcc/m2treelib.cc b/gcc/m2/gm2-gcc/m2treelib.cc
index 7e542db7b76..b054aa9fcbd 100644
--- a/gcc/m2/gm2-gcc/m2treelib.cc
+++ b/gcc/m2/gm2-gcc/m2treelib.cc
@@ -45,7 +45,7 @@ m2treelib_do_jump_if_bit (location_t location, enum tree_code code, tree word,
 {
   word = m2convert_ToWord (location, word);
   bit = m2convert_ToWord (location, bit);
-  m2statement_DoJump (
+  m2statement_IfExprJump (
       location,
       m2expr_build_binary_op (
           location, code,
@@ -55,7 +55,7 @@ m2treelib_do_jump_if_bit (location_t location, enum tree_code code, tree word,
                                FALSE),
               FALSE),
           m2expr_GetWordZero (location), FALSE),
-      NULL, label);
+      label);
 }
 
 /* build_modify_expr - taken from c-typeck.cc and heavily pruned.
@@ -147,8 +147,8 @@ m2treelib_build_modify_expr (location_t location, tree des,
 
 /* nCount - return the number of trees chained on, t.  */
 
-static int
-nCount (tree t)
+int
+m2treelib_nCount (tree t)
 {
   int i = 0;
 
@@ -167,7 +167,7 @@ tree
 m2treelib_DoCall (location_t location, tree rettype, tree funcptr,
                   tree param_list)
 {
-  int n = nCount (param_list);
+  int n = m2treelib_nCount (param_list);
   tree *argarray = XALLOCAVEC (tree, n);
   tree l = param_list;
   int i;
@@ -229,18 +229,6 @@ m2treelib_DoCall3 (location_t location, tree rettype, tree funcptr, tree arg0,
   return build_call_array_loc (location, rettype, funcptr, 3, argarray);
 }
 
-/* get_rvalue - returns the rvalue of t.  The, type, is the object
-   type to be copied upon indirection.  */
-
-tree
-m2treelib_get_rvalue (location_t location, tree t, tree type, bool is_lvalue)
-{
-  if (is_lvalue)
-    return m2expr_BuildIndirect (location, t, type);
-  else
-    return t;
-}
-
 /* get_field_no - returns the field no for, op.  The, op, is either a
    constructor or a variable of type record.  If, op, is a
    constructor (a set constant in GNU Modula-2) then this function is
diff --git a/gcc/m2/gm2-gcc/m2treelib.def b/gcc/m2/gm2-gcc/m2treelib.def
index 4b7c61ad950..ae489a0c5af 100644
--- a/gcc/m2/gm2-gcc/m2treelib.def
+++ b/gcc/m2/gm2-gcc/m2treelib.def
@@ -78,14 +78,6 @@ PROCEDURE get_set_value (location: location_t; p: tree; field: tree; is_const: B
 PROCEDURE get_field_no (type: tree; op: tree; is_const: BOOLEAN; fieldNo: CARDINAL) : tree ;
 
 
-(*
-    get_rvalue - returns the rvalue of t. The, type, is the object type to be
-                 copied upon indirection.
-*)
-
-PROCEDURE get_rvalue (location: location_t; t: tree; type: tree; is_lvalue: BOOLEAN) : tree ;
-
-
 (*
     DoCall - build a call tree arranging the parameter list as a vector.
 *)
@@ -105,4 +97,11 @@ PROCEDURE build_modify_expr (location: location_t; des: tree; modifycode: tree_c
 PROCEDURE do_jump_if_bit (location: location_t; code: tree_code; word: tree; bit: tree; label: ADDRESS) ;
 
 
+(*
+   nCount - return the number of trees chained.
+*)
+
+PROCEDURE nCount (t: tree) : INTEGER ;
+
+
 END m2treelib.
diff --git a/gcc/m2/gm2-gcc/m2treelib.h b/gcc/m2/gm2-gcc/m2treelib.h
index d751fbb8c61..a56df2566fb 100644
--- a/gcc/m2/gm2-gcc/m2treelib.h
+++ b/gcc/m2/gm2-gcc/m2treelib.h
@@ -41,8 +41,6 @@ EXTERN tree m2treelib_DoCall2 (location_t location, tree rettype, tree funcptr,
                                tree arg0, tree arg1);
 EXTERN tree m2treelib_DoCall3 (location_t location, tree rettype, tree funcptr,
                                tree arg0, tree arg1, tree arg2);
-EXTERN tree m2treelib_get_rvalue (location_t location, tree t, tree type,
-                                  bool is_lvalue);
 EXTERN tree m2treelib_get_field_no (tree type, tree op, bool is_const,
                                     unsigned int fieldNo);
 EXTERN tree m2treelib_get_set_value (location_t location, tree p, tree field,
@@ -61,6 +59,7 @@ EXTERN tree m2treelib_get_set_field_des (location_t location, tree p,
 
 EXTERN tree add_stmt (location_t location, tree t);
 EXTERN tree build_stmt (location_t loc, enum tree_code code, ...);
+EXTERN int m2treelib_nCount (tree t);
 
 #undef EXTERN
 #endif /* m2treelib_h.  */
diff --git a/gcc/m2/gm2-gcc/m2type.cc b/gcc/m2/gm2-gcc/m2type.cc
index e486f12004f..184b506aa69 100644
--- a/gcc/m2/gm2-gcc/m2type.cc
+++ b/gcc/m2/gm2-gcc/m2type.cc
@@ -50,12 +50,11 @@ struct GTY (()) struct_constructor
   /* Constructor_fields, the list of fields belonging to
      constructor_type.  Used by SET and RECORD constructors.  */
   tree GTY ((skip (""))) constructor_fields;
-  /* Constructor_element_list, the list of constants used by SET and
-     RECORD constructors.  */
-  tree GTY ((skip (""))) constructor_element_list;
-  /* Constructor_elements, used by an ARRAY initializer all elements
-     are held in reverse order.  */
+  /* Constructor_elements, used by an ARRAY, RECORD and SET initializer
+     all elements are held in reverse order.  */
   vec<constructor_elt, va_gc> *constructor_elements;
+  /* The next byte_index to be used when adding set bytes to an array.  */
+  int byte_index;
   /* Level, the next level down in the constructor stack.  */
   struct struct_constructor *level;
 };
@@ -243,8 +242,9 @@ m2type_BuildEndArrayType (tree arraytype, tree elementtype, tree indextype,
     return gm2_finish_build_array_type (arraytype, ptr_type_node, indextype,
                                         type);
   else
-    return gm2_finish_build_array_type (
-        arraytype, m2tree_skip_type_decl (elementtype), indextype, type);
+    return gm2_finish_build_array_type (arraytype,
+       m2tree_skip_type_decl (elementtype),
+       indextype, type);
 }
 
 /* gm2_build_array_type returns a type which is an array indexed by
@@ -330,7 +330,8 @@ static tree
 build_m2_type_node_by_array (tree arrayType, tree low, tree high, int fetype)
 {
   return gm2_build_array_type (arrayType,
-                               m2type_BuildArrayIndexType (low, high), fetype);
+                               m2type_BuildArrayIndexType (low, high),
+			       fetype);
 }
 
 /* build_m2_word16_type_node build an ISO 16 bit word as an ARRAY
@@ -893,6 +894,17 @@ m2type_GetBooleanType (void)
 #endif /* !USE_BOOLEAN  */
 }
 
+/* GetBooleanEnumList return a list containing boolean fields true and false.  */
+
+tree
+m2type_GetBooleanEnumList (location_t location)
+{
+  tree list = NULL;
+  m2type_BuildEnumerator (location, "TRUE", m2type_GetBooleanTrue (), &list);
+  m2type_BuildEnumerator (location, "FALSE", m2type_GetBooleanTrue (), &list);
+  return list;
+}
+
 /* GetCardinalAddressType returns the internal data type for
    computing binary arithmetic upon the ADDRESS datatype.  */
 
@@ -1892,7 +1904,7 @@ m2type_GetDefaultType (location_t location, char *name, tree type)
 }
 
 /* IsGccRealType return true if type is a GCC realtype.  */
-  
+
 static
 bool
 IsGccRealType (tree type)
@@ -1935,7 +1947,7 @@ m2type_GetMinFrom (location_t location, tree type)
   return TYPE_MIN_VALUE (m2tree_skip_type_decl (type));
 }
 
-static      
+static
 tree
 do_max_real (tree type)
 {
@@ -2201,7 +2213,7 @@ gm2_build_enumerator (location_t location, tree name, tree value)
    enumvalues, list.  It returns a copy of the value.  */
 
 tree
-m2type_BuildEnumerator (location_t location, char *name, tree value,
+m2type_BuildEnumerator (location_t location, const char *name, tree value,
                         tree *enumvalues)
 {
   tree id = get_identifier (name);
@@ -2274,8 +2286,8 @@ pop_constructor (struct struct_constructor *p)
   top_constructor = top_constructor->level;
 }
 
-/* BuildStartSetConstructor starts to create a set constant.
-   Remember that type is really a record type.  */
+/* BuildStartSetConstructor starts to create a wide set constant.
+   A wide set type will be implemented as an array type (array [0..max] OF BYTE).  */
 
 void *
 m2type_BuildStartSetConstructor (tree type)
@@ -2285,36 +2297,32 @@ m2type_BuildStartSetConstructor (tree type)
   type = m2tree_skip_type_decl (type);
   layout_type (type);
   p->constructor_type = type;
-  p->constructor_fields = TYPE_FIELDS (type);
-  p->constructor_element_list = NULL_TREE;
+  p->constructor_fields = TREE_TYPE (type);
+  p->byte_index = 0;
   vec_alloc (p->constructor_elements, 1);
   return (void *)p;
 }
 
-/* BuildSetConstructorElement adds, value, to the
-   constructor_element_list.  */
+/* BuildSetConstructorElement adds value to the constructor_elements.  */
 
 void
-m2type_BuildSetConstructorElement (void *p, tree value)
+m2type_BuildSetConstructorElement (location_t location, void *p, tree value)
 {
   struct struct_constructor *c = (struct struct_constructor *)p;
+  constructor_elt celt;
 
-  if (value == NULL_TREE)
-    {
-      internal_error ("set type cannot be initialized with a %qs",
-		      "NULL_TREE");
-      return;
-    }
-
-  if (c->constructor_fields == NULL)
+  if (c->constructor_fields == NULL_TREE)
     {
-      internal_error ("set type does not take another integer value");
+      internal_error ("set type must be initialized");
       return;
     }
 
-  c->constructor_element_list
-      = tree_cons (c->constructor_fields, value, c->constructor_element_list);
-  c->constructor_fields = TREE_CHAIN (c->constructor_fields);
+  value = m2convert_BuildConvert (location, c->constructor_fields,
+				  value, FALSE);
+  celt.index = m2decl_BuildIntegerConstant (c->byte_index);
+  celt.value = value;
+  c->byte_index++;
+  vec_safe_push (c->constructor_elements, celt);
 }
 
 /* BuildEndSetConstructor finishes building a set constant.  */
@@ -2322,24 +2330,13 @@ m2type_BuildSetConstructorElement (void *p, tree value)
 tree
 m2type_BuildEndSetConstructor (void *p)
 {
-  tree constructor;
-  tree link;
   struct struct_constructor *c = (struct struct_constructor *)p;
+  tree constructor =
+    build_constructor (c->constructor_type, c->constructor_elements);
 
-  for (link = c->constructor_element_list; link; link = TREE_CHAIN (link))
-    {
-      tree field = TREE_PURPOSE (link);
-      DECL_SIZE (field) = bitsize_int (SET_WORD_SIZE);
-      DECL_BIT_FIELD (field) = 1;
-    }
-
-  constructor = build_constructor_from_list (
-      c->constructor_type, nreverse (c->constructor_element_list));
-  TREE_CONSTANT (constructor) = 1;
-  TREE_STATIC (constructor) = 1;
-
+  TREE_CONSTANT (constructor) = true;
+  TREE_STATIC (constructor) = true;
   pop_constructor (c);
-
   return constructor;
 }
 
@@ -2355,11 +2352,30 @@ m2type_BuildStartRecordConstructor (tree type)
   layout_type (type);
   p->constructor_type = type;
   p->constructor_fields = TYPE_FIELDS (type);
-  p->constructor_element_list = NULL_TREE;
   vec_alloc (p->constructor_elements, 1);
   return (void *)p;
 }
 
+/* build_record_constructor build and return a record constructor of type
+   record_type from the ordered values in vals.  */
+
+static
+tree
+build_record_constructor (tree record_type, vec<constructor_elt, va_gc> *vals)
+{
+  tree field_init;
+  unsigned int i;
+  vec<constructor_elt, va_gc> *v = NULL;
+  tree field_type = first_field (record_type);
+  FOR_EACH_CONSTRUCTOR_VALUE (vals, i, field_init)
+    {
+      CONSTRUCTOR_APPEND_ELT (v, field_type, field_init);
+      field_type = DECL_CHAIN (field_type);
+    }
+  return build_constructor (record_type, v);
+}
+
+
 /* BuildEndRecordConstructor returns a tree containing the record
    compound literal.  */
 
@@ -2367,23 +2383,32 @@ tree
 m2type_BuildEndRecordConstructor (void *p)
 {
   struct struct_constructor *c = (struct struct_constructor *)p;
-  tree constructor = build_constructor_from_list (
-      c->constructor_type, nreverse (c->constructor_element_list));
-  TREE_CONSTANT (constructor) = 1;
-  TREE_STATIC (constructor) = 1;
-
+  tree constructor = build_record_constructor (c->constructor_type,
+					       c->constructor_elements);
+  TREE_CONSTANT (constructor) = true;
+  TREE_STATIC (constructor) = true;
   pop_constructor (c);
-
   return constructor;
 }
 
 /* BuildRecordConstructorElement adds, value, to the
-   constructor_element_list.  */
+   constructor_elements.  */
 
 void
 m2type_BuildRecordConstructorElement (void *p, tree value)
 {
-  m2type_BuildSetConstructorElement (p, value);
+  struct struct_constructor *c = (struct struct_constructor *)p;
+  constructor_elt celt;
+
+  if (c->constructor_fields == NULL_TREE)
+    {
+      internal_error ("record type must be initialized");
+      return;
+    }
+  celt.index = m2decl_BuildIntegerConstant (c->byte_index);
+  celt.value = value;
+  c->byte_index++;
+  vec_safe_push (c->constructor_elements, celt);
 }
 
 /* BuildStartArrayConstructor initializes an array compound
@@ -2398,7 +2423,6 @@ m2type_BuildStartArrayConstructor (tree type)
   layout_type (type);
   p->constructor_type = type;
   p->constructor_fields = TREE_TYPE (type);
-  p->constructor_element_list = NULL_TREE;
   vec_alloc (p->constructor_elements, 1);
   return (void *)p;
 }
@@ -2416,14 +2440,12 @@ m2type_BuildEndArrayConstructor (void *p)
       = build_constructor (c->constructor_type, c->constructor_elements);
   TREE_CONSTANT (constructor) = true;
   TREE_STATIC (constructor) = true;
-
   pop_constructor (c);
-
   return constructor;
 }
 
 /* BuildArrayConstructorElement adds, value, to the
-   constructor_element_list.  */
+   constructor_elements.  */
 
 void
 m2type_BuildArrayConstructorElement (void *p, tree value, tree indice)
diff --git a/gcc/m2/gm2-gcc/m2type.def b/gcc/m2/gm2-gcc/m2type.def
index f74888e315e..8a72652f22c 100644
--- a/gcc/m2/gm2-gcc/m2type.def
+++ b/gcc/m2/gm2-gcc/m2type.def
@@ -136,7 +136,7 @@ PROCEDURE BuildEndSetConstructor (p: Constructor) : tree ;
     BuildSetConstructorElement - adds, value, to the constructor_element_list.
 *)
 
-PROCEDURE BuildSetConstructorElement (p: Constructor; value: tree) ;
+PROCEDURE BuildSetConstructorElement (location: location_t; p: Constructor; value: tree) ;
 
 
 (*
@@ -796,7 +796,7 @@ PROCEDURE BuildArrayStringConstructor (location: location_t; arrayType: tree; st
 
 
 (*
-    RealToTree - convert a real number into a Tree.
+    RealToTree - convert a real number into a tree.
 *)
 
 PROCEDURE RealToTree (name: CharStar) : tree ;
@@ -962,7 +962,8 @@ PROCEDURE GetArrayNoOfElements (location: location_t; arraytype: tree) : tree ;
                        and which has ElementType elements.
 *)
 
-PROCEDURE BuildEndArrayType (arraytype: tree; elementtype: tree; indextype: tree; type: INTEGER) : tree ;
+PROCEDURE BuildEndArrayType (arraytype: tree; elementtype: tree;
+                             indextype: tree; type: INTEGER) : tree ;
 
 
 (*
@@ -1004,4 +1005,11 @@ PROCEDURE SameRealType (a, b: tree) : BOOLEAN ;
 PROCEDURE IsGccStrictTypeEquivalent (left, right: tree) : BOOLEAN ;
 
 
+(*
+   GetBooleanEnumList - return a list containing boolean fields true and false.
+*)
+
+PROCEDURE GetBooleanEnumList (location: location_t) : tree ;
+
+
 END m2type.
diff --git a/gcc/m2/gm2-gcc/m2type.h b/gcc/m2/gm2-gcc/m2type.h
index 663af3ce7eb..68015a01e14 100644
--- a/gcc/m2/gm2-gcc/m2type.h
+++ b/gcc/m2/gm2-gcc/m2type.h
@@ -183,14 +183,14 @@ EXTERN tree m2type_BuildStartEnumeration (location_t location, char *name,
                                           bool ispacked);
 EXTERN tree m2type_BuildEndEnumeration (location_t location, tree enumtype,
                                         tree enumvalues);
-EXTERN tree m2type_BuildEnumerator (location_t location, char *name,
+EXTERN tree m2type_BuildEnumerator (location_t location, const char *name,
                                     tree value, tree *enumvalues);
 EXTERN tree m2type_BuildPointerType (tree totype);
 EXTERN tree m2type_BuildConstPointerType (tree totype);
 EXTERN tree m2type_BuildSetType (location_t location, char *name, tree type,
                                  tree lowval, tree highval, bool ispacked);
 EXTERN void *m2type_BuildStartSetConstructor (tree type);
-EXTERN void m2type_BuildSetConstructorElement (void *p, tree value);
+EXTERN void m2type_BuildSetConstructorElement (location_t location, void *p, tree value);
 EXTERN tree m2type_BuildEndSetConstructor (void *p);
 EXTERN void *m2type_BuildStartRecordConstructor (tree type);
 EXTERN tree m2type_BuildEndRecordConstructor (void *p);
@@ -214,6 +214,7 @@ EXTERN bool m2type_IsAddress (tree type);
 EXTERN tree m2type_GetCardinalAddressType (void);
 EXTERN bool m2type_SameRealType (tree a, tree b);
 EXTERN bool m2type_IsGccStrictTypeEquivalent (tree left, tree right);
+EXTERN tree m2type_GetBooleanEnumList (location_t location);
 
 #undef EXTERN
 #endif /* m2type_h  */
diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc
index cc074d550fc..c90c7138099 100644
--- a/gcc/m2/gm2-lang.cc
+++ b/gcc/m2/gm2-lang.cc
@@ -692,6 +692,12 @@ gm2_langhook_handle_option (
     case OPT_fgen_module_list_:
       M2Options_SetGenModuleList (value, arg);
       return 1;
+    case OPT_fmem_report:
+      M2Options_SetMemReport (value);
+      return 1;
+    case OPT_ftime_report:
+      M2Options_SetTimeReport (value);
+      return 1;
     case OPT_fnil:
       M2Options_SetNilCheck (value);
       return 1;
@@ -915,6 +921,11 @@ gm2_langhook_handle_option (
     case OPT_fm2_whole_program:
       M2Options_SetWholeProgram (value);
       return 1;
+      break;
+    case OPT_fwideset:
+      M2Options_SetWideset (value);
+      return 1;
+      break;
 #ifdef OPT_mabi_ibmlongdouble
     case OPT_mabi_ibmlongdouble:
       M2Options_SetIBMLongDouble (value);
diff --git a/gcc/m2/gm2-libs-coroutines/SYSTEM.def b/gcc/m2/gm2-libs-coroutines/SYSTEM.def
index ea982e8ffa7..ea3ee93d7d7 100644
--- a/gcc/m2/gm2-libs-coroutines/SYSTEM.def
+++ b/gcc/m2/gm2-libs-coroutines/SYSTEM.def
@@ -41,10 +41,7 @@ EXPORT QUALIFIED (* the following are built into the compiler: *)
                  (* The rest are implemented in SYSTEM.mod.  *)
                  PROCESS, TRANSFER, NEWPROCESS, IOTRANSFER,
                  LISTEN,
-                 ListenLoop, TurnInterrupts,
-                 (* Internal GM2 compiler functions.  *)
-                 ShiftVal, ShiftLeft, ShiftRight,
-                 RotateVal, RotateLeft, RotateRight ;
+                 ListenLoop, TurnInterrupts ;
 
 
 TYPE
@@ -192,87 +189,4 @@ PROCEDURE TBITSIZE (<type>) : CARDINAL ;
   *)
 *)
 
-(* The following procedures are invoked by GNU Modula-2 to
-   shift non word sized set types.  They are not strictly part
-   of the core PIM Modula-2, however they are used
-   to implement the SHIFT procedure defined above,
-   which are in turn used by the Logitech compatible libraries.
-
-   Users will access these procedures by using the procedure
-   SHIFT above and GNU Modula-2 will map SHIFT onto one of
-   the following procedures.
-*)
-
-(*
-   ShiftVal - is a runtime procedure whose job is to implement
-              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
-              inline a SHIFT of a single WORD sized set and will
-              only call this routine for larger sets.
-*)
-
-PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
-                    SetSizeInBits: CARDINAL;
-                    ShiftCount: INTEGER) ;
-
-
-(*
-   ShiftLeft - performs the shift left for a multi word set.
-               This procedure might be called by the back end of
-               GNU Modula-2 depending whether amount is known at
-               compile time.
-*)
-
-PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     ShiftCount: CARDINAL) ;
-
-(*
-   ShiftRight - performs the shift left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known at
-                compile time.
-*)
-
-PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     ShiftCount: CARDINAL) ;
-
-
-(*
-   RotateVal - is a runtime procedure whose job is to implement
-               the ROTATE procedure of ISO SYSTEM.  GNU Modula-2 will
-               inline a ROTATE of a single WORD (or less)
-               sized set and will only call this routine for
-               larger sets.
-*)
-
-PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     RotateCount: INTEGER) ;
-
-
-(*
-   RotateLeft - performs the rotate left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known
-                at compile time.
-*)
-
-PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
-                      SetSizeInBits: CARDINAL;
-                      RotateCount: CARDINAL) ;
-
-
-(*
-   RotateRight - performs the rotate right for a multi word set.
-                 This procedure might be called by the back end of
-                 GNU Modula-2 depending whether amount is known at
-                 compile time.
-*)
-
-PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
-                       SetSizeInBits: CARDINAL;
-                       RotateCount: CARDINAL) ;
-
-
 END SYSTEM.
diff --git a/gcc/m2/gm2-libs-coroutines/SYSTEM.mod b/gcc/m2/gm2-libs-coroutines/SYSTEM.mod
index 63b4ecb3b48..6a71083dbd4 100644
--- a/gcc/m2/gm2-libs-coroutines/SYSTEM.mod
+++ b/gcc/m2/gm2-libs-coroutines/SYSTEM.mod
@@ -27,9 +27,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 IMPLEMENTATION MODULE SYSTEM ;
 
 FROM RTco IMPORT init, initThread, transfer, currentThread, turnInterrupts ;
-
-FROM RTint IMPORT Listen, AttachVector,
-                  IncludeVector, ExcludeVector ;
+FROM RTint IMPORT Listen, AttachVector, IncludeVector, ExcludeVector ;
 
 IMPORT RTint ;
 
@@ -60,8 +58,6 @@ VAR
 *)
 
 PROCEDURE TRANSFER (VAR p1: PROCESS; p2: PROCESS) ;
-VAR
-   r: INTEGER ;
 BEGIN
    localMain (p1) ;
    IF p1.context=p2.context
@@ -104,14 +100,13 @@ END NEWPROCESS ;
 
 PROCEDURE IOTRANSFER (VAR First, Second: PROCESS; InterruptNo: CARDINAL) ;
 VAR
-   p: IOTransferState ;
-   l: POINTER TO IOTransferState ;
+   iots: IOTransferState ;
 BEGIN
    localMain (First) ;
-   WITH p DO
+   WITH iots DO
       ptrToFirst  := ADR (First) ;
       ptrToSecond := ADR (Second) ;
-      next        := AttachVector (InterruptNo, ADR (p))
+      next        := AttachVector (InterruptNo, ADR (iots))
    END ;
    IncludeVector (InterruptNo) ;
    TRANSFER (First, Second)
@@ -124,18 +119,18 @@ END IOTRANSFER ;
 
 PROCEDURE IOTransferHandler (InterruptNo: CARDINAL;
                              Priority: CARDINAL ;
-                             l: PtrToIOTransferState) ;
+                             piots: PtrToIOTransferState) ;
 VAR
    old: PtrToIOTransferState ;
 BEGIN
-   IF l=NIL
+   IF piots = NIL
    THEN
       Halt ('no processes attached to this interrupt vector which is associated with IOTRANSFER',
             __FILE__, __FUNCTION__, __LINE__)
    ELSE
-      WITH l^ DO
+      WITH piots^ DO
          old := AttachVector (InterruptNo, next) ;
-         IF old#l
+         IF old # piots
          THEN
             Halt ('inconsistancy of return result',
                   __FILE__, __FUNCTION__, __LINE__)
@@ -250,236 +245,6 @@ BEGIN
 END localMain ;
 
 
-(*
-   Max - returns the maximum of a and b.
-*)
-
-PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
-BEGIN
-   IF a > b
-   THEN
-      RETURN a
-   ELSE
-      RETURN b
-   END
-END Max ;
-
-
-(*
-   Min - returns the minimum of a and b.
-*)
-
-PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
-BEGIN
-   IF a < b
-   THEN
-      RETURN a
-   ELSE
-      RETURN b
-   END
-END Min ;
-
-
-(*
-   ShiftVal - is a runtime procedure whose job is to implement
-              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
-              inline a SHIFT of a single WORD sized set and will only
-              call this routine for larger sets.
-*)
-
-PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
-                    SetSizeInBits: CARDINAL;
-                    ShiftCount: INTEGER) ;
-VAR
-   a: ADDRESS ;
-BEGIN
-   IF ShiftCount>0
-   THEN
-      ShiftCount := ShiftCount MOD VAL(INTEGER, SetSizeInBits) ;
-      ShiftLeft (s, d, SetSizeInBits, ShiftCount)
-   ELSIF ShiftCount<0
-   THEN
-      ShiftCount := (-ShiftCount) MOD VAL(INTEGER, SetSizeInBits) ;
-      ShiftRight (s, d, SetSizeInBits, ShiftCount)
-   ELSE
-      a := memcpy (ADR (d), ADR (s), (HIGH (d) + 1) * SIZE (BITSET))
-   END
-END ShiftVal ;
-
-
-(*
-   ShiftLeft - performs the shift left for a multi word set.
-               This procedure might be called by the back end of
-               GNU Modula-2 depending whether amount is known at compile
-               time.
-*)
-
-PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     ShiftCount: CARDINAL) ;
-VAR
-   lo, hi : BITSET ;
-   i, j, h: CARDINAL ;
-   a      : ADDRESS ;
-BEGIN
-   h := HIGH(s)+1 ;
-   IF ShiftCount MOD BitsPerBitset=0
-   THEN
-      i := ShiftCount DIV BitsPerBitset ;
-      a := ADR (d[i]) ;
-      a := memcpy (a, ADR (s), (h-i) * SIZE (BITSET)) ;
-      a := memset (ADR (d), 0, i * SIZE (BITSET))
-   ELSE
-      i := h ;
-      WHILE i>0 DO
-         DEC (i) ;
-         lo := SHIFT (s[i], ShiftCount MOD BitsPerBitset) ;
-         hi := SHIFT (s[i], -(BitsPerBitset - (ShiftCount MOD BitsPerBitset))) ;
-         d[i] := BITSET{} ;
-         j := i + ShiftCount DIV BitsPerBitset ;
-         IF j<h
-         THEN
-            d[j] := d[j] + lo ;
-            INC(j) ;
-            IF j<h
-            THEN
-               d[j] := d[j] + hi
-            END
-         END
-      END
-   END
-END ShiftLeft ;
-
-
-(*
-   ShiftRight - performs the shift left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known at compile
-                time.
-*)
-
-PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
-                      SetSizeInBits: CARDINAL;
-                      ShiftCount: CARDINAL) ;
-VAR
-   lo, hi : BITSET ;
-   j, i, h: INTEGER ;
-   a      : ADDRESS ;
-BEGIN
-   h := HIGH (s) + 1 ;
-   IF ShiftCount MOD BitsPerBitset=0
-   THEN
-      i := ShiftCount DIV BitsPerBitset ;
-      a := ADR (s[i]) ;
-      j := h-i ;
-      a := memcpy (ADR (d), a, j * VAL (INTEGER, SIZE(BITSET))) ;
-      a := ADR (d[j]) ;
-      a := memset (a, 0, i * VAL (INTEGER, SIZE(BITSET)))
-   ELSE
-      i := 0 ;
-      WHILE i<h DO
-         lo := SHIFT(s[i], BitsPerBitset - (ShiftCount MOD BitsPerBitset)) ;
-         hi := SHIFT(s[i], -(ShiftCount MOD BitsPerBitset)) ;
-         d[i] := BITSET{} ;
-         j := i - VAL(INTEGER, ShiftCount DIV BitsPerBitset) ;
-         IF j>=0
-         THEN
-            d[j] := d[j] + hi ;
-            DEC(j) ;
-            IF j>=0
-            THEN
-               d[j] := d[j] + lo
-            END
-         END ;
-         INC(i)
-      END
-   END
-END ShiftRight ;
-
-
-(*
-   RotateVal - is a runtime procedure whose job is to implement
-               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
-               inline a ROTATE of a single WORD (or less)
-               sized set and will only call this routine for larger sets.
-*)
-
-PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     RotateCount: INTEGER) ;
-VAR
-   a: ADDRESS ;
-BEGIN
-   IF RotateCount>0
-   THEN
-      RotateLeft(s, d, SetSizeInBits, RotateCount)
-   ELSIF RotateCount<0
-   THEN
-      RotateRight(s, d, SetSizeInBits, -RotateCount)
-   ELSE
-      a := memcpy(ADR(d), ADR(s), (HIGH(d)+1)*SIZE(BITSET))
-   END
-END RotateVal ;
-
-
-(*
-   RotateLeft - performs the rotate left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known at compile
-                time.
-*)
-
-PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
-                      SetSizeInBits: CARDINAL;
-                      RotateCount: CARDINAL) ;
-VAR
-   lo, hi : BITSET ;
-   b, i, j, h: CARDINAL ;
-BEGIN
-   h := HIGH(s) ;
-   (* firstly we set d := {} *)
-   i := 0 ;
-   WHILE i<=h DO
-      d[i] := BITSET{} ;
-      INC(i)
-   END ;
-   i := h+1 ;
-   RotateCount := RotateCount MOD SetSizeInBits ;
-   b := SetSizeInBits MOD BitsPerBitset ;
-   IF b=0
-   THEN
-      b := BitsPerBitset
-   END ;
-   WHILE i>0 DO
-      DEC(i) ;
-      lo := SHIFT(s[i], RotateCount MOD BitsPerBitset) ;
-      hi := SHIFT(s[i], -(b - (RotateCount MOD BitsPerBitset))) ;
-      j := ((i*BitsPerBitset + RotateCount) MOD
-            SetSizeInBits) DIV BitsPerBitset ;
-      d[j] := d[j] + lo ;
-      j := (((i+1)*BitsPerBitset + RotateCount) MOD
-            SetSizeInBits) DIV BitsPerBitset ;
-      d[j] := d[j] + hi ;
-      b := BitsPerBitset
-   END
-END RotateLeft ;
-
-
-(*
-   RotateRight - performs the rotate right for a multi word set.
-                 This procedure might be called by the back end of
-                 GNU Modula-2 depending whether amount is known at compile
-                 time.
-*)
-
-PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
-                       SetSizeInBits: CARDINAL;
-                       RotateCount: CARDINAL) ;
-BEGIN
-   RotateLeft(s, d, SetSizeInBits, SetSizeInBits-RotateCount)
-END RotateRight ;
-
-
 BEGIN
    initGTh := FALSE ;
    initMain := FALSE
diff --git a/gcc/m2/gm2-libs-iso/SYSTEM.def b/gcc/m2/gm2-libs-iso/SYSTEM.def
index b99b2afdccc..75d19ea2e62 100644
--- a/gcc/m2/gm2-libs-iso/SYSTEM.def
+++ b/gcc/m2/gm2-libs-iso/SYSTEM.def
@@ -20,10 +20,7 @@ EXPORT QUALIFIED BITSPERLOC, LOCSPERWORD,
                  LOC, BYTE, WORD, ADDRESS, CSIZE_T, CSSIZE_T, COFF_T, (* @SYSTEM_DATATYPES@  *)
                  ADDADR, SUBADR, DIFADR, MAKEADR, ADR, ROTATE,
                  SHIFT, CAST, TSIZE,
-
                  (* Internal GM2 compiler functions *)
-                 ShiftVal, ShiftLeft, ShiftRight,
-                 RotateVal, RotateLeft, RotateRight,
                  THROW, TBITSIZE ;
 
 CONST
@@ -155,81 +152,4 @@ PROCEDURE TBITSIZE (<type>) : CARDINAL ;
   *)
 *)
 
-
-(* The following procedures are invoked by GNU Modula-2 to
-   shift non word set types. They are not part of ISO Modula-2
-   but are used to implement the SHIFT procedure defined above. *)
-
-(*
-   ShiftVal - is a runtime procedure whose job is to implement
-              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
-              inline a SHIFT of a single WORD sized set and will only
-              call this routine for larger sets.
-*)
-
-PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
-                    SetSizeInBits: CARDINAL;
-                    ShiftCount: INTEGER) ;
-
-
-(*
-   ShiftLeft - performs the shift left for a multi word set.
-               This procedure might be called by the back end of
-               GNU Modula-2 depending whether amount is known at
-               compile time.
-*)
-
-PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     ShiftCount: CARDINAL) ;
-
-(*
-   ShiftRight - performs the shift left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known at
-                compile time.
-*)
-
-PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     ShiftCount: CARDINAL) ;
-
-
-(*
-   RotateVal - is a runtime procedure whose job is to implement
-               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
-               inline a ROTATE of a single WORD (or less)
-               sized set and will only call this routine for larger
-               sets.
-*)
-
-PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     RotateCount: INTEGER) ;
-
-
-(*
-   RotateLeft - performs the rotate left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known at
-                compile time.
-*)
-
-PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
-                      SetSizeInBits: CARDINAL;
-                      RotateCount: CARDINAL) ;
-
-
-(*
-   RotateRight - performs the rotate right for a multi word set.
-                 This procedure might be called by the back end of
-                 GNU Modula-2 depending whether amount is known at
-                 compile time.
-*)
-
-PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
-                       SetSizeInBits: CARDINAL;
-                       RotateCount: CARDINAL) ;
-
-
 END SYSTEM.
diff --git a/gcc/m2/gm2-libs-iso/SYSTEM.mod b/gcc/m2/gm2-libs-iso/SYSTEM.mod
index cd28b1d7b08..5e146f59abb 100644
--- a/gcc/m2/gm2-libs-iso/SYSTEM.mod
+++ b/gcc/m2/gm2-libs-iso/SYSTEM.mod
@@ -26,248 +26,4 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 IMPLEMENTATION MODULE SYSTEM ;
 
-FROM libc IMPORT memcpy, memset ;
-
-CONST
-   BitsPerBitset = MAX(BITSET)+1 ;
-
-
-(*
-   Max - returns the maximum of a and b.
-*)
-
-PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
-BEGIN
-   IF a>b
-   THEN
-      RETURN a
-   ELSE
-      RETURN b
-   END
-END Max ;
-
-
-(*
-   Min - returns the minimum of a and b.
-*)
-
-PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
-BEGIN
-   IF a<b
-   THEN
-      RETURN a
-   ELSE
-      RETURN b
-   END
-END Min ;
-
-
-(*
-   ShiftVal - is a runtime procedure whose job is to implement
-              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
-              inline a SHIFT of a single WORD sized set and will only
-              call this routine for larger sets.
-*)
-
-PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
-                    SetSizeInBits: CARDINAL;
-                    ShiftCount: INTEGER) ;
-VAR
-   a: ADDRESS ;
-BEGIN
-   IF ShiftCount>0
-   THEN
-      ShiftCount := ShiftCount MOD VAL(INTEGER, SetSizeInBits) ;
-      ShiftLeft(s, d, SetSizeInBits, ShiftCount)
-   ELSIF ShiftCount<0
-   THEN
-      ShiftCount := (-ShiftCount) MOD VAL(INTEGER, SetSizeInBits) ;
-      ShiftRight(s, d, SetSizeInBits, ShiftCount)
-   ELSE
-      a := memcpy(ADR(d), ADR(s), (HIGH(d)+1)*SIZE(BITSET))
-   END
-END ShiftVal ;
-
-
-(*
-   ShiftLeft - performs the shift left for a multi word set.
-               This procedure might be called by the back end of
-               GNU Modula-2 depending whether amount is known at compile
-               time.
-*)
-
-PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     ShiftCount: CARDINAL) ;
-VAR
-   lo, hi : BITSET ;
-   i, j, h: CARDINAL ;
-   a      : ADDRESS ;
-BEGIN
-   h := HIGH(s)+1 ;
-   IF ShiftCount MOD BitsPerBitset=0
-   THEN
-      i := ShiftCount DIV BitsPerBitset ;
-      a := ADR(d[i]) ;
-      a := memcpy(a, ADR(s), (h-i)*SIZE(BITSET)) ;
-      a := memset(ADR(d), 0, i*SIZE(BITSET))
-   ELSE
-      i := h ;
-      WHILE i>0 DO
-         DEC(i) ;
-         lo := SHIFT(s[i], ShiftCount MOD BitsPerBitset) ;
-         hi := SHIFT(s[i], -(BitsPerBitset - (ShiftCount MOD BitsPerBitset))) ;
-         d[i] := BITSET{} ;
-         j := i + ShiftCount DIV BitsPerBitset ;
-         IF j<h
-         THEN
-            d[j] := d[j] + lo ;
-            INC(j) ;
-            IF j<h
-            THEN
-               d[j] := d[j] + hi
-            END
-         END
-      END
-   END
-END ShiftLeft ;
-
-
-(*
-   ShiftRight - performs the shift left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known at compile
-                time.
-*)
-
-PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
-                      SetSizeInBits: CARDINAL;
-                      ShiftCount: CARDINAL) ;
-VAR
-   lo, hi : BITSET ;
-   j, i, h: INTEGER ;
-   a      : ADDRESS ;
-BEGIN
-   h := HIGH(s)+1 ;
-   IF ShiftCount MOD BitsPerBitset=0
-   THEN
-      i := ShiftCount DIV BitsPerBitset ;
-      a := ADR(s[i]) ;
-      j := h-i ;
-      a := memcpy(ADR(d), a, j * VAL (INTEGER, SIZE (BITSET))) ;
-      a := ADR(d[j]) ;
-      a := memset(a, 0, i * VAL (INTEGER, SIZE (BITSET)))
-   ELSE
-      i := 0 ;
-      WHILE i<h DO
-         lo := SHIFT(s[i], BitsPerBitset - (ShiftCount MOD BitsPerBitset)) ;
-         hi := SHIFT(s[i], -(ShiftCount MOD BitsPerBitset)) ;
-         d[i] := BITSET{} ;
-         j := i - VAL(INTEGER, ShiftCount DIV BitsPerBitset) ;
-         IF j>=0
-         THEN
-            d[j] := d[j] + hi ;
-            DEC(j) ;
-            IF j>=0
-            THEN
-               d[j] := d[j] + lo
-            END
-         END ;
-         INC(i)
-      END
-   END
-END ShiftRight ;
-
-
-(*
-   RotateVal - is a runtime procedure whose job is to implement
-               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
-               inline a ROTATE of a single WORD (or less)
-               sized set and will only call this routine for larger sets.
-*)
-
-PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     RotateCount: INTEGER) ;
-VAR
-   a: ADDRESS ;
-BEGIN
-   IF RotateCount>0
-   THEN
-      RotateCount := RotateCount MOD VAL(INTEGER, SetSizeInBits)
-   ELSIF RotateCount<0
-   THEN
-      RotateCount := -VAL(INTEGER, VAL(CARDINAL, -RotateCount) MOD SetSizeInBits)
-   END ;
-   IF RotateCount>0
-   THEN
-      RotateLeft(s, d, SetSizeInBits, RotateCount)
-   ELSIF RotateCount<0
-   THEN
-      RotateRight(s, d, SetSizeInBits, -RotateCount)
-   ELSE
-      (* no rotate required, but we must copy source to dest.  *)
-      a := memcpy(ADR(d), ADR(s), (HIGH(d)+1)*SIZE(BITSET))
-   END
-END RotateVal ;
-
-
-(*
-   RotateLeft - performs the rotate left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known at compile
-                time.
-*)
-
-PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
-                      SetSizeInBits: CARDINAL;
-                      RotateCount: CARDINAL) ;
-VAR
-   lo, hi : BITSET ;
-   b, i, j, h: CARDINAL ;
-BEGIN
-   h := HIGH(s) ;
-   (* firstly we set d := {} *)
-   i := 0 ;
-   WHILE i<=h DO
-      d[i] := BITSET{} ;
-      INC(i)
-   END ;
-   i := h+1 ;
-   RotateCount := RotateCount MOD SetSizeInBits ;
-   b := SetSizeInBits MOD BitsPerBitset ;
-   IF b=0
-   THEN
-      b := BitsPerBitset
-   END ;
-   WHILE i>0 DO
-      DEC(i) ;
-      lo := SHIFT(s[i], RotateCount MOD BitsPerBitset) ;
-      hi := SHIFT(s[i], -(b - (RotateCount MOD BitsPerBitset))) ;
-      j := ((i*BitsPerBitset + RotateCount) MOD
-            SetSizeInBits) DIV BitsPerBitset ;
-      d[j] := d[j] + lo ;
-      j := (((i+1)*BitsPerBitset + RotateCount) MOD
-            SetSizeInBits) DIV BitsPerBitset ;
-      d[j] := d[j] + hi ;
-      b := BitsPerBitset
-   END
-END RotateLeft ;
-
-
-(*
-   RotateRight - performs the rotate right for a multi word set.
-                 This procedure might be called by the back end of
-                 GNU Modula-2 depending whether amount is known at compile
-                 time.
-*)
-
-PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
-                       SetSizeInBits: CARDINAL;
-                       RotateCount: CARDINAL) ;
-BEGIN
-   RotateLeft(s, d, SetSizeInBits, SetSizeInBits-RotateCount)
-END RotateRight ;
-
-
 END SYSTEM.
diff --git a/gcc/m2/gm2-libs/M2Diagnostic.def b/gcc/m2/gm2-libs/M2Diagnostic.def
new file mode 100644
index 00000000000..77a2d62364a
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2Diagnostic.def
@@ -0,0 +1,182 @@
+(* M2Diagnotic provides memory and time diagnosics to the user.
+
+Copyright (C) 2024 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/>.  *)
+
+DEFINITION MODULE M2Diagnostic ;  (*!m2iso+gm2*)
+
+(*
+    Title      : M2Diagnotic
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Thu Jan  4 10:38:53 2024
+    Revision   : $Version$
+    Description: provides memory and time diagnosics to the user.
+*)
+
+FROM DynamicStrings IMPORT String ;
+
+TYPE
+   Diagnostic ;
+   DiagProc = PROCEDURE (Diagnostic) ;
+
+
+(*
+   InitTimeDiagnostic - create and return a time diagnostic.
+                        The format string can be free form and may
+                        contain {1T}, {1C} or {1P}.
+                        {1T} will contain the time and
+                        {1C} the count of the number of times the
+                        code enters the time diagnostic code region.
+                        {1P} generates the time as a percentage.
+                        {0T} is the total time for the application.
+                        {{ is rendered as a single {.
+*)
+
+PROCEDURE InitTimeDiagnostic (name, format: ARRAY OF CHAR) : Diagnostic ;
+
+
+(*
+   EnterDiagnostic - attribute all execution time from now to TimeDiag.
+*)
+
+PROCEDURE EnterDiagnostic (TimeDiag: Diagnostic) ;
+
+
+(*
+   ExitDiagnostic - stop attributing execution time to TimeDiag.
+*)
+
+PROCEDURE ExitDiagnostic (TimeDiag: Diagnostic) ;
+
+
+(*
+   InitMemDiagnostic - create and return a memory diagnostic.
+                       The format string can be free form and may
+                       contain {1M} {1d} {1x} {1P}.
+                       {1M} is replaced by the value of the first parameter
+                       with memory size units.
+                       {1d} unsigned decimal.  {1x} unsigned hexadecimal.
+                       {0M} is the global allocation (Storage.mod:ALLOCATE).
+                       {1P} is the percentage of param 1 relative
+                       to global memory.
+*)
+
+PROCEDURE InitMemDiagnostic (name, format: ARRAY OF CHAR) : Diagnostic ;
+
+
+(*
+   MemIncr - allow the appropriate parameter to be incremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*)
+
+PROCEDURE MemIncr (MemDiag: Diagnostic; paramno: CARDINAL; incr: CARDINAL) ;
+
+
+(*
+   MemDecr - allow the appropriate parameter to be decremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*)
+
+PROCEDURE MemDecr (MemDiag: Diagnostic; paramno: CARDINAL; decr: CARDINAL) ;
+
+
+(*
+   MemSet - allow the appropriate parameter to be set to value.
+            All parameters are initially set to zero.
+*)
+
+PROCEDURE MemSet (MemDiag: Diagnostic; paramno: CARDINAL; value: CARDINAL) ;
+
+
+(*
+   TotalHeapIncr - increments the total heap used.
+*)
+
+PROCEDURE TotalHeapIncr (incr: CARDINAL) ;
+
+
+(*
+   TotalHeapDecr - decrements the total heap used.
+*)
+
+PROCEDURE TotalHeapDecr (incr: CARDINAL) ;
+
+
+(*
+   SetEnable - set the enable flag in Diag to value.
+*)
+
+PROCEDURE SetEnable (Diag: Diagnostic; value: BOOLEAN) ;
+
+
+(*
+   Lookup - returns the Diagnostic containing name or NIL
+            if it does not exist.
+*)
+
+PROCEDURE Lookup (name: ARRAY OF CHAR) : Diagnostic ;
+
+
+(*
+   GetName - returns the name of Diag.
+*)
+
+PROCEDURE GetName (Diag: Diagnostic) : String ;
+
+
+(*
+   ForeachDiagDo - for diag in global diag list do
+                      dp (diag);
+                   end
+*)
+
+PROCEDURE ForeachDiagDo (dp: DiagProc) ;
+
+
+(*
+   SetDefaultConfig - force the Diag enable flag to the
+                      time or mem global default.
+*)
+
+PROCEDURE SetDefaultConfig (Diag: Diagnostic) ;
+
+
+(*
+   Configure - will turn on or off all the memory or time
+               instrumentation diagnostics and set the defaults
+               time and mem values.
+*)
+
+PROCEDURE Configure (time, mem: BOOLEAN) ;
+
+
+(*
+   Generate - return a string containing the output from
+              all the diagnostics enabled.  If hierarchical is TRUE
+              then the output is displayed in a hierarchical format
+              using the name and ':' separators to signify grouping.
+*)
+
+PROCEDURE Generate (hierarchical: BOOLEAN) : String ;
+
+
+END M2Diagnostic.
diff --git a/gcc/m2/gm2-libs/M2Diagnostic.mod b/gcc/m2/gm2-libs/M2Diagnostic.mod
new file mode 100644
index 00000000000..25988602d3e
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2Diagnostic.mod
@@ -0,0 +1,1049 @@
+(* M2Diagnotic provides memory and time diagnosics to the user.
+
+Copyright (C) 2024 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/>.  *)
+
+IMPLEMENTATION MODULE M2Diagnostic ;  (*!m2iso+gm2*)
+
+FROM ASCII IMPORT nl ;
+FROM Selective IMPORT Timeval, GetTimeOfDay, InitTime, GetTime, SetTime ;
+FROM StringConvert IMPORT LongCardinalToString, ctos ;
+FROM Storage IMPORT ALLOCATE ;
+FROM Indexing IMPORT Index ;
+
+FROM DynamicStrings IMPORT InitString, ConCat, KillString, ConCatChar,
+                           Equal, Mark, Length, char, RIndex ;
+
+IMPORT DynamicStrings, Indexing ;
+
+
+CONST
+   EnableDiagnostics = TRUE ;    (* If set to FALSE then it will ensure
+                                    this module has minimal impact upon
+                                    the rest of the application.   *)
+   DefaultTimeEnableValue = FALSE ;  (* Should the diagnostics be
+                                        enabled by default.  *)
+   DefaultMemEnableValue = FALSE ;  (* Should the diagnostics be
+                                       enabled by default.  *)
+
+   MaxParam = 4 ;   (* The maximum number of parameters for a mem
+                       diag.  *)
+   MICROSEC = 1000 * 1000 ;   (* The number of microseconds in a second.  *)
+
+TYPE
+   Diagnostic = POINTER TO RECORD
+                              name, format: String ;
+                              enable      : BOOLEAN ;
+                              next        : Diagnostic ;
+                              CASE type: DiagType OF
+
+                              timediag: tdiag: timeDiag |
+                              memdiag : mdiag: memDiag
+
+                              END
+                            END ;
+
+   DiagType = (timediag, memdiag) ;
+
+   timeDiag = RECORD
+                 count: CARDINAL ;
+                 total,
+                 enter,
+                 exit : Timeval ;
+              END ;
+
+   memDiag = RECORD
+                param: ARRAY [1..MaxParam] OF LONGCARD ;
+             END ;
+
+VAR
+   Output            : String ;
+   TotalHeap         : LONGCARD ;
+   Head              : Diagnostic ;
+   EnableHierarchical,
+   DefaultTimeEnable,
+   DefaultMemEnable  : BOOLEAN ;
+   StartTime,
+   TotalTime         : Timeval ;
+
+
+(*
+   Assert - halt if b is false.
+*)
+
+PROCEDURE Assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      HALT
+   END
+END Assert ;
+
+
+(*
+   Error - generate a error simple message with indicating the
+           format specifier ch is incorrect.
+*)
+
+PROCEDURE Error (msg: ARRAY OF CHAR; ch: CHAR) ;
+BEGIN
+   HALT
+END Error ;
+
+
+(*
+   InitTimeDiagnostic - create and return a time diagnostic.
+                        The format string can be free form and may
+                        contain {1T}, {1C} or {1P}.
+                        {1T} will contain the time and
+                        {1C} the count of the number of times the
+                        code enters the time diagnostic code region.
+                        {1P} generates the time as a percentage.
+                        {0T} is the total time for the application.
+                        {{ is rendered as a single {.
+*)
+
+PROCEDURE InitTimeDiagnostic (name, format: ARRAY OF CHAR) : Diagnostic ;
+VAR
+   d: Diagnostic ;
+BEGIN
+   IF EnableDiagnostics
+   THEN
+      NEW (d) ;
+      d^.name := InitString (name) ;
+      d^.format := InitString (format) ;
+      WITH d^ DO
+         enable := DefaultTimeEnable ;
+         next := Head ;
+         type := timediag ;
+         CASE type OF
+
+         timediag: tdiag.count := 0 ;
+                   tdiag.total := InitTime (0, 0) ;
+                   tdiag.enter := InitTime (0, 0) ;
+                   tdiag.exit  := InitTime (0, 0)
+
+         ELSE
+            HALT
+         END
+      END ;
+      Head := d ;
+      RETURN d
+   ELSE
+      RETURN NIL
+   END
+END InitTimeDiagnostic ;
+
+
+(*
+   EnterDiagnostic - attribute all execution time from now to TimeDiag.
+*)
+
+PROCEDURE EnterDiagnostic (TimeDiag: Diagnostic) ;
+BEGIN
+   IF EnableDiagnostics AND (TimeDiag # NIL)
+   THEN
+      Assert (TimeDiag^.type = timediag) ;
+      Assert (GetTimeOfDay (TimeDiag^.tdiag.enter) = 0) ;
+      INC (TimeDiag^.tdiag.count)
+   END
+END EnterDiagnostic ;
+
+
+(*
+   ExitDiagnostic - stop attributing execution time to TimeDiag.
+*)
+
+PROCEDURE ExitDiagnostic (TimeDiag: Diagnostic) ;
+BEGIN
+   IF EnableDiagnostics AND (TimeDiag # NIL)
+   THEN
+      Assert (TimeDiag^.tdiag.enter # NIL) ;
+      Assert (TimeDiag^.tdiag.exit # NIL) ;
+      Assert (TimeDiag^.tdiag.total # NIL) ;
+      Assert (TimeDiag^.type = timediag) ;
+      Assert (GetTimeOfDay (TimeDiag^.tdiag.exit) = 0) ;
+      Accumulate (TimeDiag^.tdiag.total, TimeDiag^.tdiag.enter, TimeDiag^.tdiag.exit)
+   END
+END ExitDiagnostic ;
+
+
+(*
+   Accumulate - total := total + exit - enter
+*)
+
+PROCEDURE Accumulate (total, enter, exit: Timeval) ;
+BEGIN
+   IncTime (total, exit) ;
+   DecTime (total, enter)
+END Accumulate ;
+
+
+(*
+   IncTime - left := left + right.
+*)
+
+PROCEDURE IncTime (left, right: Timeval) ;
+VAR
+   lsec, lusec,
+   rsec, rusec: CARDINAL ;
+BEGIN
+   GetTime (left, lsec, lusec) ;
+   GetTime (right, rsec, rusec) ;
+   IF lusec + rusec < MICROSEC
+   THEN
+      (* No carry  *)
+      INC (lusec, rusec) ;
+      INC (lsec, rsec)
+   ELSE
+      INC (lusec, rusec) ;
+      DEC (lusec, MICROSEC) ;
+      INC (lsec, rsec + 1)
+   END ;
+   SetTime (left, lsec, lusec)
+END IncTime ;
+
+
+(*
+   DecTime - left := left - right.
+*)
+
+PROCEDURE DecTime (left, right: Timeval) ;
+VAR
+   lsec, lusec,
+   rsec, rusec: CARDINAL ;
+BEGIN
+   GetTime (left, lsec, lusec) ;
+   GetTime (right, rsec, rusec) ;
+   IF lusec >= rusec
+   THEN
+      (* No borrow.  *)
+      DEC (lusec, rusec) ;
+      IF lsec >= rsec
+      THEN
+         DEC (lsec, rsec)
+      ELSE
+         lsec := 0
+      END
+   ELSE
+      IF lsec > 0
+      THEN
+         INC (lusec, MICROSEC) ;
+         DEC (lusec, rusec) ;
+         DEC (lsec) ;
+         IF lsec >= rsec
+         THEN
+            DEC (lsec, rsec)
+         ELSE
+            lsec := 0
+         END
+      ELSE
+         lsec := 0 ;
+         lusec := 0
+      END
+   END ;
+   SetTime (left, lsec, lusec)
+END DecTime ;
+
+
+(*
+   InitMemDiagnostic - create and return a memory diagnostic.
+                       The format string can be free form and may
+                       contain {1M} {1d} {1x} {1P}.
+                       {1M} is replaced by the value of the first parameter
+                       with memory size units.
+                       {1d} unsigned decimal.  {1x} unsigned hexadecimal.
+                       {0M} is the global allocation (Storage.mod:ALLOCATE).
+                       {1P} is the percentage of param 1 relative
+                       to global memory.
+*)
+
+PROCEDURE InitMemDiagnostic (name, format: ARRAY OF CHAR) : Diagnostic ;
+VAR
+   i: CARDINAL ;
+   d: Diagnostic ;
+BEGIN
+   IF EnableDiagnostics
+   THEN
+      NEW (d) ;
+      d^.name := InitString (name) ;
+      d^.format := InitString (format) ;
+      WITH d^ DO
+         enable := DefaultMemEnable ;
+         next := Head ;
+         type := memdiag ;
+         CASE type OF
+
+         memdiag: FOR i := 1 TO MaxParam DO
+                     mdiag.param[i] := 0
+                  END
+
+         ELSE
+            HALT
+         END
+      END ;
+      Head := d ;
+      RETURN d
+   ELSE
+      RETURN NIL
+   END
+END InitMemDiagnostic ;
+
+
+(*
+   CheckParam -
+*)
+
+PROCEDURE CheckParam (paramno: CARDINAL) ;
+BEGIN
+   IF (paramno < 1) OR (paramno > MaxParam)
+   THEN
+      HALT
+   END
+END CheckParam ;
+
+
+(*
+   MemIncr - allow the appropriate parameter to be incremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*)
+
+PROCEDURE MemIncr (MemDiag: Diagnostic; paramno: CARDINAL; incr: CARDINAL) ;
+BEGIN
+   IF EnableDiagnostics AND (MemDiag # NIL)
+   THEN
+      CheckParam (paramno) ;
+      CASE MemDiag^.type OF
+
+      memdiag:  INC (MemDiag^.mdiag.param[paramno], VAL (LONGCARD, incr))
+
+      ELSE
+         HALT
+      END
+   END
+END MemIncr ;
+
+
+(*
+   MemDecr - allow the appropriate parameter to be decremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*)
+
+PROCEDURE MemDecr (MemDiag: Diagnostic; paramno: CARDINAL; decr: CARDINAL) ;
+BEGIN
+   IF EnableDiagnostics AND (MemDiag # NIL)
+   THEN
+      CheckParam (paramno) ;
+      CASE MemDiag^.type OF
+
+      memdiag:  DEC (MemDiag^.mdiag.param[paramno], VAL (LONGCARD, decr))
+
+      ELSE
+         HALT
+      END
+   END
+END MemDecr ;
+
+
+(*
+   MemSet - allow the appropriate parameter to be set to value.
+            All parameters are initially set to zero.
+*)
+
+PROCEDURE MemSet (MemDiag: Diagnostic; paramno: CARDINAL; value: CARDINAL) ;
+BEGIN
+   IF EnableDiagnostics AND (MemDiag # NIL)
+   THEN
+      CheckParam (paramno) ;
+      CASE MemDiag^.type OF
+
+      memdiag:  MemDiag^.mdiag.param[paramno] := VAL (LONGCARD, value)
+
+      ELSE
+         HALT
+      END
+   END
+END MemSet ;
+
+
+(*
+   TotalHeapIncr - increments the total heap used.
+*)
+
+PROCEDURE TotalHeapIncr (incr: CARDINAL) ;
+BEGIN
+   IF EnableDiagnostics
+   THEN
+      TotalHeap := TotalHeap + VAL (LONGCARD, incr)
+   END
+END TotalHeapIncr ;
+
+
+(*
+   TotalHeapDecr - decrements the total heap used.
+*)
+
+PROCEDURE TotalHeapDecr (incr: CARDINAL) ;
+BEGIN
+   IF EnableDiagnostics
+   THEN
+      TotalHeap := TotalHeap - VAL (LONGCARD, incr)
+   END
+END TotalHeapDecr ;
+
+
+(*
+   SetEnable - set the enable flag in Diag to value.
+*)
+
+PROCEDURE SetEnable (Diag: Diagnostic; value: BOOLEAN) ;
+BEGIN
+   IF EnableDiagnostics AND (Diag # NIL)
+   THEN
+      Diag^.enable := value
+   END
+END SetEnable ;
+
+
+(*
+   Lookup - returns the Diagnostic containing name or NIL
+            if it does not exist.
+*)
+
+PROCEDURE Lookup (name: ARRAY OF CHAR) : Diagnostic ;
+VAR
+   ptr: Diagnostic ;
+   s  : String ;
+BEGIN
+   IF EnableDiagnostics
+   THEN
+      s := InitString (name) ;
+      ptr := Head ;
+      WHILE ptr # NIL DO
+         IF Equal (ptr^.name, s)
+         THEN
+            s := KillString (s) ;
+            RETURN ptr
+         END ;
+         ptr := ptr^.next
+      END ;
+      s := KillString (s) ;
+      RETURN NIL
+   ELSE
+      RETURN NIL
+   END
+END Lookup ;
+
+
+(*
+   ForeachDiagDo - for diag in global diag list do
+                      dp (diag);
+                   end
+*)
+
+PROCEDURE ForeachDiagDo (dp: DiagProc) ;
+VAR
+   ptr: Diagnostic ;
+BEGIN
+   ptr := Head ;
+   WHILE ptr # NIL DO
+      dp (ptr) ;
+      ptr := ptr^.next
+   END
+END ForeachDiagDo ;
+
+
+(*
+   SetDefaultConfig - force the Diag enable flag to the
+                      time or mem global default.
+*)
+
+PROCEDURE SetDefaultConfig (Diag: Diagnostic) ;
+BEGIN
+   IF Diag^.type = timediag
+   THEN
+      Diag^.enable := DefaultTimeEnable
+   ELSE
+      Diag^.enable := DefaultMemEnable
+   END
+END SetDefaultConfig ;
+
+
+(*
+   Configure - will turn on or off all the memory or time
+               instrumentation diagnostics and set the defaults
+               time and mem values.
+*)
+
+PROCEDURE Configure (time, mem: BOOLEAN) ;
+BEGIN
+   IF EnableDiagnostics
+   THEN
+      DefaultTimeEnable := time ;
+      DefaultMemEnable := mem ;
+      ForeachDiagDo (SetDefaultConfig)
+   END
+END Configure ;
+
+
+(*
+   CreateStartTime -
+*)
+
+PROCEDURE CreateStartTime ;
+BEGIN
+   IF EnableDiagnostics
+   THEN
+      IF StartTime = NIL
+      THEN
+         StartTime := InitTime (0, 0) ;
+         IF GetTimeOfDay (StartTime) = 0
+         THEN
+         END
+      END ;
+      IF TotalTime = NIL
+      THEN
+         TotalTime := InitTime (0, 0)
+      END
+   ELSE
+      StartTime := NIL ;
+      TotalTime := NIL
+   END
+END CreateStartTime ;
+
+
+(*
+   UpdateTotalTime -
+*)
+
+PROCEDURE UpdateTotalTime ;
+BEGIN
+   IF GetTimeOfDay (TotalTime) = 0
+   THEN
+   END ;
+   DecTime (TotalTime, StartTime)
+END UpdateTotalTime ;
+
+
+(*
+   GetTimeParam - a paramno of 0 will return the total time so far
+                  whereas a paramno > 0 will return the time associated
+                  with Diag.
+*)
+
+PROCEDURE GetTimeParam (Diag: Diagnostic; paramno: CARDINAL) : Timeval ;
+VAR
+   sec, usec: CARDINAL ;
+BEGIN
+   IF paramno = 0
+   THEN
+      UpdateTotalTime ;
+      RETURN TotalTime
+   ELSE
+      RETURN Diag^.tdiag.total
+   END
+END GetTimeParam ;
+
+
+(*
+   GetMemParam - return the mem paramno from within Diag.  A paramno of 0
+                 will return the total heap.
+*)
+
+PROCEDURE GetMemParam (Diag: Diagnostic; paramno: CARDINAL) : LONGCARD ;
+BEGIN
+   IF paramno = 0
+   THEN
+      RETURN TotalHeap
+   ELSE
+      RETURN Diag^.mdiag.param[paramno]
+   END
+END GetMemParam ;
+
+
+(*
+   CreateDecimalMem - converts c to a decimal string.
+*)
+
+PROCEDURE CreateDecimalMem (c: LONGCARD) : String ;
+BEGIN
+   RETURN LongCardinalToString (c, 0, ' ', 10, TRUE)
+END CreateDecimalMem ;
+
+
+(*
+   CreateHexadecimalMem - converts c to a hexadecimal string.
+*)
+
+PROCEDURE CreateHexadecimalMem (c: LONGCARD) : String ;
+BEGIN
+   RETURN ConCat (InitString ('0x'),
+                  Mark (LongCardinalToString (c, 0, ' ', 16, TRUE)))
+END CreateHexadecimalMem ;
+
+
+(*
+   CreateDecimalTime - return timeval as a decimal seconds.usecs string.
+*)
+
+PROCEDURE CreateDecimalTime (timeval: Timeval) : String ;
+VAR
+   sec, usec: CARDINAL ;
+BEGIN
+   GetTime (timeval, sec, usec) ;
+   RETURN ConCat (ConCat (LongCardinalToString (sec, 0, ' ', 10, TRUE),
+                          Mark (InitString ('.'))),
+                  LongCardinalToString (usec, 6, '0', 10, TRUE))
+END CreateDecimalTime ;
+
+
+(*
+   CreateHexadecimalTime - return timeval as a hexadecimal seconds.usecs string.
+*)
+
+PROCEDURE CreateHexadecimalTime (timeval: Timeval) : String ;
+VAR
+   sec, usec: CARDINAL ;
+BEGIN
+   GetTime (timeval, sec, usec) ;
+   RETURN ConCat (ConCat (LongCardinalToString (sec, 0, ' ', 16, TRUE),
+                          Mark (InitString ('.'))),
+                  LongCardinalToString (usec, 5, '0', 16, TRUE))
+END CreateHexadecimalTime ;
+
+
+(*
+   Decimal - convert paramno in Diag to a string.
+*)
+
+PROCEDURE Decimal (Diag: Diagnostic; paramno: CARDINAL) : String ;
+BEGIN
+   CASE Diag^.type OF
+
+   memdiag :  RETURN CreateDecimalMem (GetMemParam (Diag, paramno)) |
+   timediag:  RETURN CreateDecimalTime (GetTimeParam (Diag, paramno))
+
+   END ;
+   RETURN NIL
+END Decimal ;
+
+
+(*
+   Hexadecimal - convert paramno in Diag to a hex string.
+*)
+
+PROCEDURE Hexadecimal (Diag: Diagnostic; paramno: CARDINAL) : String ;
+BEGIN
+   CASE Diag^.type OF
+
+   memdiag :  RETURN CreateHexadecimalMem (GetMemParam (Diag, paramno)) |
+   timediag:  RETURN CreateHexadecimalTime (GetTimeParam (Diag, paramno))
+
+   END ;
+   RETURN NIL
+END Hexadecimal ;
+
+
+(*
+   Count - return the count field for a time diag or return the decimal
+           value for a paramno in a mem diag.
+*)
+
+PROCEDURE Count (Diag: Diagnostic; paramno: CARDINAL) : String ;
+BEGIN
+   CASE Diag^.type OF
+
+   memdiag :  RETURN CreateDecimalMem (GetMemParam (Diag, paramno)) |
+   timediag:  RETURN ctos (Diag^.tdiag.count, 0, ' ')
+
+   END ;
+   RETURN NIL
+END Count ;
+
+
+(*
+   Microsec - convert timeval into microseconds and return the value as
+              a longcard.
+*)
+
+PROCEDURE Microsec (timeval: Timeval) : LONGCARD ;
+VAR
+   sec, usec: CARDINAL ;
+   microsec : LONGCARD ;
+BEGIN
+   GetTime (timeval, sec, usec) ;
+   microsec := VAL (LONGCARD, sec) * MICROSEC + VAL (LONGCARD, usec) ;
+   RETURN microsec
+END Microsec ;
+
+
+(*
+   CreateTimePercent - return timeval as a percentage of the TotalTime.
+*)
+
+PROCEDURE CreateTimePercent (timeval: Timeval) : String ;
+VAR
+   total, param: LONGCARD ;
+BEGIN
+   IF timeval = TotalTime
+   THEN
+      param := 100
+   ELSE
+      UpdateTotalTime ;
+      param := Microsec (timeval) * 100 ;
+      total := Microsec (TotalTime) ;
+      IF total = 0
+      THEN
+         param := 0
+      ELSE
+         param := param DIV total
+      END
+   END ;
+   RETURN ConCatChar (ctos (VAL (CARDINAL, param), 3, ' '), '%')
+END CreateTimePercent ;
+
+
+(*
+   CreateMemPercent - return memval as a percentage of TotalHeap.
+*)
+
+PROCEDURE CreateMemPercent (memval: LONGCARD) : String ;
+VAR
+   param: LONGCARD ;
+BEGIN
+   IF memval = TotalHeap
+   THEN
+      param := 100
+   ELSE
+      param := memval * 100 ;
+      IF TotalHeap = 0
+      THEN
+         param := 0
+      ELSE
+         param := param DIV TotalHeap
+      END
+   END ;
+   RETURN ConCatChar (ctos (VAL (CARDINAL, param), 3, ' '), '%')
+END CreateMemPercent ;
+
+
+(*
+   DescribePercent - call the appropriate mem or time percentage procedure.
+*)
+
+PROCEDURE DescribePercent (Diag: Diagnostic; paramno: CARDINAL) : String ;
+BEGIN
+   CASE Diag^.type OF
+
+   memdiag :  RETURN CreateMemPercent (GetMemParam (Diag, paramno)) |
+   timediag:  RETURN CreateTimePercent (GetTimeParam (Diag, paramno))
+
+   END ;
+   RETURN NIL
+END DescribePercent ;
+
+
+(*
+   DescribeMemory - return the memory diagnostic
+*)
+
+PROCEDURE DescribeMemory (Diag: Diagnostic; paramno: CARDINAL) : String ;
+CONST
+   kilo = 1024 ;
+   mega = kilo * kilo ;
+   giga = mega * kilo ;
+VAR
+   param: LONGCARD ;
+   s    : String ;
+BEGIN
+   param := GetMemParam (Diag, paramno) ;
+   IF param < kilo
+   THEN
+      s := ConCat (LongCardinalToString (param, 0, ' ', 10, FALSE),
+                   Mark (InitString (' Bytes')))
+   ELSIF param < mega
+   THEN
+      param := param DIV kilo ;
+      s := ConCat (LongCardinalToString (param, 0, ' ', 10, FALSE),
+                   Mark (InitString ('KB')))
+   ELSIF param < giga
+   THEN
+      param := param DIV mega ;
+      s := ConCat (LongCardinalToString (param, 0, ' ', 10, FALSE),
+                   Mark (InitString ('MB')))
+   ELSE
+      param := param DIV giga ;
+      s := ConCat (LongCardinalToString (param, 0, ' ', 10, FALSE),
+                   Mark (InitString ('GB')))
+   END ;
+   RETURN s
+END DescribeMemory ;
+
+
+(*
+   DescribeTime - returns the time diagnostic in seconds.
+*)
+
+PROCEDURE DescribeTime (Diag: Diagnostic; paramno: CARDINAL) : String ;
+VAR
+   sec, usec: CARDINAL ;
+BEGIN
+   CASE Diag^.type OF
+
+   memdiag :  HALT |
+   timediag:  GetTime (GetTimeParam (Diag, paramno), sec, usec) ;
+              RETURN ConCat (ConCat (LongCardinalToString (sec, 0, ' ', 10, TRUE),
+                                     Mark (InitString ('.'))),
+                             ConCat (LongCardinalToString (usec, 6, '0', 10, TRUE),
+                                     Mark (InitString (' sec'))))
+
+   END ;
+   RETURN NIL
+END DescribeTime ;
+
+
+(*
+   ParamSpec - ebnf:
+
+               ( '{' | '0' | '1' | '2' | '3' | '4' )
+               ( 'd' | 'x' | 'C' | 'H' | 'T' | 'M' | 'N' | 'P' )
+               '}'
+*)
+
+PROCEDURE ParamSpec (Diag: Diagnostic; i: CARDINAL) : CARDINAL ;
+VAR
+   paramno,
+   length : CARDINAL ;
+   ch     : CHAR ;
+BEGIN
+   length := Length (Diag^.format) ;
+   paramno := 0 ;
+   IF i < length
+   THEN
+      ch := char (Diag^.format, i) ;
+      CASE ch OF
+
+      '{':  Output := ConCatChar (Output, '{') ;
+            RETURN i + 1 |
+      '0':  paramno := 0 |
+      '1':  paramno := 1 |
+      '2':  paramno := 2 |
+      '3':  paramno := 3 |
+      '4':  paramno := 4
+
+      ELSE
+         Error ('unexpected character: ', ch)
+      END ;
+      INC (i) ;
+      IF i < length
+      THEN
+         ch := char (Diag^.format, i) ;
+         CASE ch OF
+
+         'd':  Output := ConCat (Output, Decimal (Diag, paramno)) |
+         'x':  Output := ConCat (Output, Hexadecimal (Diag, paramno)) |
+         'C':  Output := ConCat (Output, Count (Diag, paramno)) |
+         'H':  Output := ConCat (Output, HierarchicalName (Diag, i)) |
+         'M':  Output := ConCat (Output, DescribeMemory (Diag, paramno)) |
+         'N':  Output := ConCat (Output, Diag^.name) |
+         'P':  Output := ConCat (Output, DescribePercent (Diag, paramno)) |
+         'T':  Output := ConCat (Output, DescribeTime (Diag, paramno))
+
+         ELSE
+            Error ('unexpected character: ', ch)
+         END ;
+         INC (i) ;
+         IF i < length
+         THEN
+            ch := char (Diag^.format, i) ;
+            IF ch # '}'
+            THEN
+               Error ('expected } character, seen ', ch)
+            END
+         END
+      END
+   END ;
+   RETURN i + 1
+END ParamSpec ;
+
+
+(*
+   HierarchicalName - if the hierarchical formatting of output
+                      has been enabled use the last component
+                      of the name separated by ':' else
+                      output full name.
+*)
+
+PROCEDURE HierarchicalName (Diag: Diagnostic; pos: CARDINAL) : String ;
+VAR
+   i, j: INTEGER ;
+BEGIN
+   IF EnableHierarchical
+   THEN
+      i := DynamicStrings.Index (Diag^.name, '}', pos) ;
+      IF i > 0
+      THEN
+         j := i - 1 ;
+         i := RIndex (Diag^.name, ':', j) ;
+         IF (i >= 0) AND (i < j)
+         THEN
+            RETURN DynamicStrings.Slice (Diag^.name, i, j)
+         END
+      END
+   END ;
+   RETURN Diag^.name
+END HierarchicalName ;
+
+
+(*
+   FormatDiag - ebnf:
+
+                { ( '{' ParamSpec ) | any }
+*)
+
+PROCEDURE FormatDiag (Diag: Diagnostic) ;
+VAR
+   i, length: CARDINAL ;
+   ch       : CHAR ;
+BEGIN
+   i := 0 ;
+   length := Length (Diag^.format) ;
+   WHILE i < length DO
+      ch := char (Diag^.format, i) ;
+      IF ch = '{'
+      THEN
+         INC (i) ;
+         i := ParamSpec (Diag, i)
+      ELSE
+         Output := ConCatChar (Output, ch) ;
+         INC (i)
+      END
+   END ;
+   Output := ConCatChar (Output, nl)
+END FormatDiag ;
+
+
+(*
+   GetName - returns the name of Diag.
+*)
+
+PROCEDURE GetName (Diag: Diagnostic) : String ;
+BEGIN
+   IF EnableDiagnostics AND (Diag # NIL)
+   THEN
+      RETURN Diag^.name
+   ELSE
+      RETURN NIL
+   END
+END GetName ;
+
+
+(*
+   Match -
+*)
+
+PROCEDURE Match (stem, name: String) : BOOLEAN ;
+BEGIN
+   RETURN TRUE
+END Match ;
+
+
+(*
+   HierarchicalDiag - iterate over every diagnostic using a depth first search
+                      for each component of the diagnostic name.
+*)
+
+PROCEDURE HierarchicalDiag (stem: String; visited: Index) : String ;
+VAR
+   diag: Diagnostic ;
+BEGIN
+   diag := Head ;
+   WHILE diag # NIL DO
+      IF NOT Indexing.IsIndiceInIndex (visited, diag)
+      THEN
+         IF Match (stem, diag^.name)
+         THEN
+            Indexing.IncludeIndiceIntoIndex (visited, diag)
+         END
+      END ;
+      diag := diag^.next
+   END ;
+   RETURN Output
+END HierarchicalDiag ;
+
+
+(*
+   GenerateRaw - return the output string after calling FormatDiag on
+                 every diagnostic rule.
+*)
+
+PROCEDURE GenerateRaw () : String ;
+BEGIN
+   ForeachDiagDo (FormatDiag) ;
+   RETURN Output
+END GenerateRaw ;
+
+
+(*
+   GenerateHierarchical -
+*)
+
+PROCEDURE GenerateHierarchical () : String ;
+BEGIN
+   RETURN HierarchicalDiag (InitString (''), Indexing.InitIndex (1))
+END GenerateHierarchical ;
+
+
+(*
+   Generate - return a string containing the output from
+              all the diagnostics enabled.
+*)
+
+PROCEDURE Generate (hierarchical: BOOLEAN) : String ;
+BEGIN
+   EnableHierarchical := hierarchical ;
+   IF EnableDiagnostics
+   THEN
+      Output := KillString (Output) ;
+      Output := InitString ('') ;
+      IF hierarchical
+      THEN
+         RETURN GenerateHierarchical ()
+      ELSE
+         RETURN GenerateRaw ()
+      END
+   ELSE
+      RETURN NIL
+   END
+END Generate ;
+
+
+BEGIN
+   TotalHeap := 0 ;
+   StartTime := NIL ;
+   TotalTime := NIL ;
+   CreateStartTime ;
+   Head := NIL ;
+   Output := NIL ;
+   EnableHierarchical := FALSE ;
+   DefaultTimeEnable := DefaultTimeEnableValue ;
+   DefaultMemEnable := DefaultMemEnableValue ;
+END M2Diagnostic.
diff --git a/gcc/m2/gm2-libs/M2WIDESET.def b/gcc/m2/gm2-libs/M2WIDESET.def
new file mode 100644
index 00000000000..5369d7baddd
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2WIDESET.def
@@ -0,0 +1,210 @@
+(* M2WIDESET.def runtime support procedures for wide sets.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  *)
+
+DEFINITION MODULE M2WIDESET ;
+
+(*
+    Title      : M2WIDESET
+    Author     : Gaius Mulley
+    System     : GNU Modula-2
+    Date       : Thu Nov 16 19:57:31 2023
+    Description: provides runtime capability for wide sets.
+*)
+
+FROM SYSTEM IMPORT BYTE ;
+
+
+(*
+   Or - dest = left | right
+        implement OR for a wide set type.
+*)
+
+PROCEDURE Or (VAR dest: ARRAY OF BYTE; left, right: ARRAY OF BYTE;
+              highbit: CARDINAL) ;
+
+
+(*
+   And - dest = left & right
+         implement AND for a wide set type.
+*)
+
+PROCEDURE And (VAR dest: ARRAY OF BYTE; left, right: ARRAY OF BYTE;
+               highbit: CARDINAL) ;
+
+
+(*
+   Not - dest = ~ operand
+         implement AND for a wide set type.
+*)
+
+PROCEDURE Not (VAR dest: ARRAY OF BYTE; expr: ARRAY OF BYTE;
+               highbit: CARDINAL) ;
+
+
+(*
+   Incl - dest |= bit
+          implement INCL for a wide set type.
+*)
+
+PROCEDURE Incl (VAR dest: ARRAY OF BYTE; bit: CARDINAL) ;
+
+
+(*
+   Excl - dest &= (~ bit)
+          implement EXCL for a wide set type.
+*)
+
+PROCEDURE Excl (VAR dest: ARRAY OF BYTE; bit: CARDINAL) ;
+
+
+(*
+   In - return bit IN expr.
+*)
+
+PROCEDURE In (VAR expr: ARRAY OF BYTE; bit: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Equal - return left = right.
+*)
+
+PROCEDURE Equal (VAR left, right: ARRAY OF BYTE; highbit: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Clear - dest = {}.
+*)
+
+PROCEDURE Clear (VAR dest: ARRAY OF BYTE; highbit: CARDINAL) ;
+
+
+(*
+   Shift - dest := SHIFT (src, ShiftCount).  This is a logical shift
+           all the new bit values will be zero.
+*)
+
+PROCEDURE Shift (VAR dest: ARRAY OF BYTE; src: ARRAY OF BYTE;
+                 highbit: CARDINAL; ShiftCount: INTEGER) ;
+
+
+(*
+   ArithShift - dest := ArithShift (dest, ShiftCount, carry).  This is an
+                arithmetic shift all the new bit values will
+                be set to carry.
+*)
+
+PROCEDURE ArithShift (VAR dest: ARRAY OF BYTE;
+                      highbit: CARDINAL; ShiftCount: INTEGER;
+                      carry: BOOLEAN) ;
+
+
+(*
+   Rotate - is a runtime procedure whose job is to implement
+            the ROTATE procedure of ISO SYSTEM.
+*)
+
+PROCEDURE Rotate (VAR dest: ARRAY OF BYTE; src: ARRAY OF BYTE;
+                  highbit: CARDINAL; RotateCount: INTEGER) ;
+
+(*
+   Less - performs the set comparison for a wide set.
+          Less returns ProperSubset (left, right, highbit).
+*)
+
+PROCEDURE Less (VAR left, right: ARRAY OF BYTE;
+                highbit: CARDINAL) : BOOLEAN ;
+
+
+(*
+   LessEqu - performs the set comparison for a wide set.
+             LessEqu returns Equal (left, right, highbit) OR
+                             ProperSubset (left, right, highbit).
+*)
+
+PROCEDURE LessEqu (VAR left, right: ARRAY OF BYTE;
+                   highbit: CARDINAL) : BOOLEAN ;
+
+
+(*
+   Gre - performs the set comparison for a wide set.
+         Gre returns the result of
+         ProperSuperet (left, right, highbit).
+*)
+
+PROCEDURE Gre (VAR left, right: ARRAY OF BYTE;
+               highbit: CARDINAL) : BOOLEAN ;
+
+
+(*
+   GreEqu - performs the set comparison for a wide set.
+            GreEqu returns Equal (left, right, highbit) OR
+                           ProperSuperet (left, right, highbit).
+*)
+
+PROCEDURE GreEqu (VAR left, right: ARRAY OF BYTE;
+                  highbit: CARDINAL) : BOOLEAN ;
+
+(*
+   ProperSubset - return TRUE if left is a proper subset of right.
+                  If true the left set will have at least one element
+                  less than set right.
+*)
+
+PROCEDURE ProperSubset (VAR left, right: ARRAY OF BYTE;
+                        highbit: CARDINAL) : BOOLEAN ;
+
+
+(*
+   ProperSuperset - return TRUE if left is a proper superset of right.
+                    If true the left set will have at least one element
+                    more than set right.
+*)
+
+PROCEDURE ProperSuperset (VAR left, right: ARRAY OF BYTE;
+                          highbit: CARDINAL) : BOOLEAN ;
+
+
+(*
+   LogicalDifference - build a logical difference expression tree.
+                       dest := left and (not right).
+*)
+
+PROCEDURE LogicalDifference (VAR dest: ARRAY OF BYTE;
+                             left, right: ARRAY OF BYTE;
+                             highbit: CARDINAL) ;
+
+
+(*
+   SymmetricDifference - build a logical difference expression tree.
+                         dest := left xor right.
+*)
+
+PROCEDURE SymmetricDifference (VAR dest: ARRAY OF BYTE;
+                               left, right: ARRAY OF BYTE;
+                               highbit: CARDINAL) ;
+
+
+END M2WIDESET.
diff --git a/gcc/m2/gm2-libs/M2WIDESET.mod b/gcc/m2/gm2-libs/M2WIDESET.mod
new file mode 100644
index 00000000000..f1b1bed3b3f
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2WIDESET.mod
@@ -0,0 +1,1259 @@
+(* M2WIDESET.mod runtime support procedures for wide sets.
+
+Copyright (C) 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/>.  *)
+
+IMPLEMENTATION MODULE M2WIDESET ;
+
+FROM SYSTEM IMPORT TBITSIZE, ADDRESS, ADR, SHIFT ;
+FROM Builtins IMPORT memcpy, memset ;
+FROM libc IMPORT printf ;
+
+TYPE
+   BYTESET = PACKEDSET OF [0..7] ;
+   PtrToByteset = POINTER TO BYTESET ;
+   PtrToBitset = POINTER TO BITSET ;
+
+
+CONST
+   EnableOptimizeBitset = TRUE ;
+   EnableDebugging      = FALSE ;
+
+
+(*
+   BitsPerByteset = TSIZE (BYTESET) * 8 ;
+*)
+
+
+(*
+   DumpSet -
+*)
+
+PROCEDURE DumpSet (set: ARRAY OF BYTE; highbit: CARDINAL) ;
+VAR
+   count,
+   i, high: CARDINAL ;
+   last   : BYTE ;
+BEGIN
+   high := HIGH (set) ;
+   printf ("set highbit = %d, high indice = %d\n", highbit, high) ;
+   printf ("{ ") ;
+   last := set[0] ;
+   i := 1 ;
+   count := 1 ;
+   printf (" 0: 0x%02x", VAL (CARDINAL, last)) ;
+   WHILE i <= high DO
+      IF last = set[i]
+      THEN
+         INC (count)
+      ELSE
+         IF count > 1
+         THEN
+            printf (" x %d, %d: 0x%02x", count, i, VAL (CARDINAL, set[i]))
+         ELSE
+            IF i > 0
+            THEN
+               printf (",")
+            END ;
+            printf (" %d: 0x%02x", i, VAL (CARDINAL, set[i]))
+         END ;
+         last := set[i] ;
+         count := 1
+      END ;
+      INC (i)
+   END ;
+   IF count > 1
+   THEN
+      printf (" x %d ", count)
+   END ;
+   printf (" }\n")
+END DumpSet ;
+
+
+(*
+   Or - dest = left | right
+        implement OR for a wide set type.
+*)
+
+PROCEDURE Or (VAR dest: ARRAY OF BYTE; left, right: ARRAY OF BYTE;
+              highbit: CARDINAL) ;
+VAR
+   i,
+   bit,
+   high,
+   lastbit: CARDINAL ;
+   byteset: BYTESET ;
+BEGIN
+   IF EnableDebugging
+   THEN
+      printf ("left\n");
+      DumpSet (left, highbit) ;
+      printf ("right\n");
+      DumpSet (right, highbit)
+   END ;
+   high := HIGH (dest) ;
+   i := 0 ;
+   WHILE i < high DO
+      IF EnableDebugging
+      THEN
+         printf ("%02x or %02x", left[i], right[i])
+      END ;
+      dest[i] := BYTESET (left[i]) + BYTESET (right[i]) ;
+      IF EnableDebugging
+      THEN
+         printf (" -> %02x\n", dest[i])
+      END ;
+      INC (i)
+   END ;
+   IF i = high
+   THEN
+      lastbit := highbit MOD TBITSIZE (BYTE) ;
+      IF lastbit = 0
+      THEN
+         dest[i] := BYTESET (left[i]) + BYTESET (right[i])
+      ELSE
+         byteset := dest[i] ;
+         FOR bit := 0 TO lastbit DO
+            IF (bit IN BYTESET (left[i])) OR (bit IN BYTESET (right[i]))
+            THEN
+               INCL (byteset, bit)
+            ELSE
+               EXCL (byteset, bit)
+            END
+         END ;
+         dest[i] := byteset
+      END
+   ELSE
+      HALT
+   END
+END Or ;
+
+
+(*
+   And - dest = left & right
+         implement AND for a wide set type.
+*)
+
+PROCEDURE And (VAR dest: ARRAY OF BYTE; left, right: ARRAY OF BYTE;
+               highbit: CARDINAL) ;
+VAR
+   i,
+   bit,
+   high,
+   lastbit: CARDINAL ;
+   byteset: BYTESET ;
+BEGIN
+   high := HIGH (dest) ;
+   i := 0 ;
+   WHILE i < high DO
+      dest[i] := BYTESET (left[i]) * BYTESET (right[i]) ;
+      INC (i)
+   END ;
+   IF i = high
+   THEN
+      lastbit := highbit MOD TBITSIZE (BYTE) ;
+      IF lastbit = 0
+      THEN
+         dest[i] := BYTESET (left[i]) * BYTESET (right[i])
+      ELSE
+         byteset := dest[i] ;
+         FOR bit := 0 TO lastbit DO
+            IF (bit IN BYTESET (left[i])) AND (bit IN BYTESET (right[i]))
+            THEN
+               INCL (byteset, bit)
+            ELSE
+               EXCL (byteset, bit)
+            END
+         END ;
+         dest[i] := byteset
+      END
+   ELSE
+      HALT
+   END
+END And ;
+
+
+(*
+   Not - dest = ~ expr
+         implement NOT for a wide set type.
+*)
+
+PROCEDURE Not (VAR dest: ARRAY OF BYTE; expr: ARRAY OF BYTE;
+               highbit: CARDINAL) ;
+VAR
+   i,
+   bit,
+   high,
+   lastbit: CARDINAL ;
+   byteset: BYTESET ;
+BEGIN
+   high := HIGH (dest) ;
+   i := 0 ;
+   WHILE i < high DO
+      dest[i] := - BYTESET (expr[i]) ;
+      INC (i)
+   END ;
+   IF i = high
+   THEN
+      lastbit := highbit MOD TBITSIZE (BYTE) ;
+      IF lastbit = 0
+      THEN
+         dest[i] := - BYTESET (expr[i])
+      ELSE
+         byteset := dest[i] ;
+         FOR bit := 0 TO lastbit DO
+            IF bit IN BYTESET (expr[i])
+            THEN
+               EXCL (byteset, bit)
+            ELSE
+               INCL (byteset, bit)
+            END
+         END ;
+         dest[i] := byteset
+      END
+   ELSE
+      HALT
+   END
+END Not ;
+
+
+(*
+   Incl - dest |= bit
+          implement INCL for a wide set type.
+*)
+
+PROCEDURE Incl (VAR dest: ARRAY OF BYTE; bit: CARDINAL) ;
+VAR
+   byteset: BYTESET ;
+   byteno,
+   bitno,
+   high   : CARDINAL ;
+BEGIN
+   high := HIGH (dest) ;
+   byteno := bit DIV TBITSIZE (BYTE) ;
+   bitno := bit MOD TBITSIZE (BYTE) ;
+   IF byteno <= high
+   THEN
+      byteset := BYTESET (dest[byteno]) ;
+      INCL (byteset, bitno) ;
+      dest[byteno] := byteset
+   ELSE
+      HALT
+   END
+END Incl ;
+
+
+(*
+   Excl - dest &= (~ bit)
+          implement EXCL for a wide set type.
+*)
+
+PROCEDURE Excl (VAR dest: ARRAY OF BYTE; bit: CARDINAL) ;
+VAR
+   byteset: BYTESET ;
+   byteno,
+   bitno,
+   high   : CARDINAL ;
+BEGIN
+   high := HIGH (dest) ;
+   byteno := bit DIV TBITSIZE (BYTE) ;
+   bitno := bit MOD TBITSIZE (BYTE) ;
+   IF byteno <= high
+   THEN
+      byteset := BYTESET (dest[byteno]) ;
+      EXCL (byteset, bitno) ;
+      dest[byteno] := byteset
+   ELSE
+      HALT
+   END
+END Excl ;
+
+
+(*
+   In - return bit IN expr.
+*)
+
+PROCEDURE In (VAR expr: ARRAY OF BYTE; bit: CARDINAL) : BOOLEAN ;
+VAR
+   byteno,
+   bitno,
+   high  : CARDINAL ;
+BEGIN
+   high := HIGH (expr) ;
+   byteno := bit DIV TBITSIZE (BYTE) ;
+   bitno := bit MOD TBITSIZE (BYTE) ;
+   IF byteno <= high
+   THEN
+      RETURN bitno IN BYTESET (expr[byteno])
+   ELSE
+      HALT
+   END
+END In ;
+
+
+(*
+   Empty - return TRUE if expr = {}.
+*)
+
+PROCEDURE Empty (expr: ARRAY OF BYTE; highbit: CARDINAL) : BOOLEAN ;
+VAR
+   i,
+   bit,
+   high,
+   lastbit: CARDINAL ;
+BEGIN
+   high := HIGH (expr) ;
+   i := 0 ;
+   WHILE i < high DO
+      IF expr[i] # BYTE (0)
+      THEN
+         RETURN FALSE
+      END ;
+      INC (i)
+   END ;
+   IF i = high
+   THEN
+      lastbit := highbit MOD TBITSIZE (BYTE) ;
+      IF lastbit = 0
+      THEN
+         RETURN expr[i] = BYTE (0)
+      ELSE
+         FOR bit := 0 TO lastbit DO
+            IF bit IN BYTESET (expr[i])
+            THEN
+               RETURN FALSE
+            END
+         END
+      END
+   ELSE
+      HALT
+   END ;
+   RETURN TRUE
+END Empty ;
+
+
+(*
+   Clear - set dest := {}.
+*)
+
+PROCEDURE Clear (VAR dest: ARRAY OF BYTE; highbit: CARDINAL) ;
+VAR
+   i,
+   bit,
+   high,
+   lastbit: CARDINAL ;
+   byteset: BYTESET ;
+BEGIN
+   high := HIGH (dest) ;
+   IF EnableOptimizeBitset
+   THEN
+      IF memset (ADR (dest), 0, high) = NIL
+      THEN
+      END ;
+      i := high
+   ELSE
+      i := 0 ;
+      WHILE i < high DO
+         dest[i] := BYTE (0) ;
+         INC (i)
+      END
+   END ;
+   IF i = high
+   THEN
+      lastbit := highbit MOD TBITSIZE (BYTE) ;
+      IF lastbit = 0
+      THEN
+         dest[i] := BYTE (0)
+      ELSE
+         byteset := dest[i] ;
+         FOR bit := 0 TO lastbit DO
+            EXCL (byteset, bit)
+         END ;
+         dest[i] := byteset
+      END
+   ELSE
+      HALT
+   END
+END Clear ;
+
+
+(*
+   Equal - return left = right.
+*)
+
+PROCEDURE Equal (VAR left, right: ARRAY OF BYTE; highbit: CARDINAL) : BOOLEAN ;
+VAR
+   i,
+   bit,
+   high,
+   lastbit   : CARDINAL ;
+   rptr, lptr: PtrToByteset ;
+   lb, rb    : BOOLEAN ;
+BEGIN
+   IF EnableDebugging
+   THEN
+      printf ("Equal left : ");
+      DumpSet (left, highbit) ;
+      printf ("      right: ");
+      DumpSet (right, highbit) ;
+   END ;
+
+   high := HIGH (left) ;
+   IF high = HIGH (right)
+   THEN
+      i := 0 ;
+      WHILE i < high DO
+         IF left[i] # right[i]
+         THEN
+            RETURN FALSE
+         END ;
+         INC (i)
+      END ;
+      IF i = high
+      THEN
+         lastbit := highbit MOD TBITSIZE (BYTE) ;
+         IF lastbit = 7
+         THEN
+            (* All bits 0..7 inclusive can be tested.  *)
+            RETURN left[i] = right[i]
+         END ;
+         rptr := ADR (right[i]) ;
+         lptr := ADR (left[i]) ;
+         (* Only check the bits in the set which are used in the last byte.  *)
+         FOR bit := 0 TO lastbit DO
+            (*
+            IF (bit IN rptr^) # (bit IN lptr^)
+            THEN
+               RETURN FALSE
+            END
+            *)
+            lb := bit IN lptr^ ;    (* Replace with the above - when the bug is fixed.  *)
+            rb := bit IN rptr^ ;
+            IF lb # rb
+            THEN
+               RETURN FALSE
+            END
+         END
+      END
+   ELSE
+      HALT
+   END ;
+   RETURN TRUE
+END Equal ;
+
+
+(*
+   ShiftLeft - performs the shift left for a multi word set.
+*)
+
+PROCEDURE ShiftLeft (VAR dest: ARRAY OF BYTE; src: ARRAY OF BYTE;
+                     highbit: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+VAR
+   byteshift,
+   bitshift : CARDINAL ;
+BEGIN
+   byteshift := ShiftCount DIV TBITSIZE (BYTESET) ;
+   bitshift := ShiftCount MOD TBITSIZE (BYTESET) ;
+   ShiftLeftByteBit (dest, src, highbit, byteshift, bitshift)
+END ShiftLeft ;
+
+
+(*
+   ShiftLeftByteBit - shifts src left by byteshift and bitshift.  It
+                      moves the bottom bitshift bits from lo into the
+                      first byte.
+*)
+
+PROCEDURE ShiftLeftByteBit (VAR dest: ARRAY OF BYTE; src: ARRAY OF BYTE;
+                            highbit: CARDINAL;
+                            byteshift, bitshift: CARDINAL) ;
+VAR
+   top, bot, mid : BYTESET ;
+   i, h, from, to: CARDINAL ;
+BEGIN
+   (* Copy the bytes into dest at the mostly correct position
+      (modulo byte position).  *)
+   to := 0 ;
+   from := 0 ;
+   WHILE to < byteshift DO
+      dest[to] := BYTE (0) ;
+      INC (to)
+   END ;
+   WHILE to <= HIGH (dest) DO
+      dest[to] := src[from] ;
+      INC (to) ;
+      INC (from)
+   END ;
+   (* And adjust by bit shifting.  *)
+   IF bitshift > 0
+   THEN
+      bot := BYTE (0) ;
+      h := HIGH (dest) ;
+      i := 0 ;
+      WHILE i < h DO
+         mid := dest[i] ;
+         (* Shift right by TBITSIZE (BYTE) - bitshift.  *)
+         top := SHIFT (mid, - INTEGER ((TBITSIZE (BYTE) - bitshift))) ;  (* Right must be negative.  *)
+         mid := SHIFT (mid, bitshift) ;   (* Shift left.  *)
+         dest[i] := mid + bot ;
+         bot := top ;
+         INC (i)
+      END ;
+      mid := dest[h] ;
+      mid := SHIFT (mid, bitshift) ;   (* Shift left.  *)
+      dest[h] := mid + bot
+   END
+END ShiftLeftByteBit ;
+
+
+(*
+   ShiftRight - performs the shift rightt for a multi word set.
+*)
+
+PROCEDURE ShiftRight (VAR dest: ARRAY OF BYTE; src: ARRAY OF BYTE;
+                     highbit: CARDINAL;
+                     ShiftCount: CARDINAL) ;
+VAR
+   byteshift,
+   bitshift : CARDINAL ;
+BEGIN
+   IF EnableDebugging
+   THEN
+      printf ("highbit = %d, ShiftCount = %d\n",
+              highbit, ShiftCount)
+   END ;
+   byteshift := ShiftCount DIV TBITSIZE (BYTESET) ;
+   bitshift := ShiftCount MOD TBITSIZE (BYTESET) ;
+   IF EnableDebugging
+   THEN
+      printf ("SIZE (byteset) = %d, TBITSIZE (byteset) = %d\n",
+              SIZE (BYTESET), TBITSIZE (BYTESET));
+      printf ("  byteshift = %d, bitshift = %d\n",
+              byteshift, bitshift)
+   END ;
+   ShiftRightByteBit (dest, src, highbit, byteshift, bitshift)
+END ShiftRight ;
+
+
+(*
+   ShiftRightByteBit - shifts src left by byteshift and bitshift.  It
+                      moves the bottom bitshift bits from lo into the
+                      first byte.
+*)
+
+PROCEDURE ShiftRightByteBit (VAR dest: ARRAY OF BYTE; src: ARRAY OF BYTE;
+                             highbit: CARDINAL;
+                             byteshift, bitshift: CARDINAL) ;
+VAR
+   top, bot, mid : BYTESET ;
+   i, h, to, from: CARDINAL ;
+BEGIN
+   (* Copy the bytes.  *)
+   to := 0 ;
+   from := byteshift ;
+   IF EnableDebugging
+   THEN
+      printf ("HIGH (dest) = %d\n", HIGH (dest))
+   END ;
+   IF byteshift <= HIGH (dest)
+   THEN
+      h := HIGH (dest) - byteshift ;
+      WHILE to <= h DO
+         dest[to] := src[from] ;
+         INC (to) ;
+         INC (from)
+      END
+   END ;
+   WHILE to <= HIGH (dest) DO
+      dest[to] := BYTE (0) ;
+      INC (to)
+   END ;
+   (* And bit shift the remainder.  *)
+   IF EnableDebugging
+   THEN
+      printf ("bitshift = %d\n", bitshift)
+   END ;
+   IF bitshift > 0
+   THEN
+      top := BYTE (0) ;
+      i := HIGH (dest) ;
+      WHILE i > 0 DO
+         mid := dest[i] ;
+         bot := SHIFT (mid, TBITSIZE (BYTE) - bitshift) ;   (* Shift left.  *)
+         mid := SHIFT (mid, - INTEGER (bitshift)) ;  (* Shift right by bitshift.  *)
+         dest[i] := top + mid ;
+         top := bot ;
+         DEC (i)
+      END ;
+      mid := dest[0] ;
+      mid := SHIFT (mid, - INTEGER (bitshift)) ;  (* Shift right by bitshift.  *)
+      dest[0] := top + mid
+   END
+END ShiftRightByteBit ;
+
+
+(*
+   Shift - dest := SHIFT (src, ShiftCount).
+*)
+
+PROCEDURE Shift (VAR dest: ARRAY OF BYTE; src: ARRAY OF BYTE;
+                 highbit: CARDINAL; ShiftCount: INTEGER) ;
+BEGIN
+   IF ShiftCount > 0
+   THEN
+      IF EnableDebugging
+      THEN
+         printf ("Shift Left: ") ;
+         DumpSet (src, highbit)
+      END ;
+      ShiftCount := ShiftCount MOD VAL (INTEGER, (highbit + 1)) ;
+      ShiftLeft (dest, src, highbit, ShiftCount) ;
+      IF EnableDebugging
+      THEN
+         printf ("  Result of shift Left: ") ;
+         DumpSet (dest, highbit)
+      END
+   ELSIF ShiftCount < 0
+   THEN
+      IF EnableDebugging
+      THEN
+         printf ("Shift Right: ") ;
+         DumpSet (src, highbit)
+      END ;
+      ShiftCount := (-ShiftCount) MOD VAL (INTEGER, (highbit + 1)) ;
+      ShiftRight (dest, src, highbit, ShiftCount) ;
+      IF EnableDebugging
+      THEN
+         printf ("  Result of shift right: ") ;
+         DumpSet (dest, highbit)
+      END
+   ELSE
+      IF memcpy (ADR (dest), ADR (src), (HIGH (dest) + 1) * SIZE (BYTE)) = NIL
+      THEN
+      END
+   END
+END Shift ;
+
+
+(*
+   ArithShift - dest := ArithShift (dest, ShiftCount, carry).  This is an
+                arithmetic shift all the new bit values will
+                be set to carry.
+*)
+
+PROCEDURE ArithShiftLeft (VAR dest: ARRAY OF BYTE;
+                          highbit: CARDINAL; ShiftCount: CARDINAL;
+                          carry: BOOLEAN) ;
+BEGIN
+   WHILE ShiftCount > 0 DO
+      ArithShiftLeftBit (dest, highbit, carry) ;
+      DEC (ShiftCount)
+   END
+END ArithShiftLeft ;
+
+
+(*
+   ArithShiftLeftBit - shift set left by one bit.  Carry will appear at
+                       bit position 0.  Any unused bits on the high byte
+                       are unaffected.
+*)
+
+PROCEDURE ArithShiftLeftBit (VAR dest: ARRAY OF BYTE; highbit: CARDINAL;
+                             carry: BOOLEAN) ;
+CONST
+   MSB = TBITSIZE (BYTE) - 1 ;
+VAR
+   topbit,
+   i,
+   high  : CARDINAL ;
+   next  : BOOLEAN ;
+   mask,
+   unused,
+   set   : BYTESET ;
+BEGIN
+   IF EnableDebugging
+   THEN
+      printf ("ArithShiftLeft enter\n");
+      DumpSet (dest, highbit)
+   END ;
+
+   high := HIGH (dest) ;
+   (* We ripple through the bytes 0..high-1, propagating local carry between
+      bytes.  *)
+   i := 0 ;
+   WHILE i < high DO
+      set := dest[i] ;
+      next := MSB IN set ;
+      set := SHIFT (set, 1) ;  (* Shift left.  *)
+      IF carry
+      THEN
+         INCL (set, 0)   (* Set bit 0.  *)
+      END ;
+      dest[i] := set ;
+      carry := next ;
+      IF EnableDebugging
+      THEN
+         printf ("ArithShiftLeft shifted byte dest[%d]\n", i);
+         DumpSet (dest, highbit)
+      END ;
+      INC (i)
+   END ;
+   (* Last byte special case as there may be some unused bits which must be
+      preserved.  *)
+   set := dest[high] ;
+   unused := BYTESET {} ;  (* Will contain all top unused bits of dest[high].  *)
+   mask := - BYTESET {} ;
+   topbit := (highbit+1) MOD TBITSIZE (BYTE) ;
+   WHILE topbit # 0 DO
+      EXCL (mask, topbit) ;
+      IF topbit IN set
+      THEN
+         EXCL (set, topbit) ;
+         INCL (unused, topbit)
+      END ;
+      topbit := (topbit+1) MOD TBITSIZE (BYTE)
+   END ;
+   set := SHIFT (set, 1) ;  (* Left shift.  *)
+   IF carry
+   THEN
+      INCL (set, 0)   (* Set bit 0.  *)
+   END ;
+   set := set * mask ;  (* Remove all unused bits.  *)
+   set := set + unused ;  (* Restore original unused bits.  *)
+   dest[high] := set ;
+   IF EnableDebugging
+   THEN
+      printf ("ArithShiftLeft shifted byte dest[%d]\n", high);
+      DumpSet (dest, highbit)
+   END
+END ArithShiftLeftBit ;
+
+
+(*
+   ArithShiftRight - dest := ArithShiftRight (dest, ShiftCount, carry).
+                     This is an arithmetic shift all the new bit values
+                     will be set to carry.
+*)
+
+PROCEDURE ArithShiftRight (VAR dest: ARRAY OF BYTE;
+                           highbit: CARDINAL; ShiftCount: CARDINAL;
+                           carry: BOOLEAN) ;
+BEGIN
+   WHILE ShiftCount > 0 DO
+      ArithShiftRightBit (dest, highbit, carry) ;
+      DEC (ShiftCount)
+   END
+END ArithShiftRight ;
+
+
+(*
+   ArithShiftRightBit - shift set right by one bit and place carry in the
+                        top most bit.
+*)
+
+PROCEDURE ArithShiftRightBit (VAR dest: ARRAY OF BYTE; highbit: CARDINAL;
+                              carry: BOOLEAN) ;
+CONST
+   MSB = TBITSIZE (BYTE) - 1 ;
+VAR
+   topbit,
+   i,
+   high  : CARDINAL ;
+   prev,
+   next  : BOOLEAN ;
+   mask,
+   unused,
+   set   : BYTESET ;
+BEGIN
+   high := HIGH (dest) ;
+   (* Clear any unused bits in the highest byte, but save them into unused.  *)
+   set := dest[high] ;
+   unused := BYTESET {} ;
+   topbit := (highbit+1) MOD TBITSIZE (BYTE) ;
+   mask := - BYTESET {} ;
+   WHILE topbit # 0 DO
+      EXCL (mask, topbit) ;
+      IF topbit IN set
+      THEN
+         EXCL (set, topbit) ;
+         INCL (unused, topbit)
+      END ;
+      topbit := (topbit+1) MOD TBITSIZE (BYTE)
+   END ;
+   (* Start at the top and work down to byte 0.  *)
+   set := set * mask ;  (* Ignore unused bits.  *)
+   next := 0 IN set ;   (* Next carry.  *)
+   set := SHIFT (set, -1) ;   (* Shift right by 1 bit.  *)
+   IF carry
+   THEN
+      INCL (set, highbit MOD TBITSIZE (BYTE))
+   END ;
+   dest[high] := set + unused ;  (* First byte is a special case as we
+                                    have to preserve the unused bits.  *)
+   (* Now we ripple through the remaining bytes, propagating local
+      carry between bytes.  *)
+   i := high ;
+   WHILE i > 0 DO
+      prev := next ;
+      DEC (i) ;
+      set := dest[i] ;
+      next := 0 IN set ;
+      set := SHIFT (set, -1) ;
+      IF prev
+      THEN
+         INCL (set, MSB)
+      END ;
+      dest[i] := set
+   END
+END ArithShiftRightBit ;
+
+
+(*
+   ArithShift - dest := ArithShift (dest, ShiftCount, carry).  This is an
+                arithmetic shift all the new bit values will
+                be set to carry.
+*)
+
+PROCEDURE ArithShift (VAR dest: ARRAY OF BYTE;
+                      highbit: CARDINAL; ShiftCount: INTEGER;
+                      carry: BOOLEAN) ;
+BEGIN
+   IF EnableDebugging
+   THEN
+      printf ("Arith enter\n");
+      DumpSet (dest, highbit)
+   END ;
+   IF ShiftCount > 0
+   THEN
+      ShiftCount := ShiftCount MOD VAL (INTEGER, (highbit + 1)) ;
+      ArithShiftLeft (dest, highbit, ShiftCount, carry)
+   ELSIF ShiftCount < 0
+   THEN
+      ShiftCount := (-ShiftCount) MOD VAL (INTEGER, (highbit + 1)) ;
+      ArithShiftRight (dest, highbit, ShiftCount, carry)
+   END ;
+   IF EnableDebugging
+   THEN
+      printf ("Arith exit\n");
+      DumpSet (dest, highbit)
+   END
+END ArithShift ;
+
+
+(*
+   Rotate - is a runtime procedure whose job is to implement
+            the ROTATE procedure of ISO SYSTEM.
+*)
+
+PROCEDURE Rotate (VAR dest: ARRAY OF BYTE; src: ARRAY OF BYTE;
+                  highbit: CARDINAL; RotateCount: INTEGER) ;
+BEGIN
+   IF EnableDebugging
+   THEN
+      printf ("Rotate enter\n");
+      DumpSet (src, highbit)
+   END ;
+   IF RotateCount > 0
+   THEN
+      RotateCount := RotateCount MOD VAL (INTEGER, highbit + 1)
+   ELSIF RotateCount < 0
+   THEN
+      RotateCount := -VAL (INTEGER, VAL (CARDINAL, -RotateCount) MOD (highbit + 1))
+   END ;
+   IF RotateCount > 0
+   THEN
+      RotateLeft (dest, src, highbit, RotateCount)
+   ELSIF RotateCount < 0
+   THEN
+      RotateRight (dest, src, highbit, -RotateCount)
+   ELSE
+      (* No rotate required, but we must copy source to dest.  *)
+      IF memcpy (ADR (dest), ADR (src), (HIGH (dest) + 1) * SIZE (BYTE)) = NIL
+      THEN
+      END
+   END ;
+   IF EnableDebugging
+   THEN
+      printf ("Rotate exit\n");
+      DumpSet (dest, highbit)
+   END
+END Rotate ;
+
+
+(*
+   RotateLeft - performs the rotate left for a multi word set.
+*)
+
+PROCEDURE RotateLeft (VAR dest: ARRAY OF BYTE; src: ARRAY OF BYTE;
+                      highbit: CARDINAL; RotateCount: CARDINAL) ;
+VAR
+   bit,  carry : BOOLEAN ;
+   count,
+   high,
+   highplus1,
+   highbitplus1,
+   from, to    : CARDINAL ;
+BEGIN
+   IF EnableDebugging
+   THEN
+      printf ("RotateLeft enter\n");
+      DumpSet (src, highbit)
+   END ;
+
+   (* Copy the contents rotating on byte granularity, then
+      arithmetically shift the remaining number of bits.  *)
+   high := HIGH (dest) ;
+   from := 0 ;
+   highplus1 := high + 1 ;
+   highbitplus1 := highbit + 1 ;
+   to := RotateCount DIV TBITSIZE (BYTE) ;  (* Byte level granularity.  *)
+   REPEAT
+      dest[to] := src[from] ;
+      IF EnableDebugging
+      THEN
+         printf ("RotateLeft after partial byte movement: dest[%d] := src[%d]\n",
+                 to, from);
+         DumpSet (dest, highbit)
+      END ;
+      from := (from + 1) MOD highplus1 ;
+      to := (to + 1) MOD highplus1 ;
+   UNTIL from = 0 ;
+
+   IF EnableDebugging
+   THEN
+      printf ("RotateLeft after byte placement\n");
+      DumpSet (dest, highbit)
+   END ;
+
+   (* Now ArithShiftLeft the remainder number of bits.  *)
+   count := RotateCount MOD (TBITSIZE (BYTE)) ;
+   WHILE count > 0 DO
+      (* Get last bit.  *)
+      bit := (highbit MOD TBITSIZE (BYTE)) IN BYTESET (dest[high]) ;
+      (* Shift everything left wards and the last bit goes to bit
+         position 0.  *)
+      ArithShiftLeft (dest, highbit, 1, bit) ;
+      DEC (count)
+   END ;
+   IF EnableDebugging
+   THEN
+      printf ("RotateLeft after bit shifting final placement\n");
+      DumpSet (dest, highbit)
+   END
+END RotateLeft ;
+
+
+(*
+   RotateRight - performs the rotate right for a multi word set.
+*)
+
+PROCEDURE RotateRight (VAR dest: ARRAY OF BYTE; src: ARRAY OF BYTE;
+                       highbit: CARDINAL; RotateCount: CARDINAL) ;
+BEGIN
+   RotateLeft (dest, src, highbit, (highbit + 1) - RotateCount)
+END RotateRight ;
+
+
+(*
+   Less - performs the set comparison for a wide set.
+          Less returns ProperSubset (left, right, highbit).
+*)
+
+PROCEDURE Less (VAR left, right: ARRAY OF BYTE;
+                highbit: CARDINAL) : BOOLEAN ;
+
+BEGIN
+   RETURN ProperSubset (left, right, highbit)
+END Less ;
+
+
+(*
+   LessEqu - performs the set comparison for a wide set.
+             LessEqu returns Equal (left, right, highbit) OR
+                             ProperSubset (left, right, highbit).
+*)
+
+PROCEDURE LessEqu (VAR left, right: ARRAY OF BYTE;
+                   highbit: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN Equal (left, right, highbit) OR
+          ProperSubset (left, right, highbit)
+END LessEqu ;
+
+
+(*
+   Gre - performs the set comparison for a wide set.
+         Gre returns the result of
+         ProperSuperet (left, right, highbit).
+*)
+
+PROCEDURE Gre (VAR left, right: ARRAY OF BYTE;
+               highbit: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN ProperSuperset (left, right, highbit)
+END Gre ;
+
+
+(*
+   GreEqu - performs the set comparison for a wide set.
+            GreEqu returns Equal (left, right, highbit) OR
+                           ProperSuperet (left, right, highbit).
+*)
+
+PROCEDURE GreEqu (VAR left, right: ARRAY OF BYTE;
+                  highbit: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN Equal (left, right, highbit) OR
+          ProperSuperset (left, right, highbit)
+END GreEqu ;
+
+
+(*
+   ProperSubset - return TRUE if left is a proper subset of right.
+                  If true the left set will have at least one element
+                  less than set right.
+*)
+
+PROCEDURE ProperSubset (VAR left, right: ARRAY OF BYTE;
+                        highbit: CARDINAL) : BOOLEAN ;
+VAR
+   diffbits,
+   diffright,
+   diffleft : BYTESET ;
+   rightmore: BOOLEAN ;
+   i,
+   bit,
+   high,
+   lastbit: CARDINAL ;
+   lptr,
+   rptr   : PtrToByteset ;
+BEGIN
+   high := HIGH (left) ;
+   lptr := ADR (left) ;
+   rptr := ADR (right) ;
+   i := 0 ;
+   rightmore := FALSE ;
+   WHILE i < high DO
+      diffbits :=  lptr^ / rptr^ ;  (* / in M2 is xor.  *)
+      diffright := diffbits * rptr^ ;  (* * in M2 is and.  *)
+      IF diffright # BYTESET {}
+      THEN
+         rightmore := TRUE
+      END ;
+      diffleft := diffbits * lptr^ ;
+      IF diffleft # BYTESET {}
+      THEN
+         (* Not a subset, so we early return.  *)
+         RETURN FALSE
+      END ;
+      INC (rptr) ;
+      INC (lptr) ;
+      INC (i)
+   END ;
+   lastbit := highbit MOD TBITSIZE (BYTE) ;
+   IF lastbit > 0
+   THEN
+      FOR bit := 0 TO lastbit DO
+         IF (NOT (bit IN lptr^)) AND (bit IN rptr^)
+         THEN
+            rightmore := TRUE
+         ELSIF (bit IN lptr^) AND (NOT (bit IN rptr^))
+         THEN
+            (* Not a subset, so we early return.  *)
+            RETURN FALSE
+         END
+      END
+   END ;
+   RETURN rightmore
+END ProperSubset ;
+
+
+(*
+   ProperSuperset - return TRUE if left is a proper superset of right.
+                    If true the left set will have at least one element
+                    more than set right.
+*)
+
+PROCEDURE ProperSuperset (VAR left, right: ARRAY OF BYTE;
+                          highbit: CARDINAL) : BOOLEAN ;
+VAR
+   diffbits,
+   diffleft,
+   diffright: BYTESET ;
+   leftmore : BOOLEAN ;
+   i,
+   bit,
+   high,
+   lastbit  : CARDINAL ;
+   lptr,
+   rptr     : PtrToByteset ;
+BEGIN
+   high := HIGH (left) ;
+   lptr := ADR (left) ;
+   rptr := ADR (right) ;
+   i := 0 ;
+   leftmore := FALSE ;
+   WHILE i < high DO
+      diffbits :=  lptr^ / rptr^ ;  (* / in M2 is xor.  *)
+      diffleft := diffbits * lptr^ ;  (* * in M2 is and.  *)
+      IF diffleft # BYTESET {}
+      THEN
+         leftmore := TRUE
+      END ;
+      diffright := diffbits * rptr^ ;
+      IF diffright # BYTESET {}
+      THEN
+         (* Not a superset, so we early return.  *)
+         RETURN FALSE
+      END ;
+      INC (rptr) ;
+      INC (lptr) ;
+      INC (i)
+   END ;
+   lastbit := highbit MOD TBITSIZE (BYTE) ;
+   IF lastbit > 0
+   THEN
+      FOR bit := 0 TO lastbit DO
+         IF (bit IN lptr^) AND (NOT (bit IN rptr^))
+         THEN
+            leftmore := TRUE
+         ELSIF (NOT (bit IN lptr^)) AND (bit IN rptr^)
+         THEN
+            (* Not a superset, so we early return.  *)
+            RETURN FALSE
+         END
+      END
+   END ;
+   RETURN leftmore
+END ProperSuperset ;
+
+
+(*
+   LogicalDifference - build a logical difference expression tree.
+                       dest := left and (not right).
+*)
+
+PROCEDURE LogicalDifference (VAR dest: ARRAY OF BYTE;
+                             left, right: ARRAY OF BYTE;
+                             highbit: CARDINAL) ;
+BEGIN
+   Not (right, right, highbit) ;
+   And (dest, left, right, highbit)
+END LogicalDifference ;
+
+
+(*
+   SymmetricDifference - build a logical difference expression tree.
+                         dest := left xor right.
+*)
+
+PROCEDURE SymmetricDifference (VAR dest: ARRAY OF BYTE;
+                               left, right: ARRAY OF BYTE;
+                               highbit: CARDINAL) ;
+VAR
+   i,
+   bit,
+   high,
+   lastbit: CARDINAL ;
+   byteset: BYTESET ;
+BEGIN
+   high := HIGH (dest) ;
+   i := 0 ;
+   WHILE i < high DO
+      dest[i] := BYTESET (left[i]) / BYTESET (right[i]) ;
+      INC (i)
+   END ;
+   IF i = high
+   THEN
+      lastbit := highbit MOD TBITSIZE (BYTE) ;
+      IF lastbit = 0
+      THEN
+         dest[i] := BYTESET (left[i]) / BYTESET (right[i])
+      ELSE
+         byteset := dest[i] ;
+         FOR bit := 0 TO lastbit DO
+            IF (bit IN BYTESET (left[i])) = (bit IN BYTESET (right[i]))
+            THEN
+               EXCL (byteset, bit)
+            ELSE
+               INCL (byteset, bit)
+            END
+         END ;
+         dest[i] := byteset
+      END
+   ELSE
+      HALT
+   END
+END SymmetricDifference ;
+
+
+(*
+   AssignBits - copy bits [0..highbit] from src to dest.
+*)
+
+PROCEDURE AssignBits (VAR dest: BYTESET; src: BYTESET; highbit: CARDINAL) ;
+VAR
+   bit,
+   lastbit: CARDINAL ;
+BEGIN
+   (* Last byte.  *)
+   lastbit := highbit MOD TBITSIZE (BYTE) ;
+   IF lastbit = 0
+   THEN
+      (* Copy all bits.  *)
+      dest := src
+   ELSE
+      (* Copy only required bits.  *)
+      FOR bit := 0 TO lastbit DO
+         IF bit IN src
+         THEN
+            INCL (dest, bit)
+         ELSE
+            EXCL (dest, bit)
+         END
+      END
+   END
+END AssignBits ;
+
+
+(*
+   Assign -
+*)
+
+PROCEDURE Assign (VAR dest: ARRAY OF BYTE; src: ARRAY OF BYTE; highbit: CARDINAL) ;
+VAR
+   i, high: CARDINAL ;
+BEGIN
+   high := HIGH (dest) ;
+   i := 0 ;
+   WHILE i < high DO
+      dest[i] := src[i] ;
+      INC (i)
+   END ;
+   AssignBits (dest[i], src[i], highbit)
+END Assign ;
+
+
+END M2WIDESET.
diff --git a/gcc/m2/gm2-libs/SYSTEM.def b/gcc/m2/gm2-libs/SYSTEM.def
index 1b2949eebb0..9d043999cfe 100644
--- a/gcc/m2/gm2-libs/SYSTEM.def
+++ b/gcc/m2/gm2-libs/SYSTEM.def
@@ -111,87 +111,4 @@ PROCEDURE TBITSIZE (<type>) : CARDINAL ;
   *)
 *)
 
-(* The following procedures are invoked by GNU Modula-2 to
-   shift non word sized set types. They are not strictly part
-   of the core PIM Modula-2, however they are used
-   to implement the SHIFT procedure defined above,
-   which are in turn used by the Logitech compatible libraries.
-
-   Users will access these procedures by using the procedure
-   SHIFT above and GNU Modula-2 will map SHIFT onto one of
-   the following procedures.
-*)
-
-(*
-   ShiftVal - is a runtime procedure whose job is to implement
-              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
-              inline a SHIFT of a single WORD sized set and will only
-              call this routine for larger sets.
-*)
-
-PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
-                    SetSizeInBits: CARDINAL;
-                    ShiftCount: INTEGER) ;
-
-
-(*
-   ShiftLeft - performs the shift left for a multi word set.
-               This procedure might be called by the back end of
-               GNU Modula-2 depending whether amount is known at
-               compile time.
-*)
-
-PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     ShiftCount: CARDINAL) ;
-
-(*
-   ShiftRight - performs the shift left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known at
-                compile time.
-*)
-
-PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
-                      SetSizeInBits: CARDINAL;
-                      ShiftCount: CARDINAL) ;
-
-
-(*
-   RotateVal - is a runtime procedure whose job is to implement
-               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
-               inline a ROTATE of a single WORD (or less)
-               sized set and will only call this routine for larger
-               sets.
-*)
-
-PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     RotateCount: INTEGER) ;
-
-
-(*
-   RotateLeft - performs the rotate left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known at
-                compile time.
-*)
-
-PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
-                      SetSizeInBits: CARDINAL;
-                      RotateCount: CARDINAL) ;
-
-
-(*
-   RotateRight - performs the rotate right for a multi word set.
-                 This procedure might be called by the back end of
-                 GNU Modula-2 depending whether amount is known at
-                 compile time.
-*)
-
-PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
-                       SetSizeInBits: CARDINAL;
-                       RotateCount: CARDINAL) ;
-
-
 END SYSTEM.
diff --git a/gcc/m2/gm2-libs/SYSTEM.mod b/gcc/m2/gm2-libs/SYSTEM.mod
index 72b22cdf06d..7ee5a043dc2 100644
--- a/gcc/m2/gm2-libs/SYSTEM.mod
+++ b/gcc/m2/gm2-libs/SYSTEM.mod
@@ -26,248 +26,4 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 IMPLEMENTATION MODULE SYSTEM ;
 
-FROM libc IMPORT memcpy, memset ;
-
-CONST
-   BitsPerBitset = MAX(BITSET)+1 ;
-
-
-(*
-   Max - returns the maximum of a and b.
-*)
-
-PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
-BEGIN
-   IF a>b
-   THEN
-      RETURN( a )
-   ELSE
-      RETURN( b )
-   END
-END Max ;
-
-
-(*
-   Min - returns the minimum of a and b.
-*)
-
-PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
-BEGIN
-   IF a<b
-   THEN
-      RETURN( a )
-   ELSE
-      RETURN( b )
-   END
-END Min ;
-
-
-(*
-   ShiftVal - is a runtime procedure whose job is to implement
-              the SHIFT procedure of ISO SYSTEM. GNU Modula-2 will
-              inline a SHIFT of a single WORD sized set and will only
-              call this routine for larger sets.
-*)
-
-PROCEDURE ShiftVal (VAR s, d: ARRAY OF BITSET;
-                    SetSizeInBits: CARDINAL;
-                    ShiftCount: INTEGER) ;
-VAR
-   a: ADDRESS ;
-BEGIN
-   IF ShiftCount>0
-   THEN
-      ShiftCount := ShiftCount MOD VAL(INTEGER, SetSizeInBits) ;
-      ShiftLeft(s, d, SetSizeInBits, ShiftCount)
-   ELSIF ShiftCount<0
-   THEN
-      ShiftCount := (-ShiftCount) MOD VAL(INTEGER, SetSizeInBits) ;
-      ShiftRight(s, d, SetSizeInBits, ShiftCount)
-   ELSE
-      a := memcpy(ADR(d), ADR(s), (HIGH(d)+1)*SIZE(BITSET))
-   END
-END ShiftVal ;
-
-
-(*
-   ShiftLeft - performs the shift left for a multi word set.
-               This procedure might be called by the back end of
-               GNU Modula-2 depending whether amount is known at compile
-               time.
-*)
-
-PROCEDURE ShiftLeft (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     ShiftCount: CARDINAL) ;
-VAR
-   lo, hi : BITSET ;
-   i, j, h: CARDINAL ;
-   a      : ADDRESS ;
-BEGIN
-   h := HIGH(s)+1 ;
-   IF ShiftCount MOD BitsPerBitset=0
-   THEN
-      i := ShiftCount DIV BitsPerBitset ;
-      a := ADR(d[i]) ;
-      a := memcpy(a, ADR(s), (h-i)*SIZE(BITSET)) ;
-      a := memset(ADR(d), 0, i*SIZE(BITSET))
-   ELSE
-      i := h ;
-      WHILE i>0 DO
-         DEC(i) ;
-         lo := SHIFT(s[i], ShiftCount MOD BitsPerBitset) ;
-         hi := SHIFT(s[i], -(BitsPerBitset - (ShiftCount MOD BitsPerBitset))) ;
-         d[i] := BITSET{} ;
-         j := i + ShiftCount DIV BitsPerBitset ;
-         IF j<h
-         THEN
-            d[j] := d[j] + lo ;
-            INC(j) ;
-            IF j<h
-            THEN
-               d[j] := d[j] + hi
-            END
-         END
-      END
-   END
-END ShiftLeft ;
-
-
-(*
-   ShiftRight - performs the shift left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known at compile
-                time.
-*)
-
-PROCEDURE ShiftRight (VAR s, d: ARRAY OF BITSET;
-                      SetSizeInBits: CARDINAL;
-                      ShiftCount: CARDINAL) ;
-VAR
-   lo, hi : BITSET ;
-   j, i, h: INTEGER ;
-   a      : ADDRESS ;
-BEGIN
-   h := HIGH (s) + 1 ;
-   IF ShiftCount MOD BitsPerBitset = 0
-   THEN
-      i := ShiftCount DIV BitsPerBitset ;
-      a := ADR (s[i]) ;
-      j := h-i ;
-      a := memcpy (ADR (d), a, j * VAL (INTEGER, SIZE (BITSET))) ;
-      a := ADR (d[j]) ;
-      a := memset (a, 0, i * VAL (INTEGER, SIZE (BITSET)))
-   ELSE
-      i := 0 ;
-      WHILE i<h DO
-         lo := SHIFT(s[i], BitsPerBitset - (ShiftCount MOD BitsPerBitset)) ;
-         hi := SHIFT(s[i], -(ShiftCount MOD BitsPerBitset)) ;
-         d[i] := BITSET{} ;
-         j := i - VAL (INTEGER, ShiftCount DIV BitsPerBitset) ;
-         IF j>=0
-         THEN
-            d[j] := d[j] + hi ;
-            DEC(j) ;
-            IF j>=0
-            THEN
-               d[j] := d[j] + lo
-            END
-         END ;
-         INC(i)
-      END
-   END
-END ShiftRight ;
-
-
-(*
-   RotateVal - is a runtime procedure whose job is to implement
-               the ROTATE procedure of ISO SYSTEM. GNU Modula-2 will
-               inline a ROTATE of a single WORD (or less)
-               sized set and will only call this routine for larger sets.
-*)
-
-PROCEDURE RotateVal (VAR s, d: ARRAY OF BITSET;
-                     SetSizeInBits: CARDINAL;
-                     RotateCount: INTEGER) ;
-VAR
-   a: ADDRESS ;
-BEGIN
-   IF RotateCount>0
-   THEN
-      RotateCount := RotateCount MOD VAL(INTEGER, SetSizeInBits)
-   ELSIF RotateCount<0
-   THEN
-      RotateCount := -VAL(INTEGER, VAL(CARDINAL, -RotateCount) MOD SetSizeInBits)
-   END ;
-   IF RotateCount>0
-   THEN
-      RotateLeft(s, d, SetSizeInBits, RotateCount)
-   ELSIF RotateCount<0
-   THEN
-      RotateRight(s, d, SetSizeInBits, -RotateCount)
-   ELSE
-      (* no rotate required, but we must copy source to dest.  *)
-      a := memcpy(ADR(d), ADR(s), (HIGH(d)+1)*SIZE(BITSET))
-   END
-END RotateVal ;
-
-
-(*
-   RotateLeft - performs the rotate left for a multi word set.
-                This procedure might be called by the back end of
-                GNU Modula-2 depending whether amount is known at compile
-                time.
-*)
-
-PROCEDURE RotateLeft (VAR s, d: ARRAY OF BITSET;
-                      SetSizeInBits: CARDINAL;
-                      RotateCount: CARDINAL) ;
-VAR
-   lo, hi : BITSET ;
-   b, i, j, h: CARDINAL ;
-BEGIN
-   h := HIGH(s) ;
-   (* firstly we set d := {} *)
-   i := 0 ;
-   WHILE i<=h DO
-      d[i] := BITSET{} ;
-      INC(i)
-   END ;
-   i := h+1 ;
-   RotateCount := RotateCount MOD SetSizeInBits ;
-   b := SetSizeInBits MOD BitsPerBitset ;
-   IF b=0
-   THEN
-      b := BitsPerBitset
-   END ;
-   WHILE i>0 DO
-      DEC(i) ;
-      lo := SHIFT(s[i], RotateCount MOD BitsPerBitset) ;
-      hi := SHIFT(s[i], -(b - (RotateCount MOD BitsPerBitset))) ;
-      j := ((i*BitsPerBitset + RotateCount) MOD
-            SetSizeInBits) DIV BitsPerBitset ;
-      d[j] := d[j] + lo ;
-      j := (((i+1)*BitsPerBitset + RotateCount) MOD
-            SetSizeInBits) DIV BitsPerBitset ;
-      d[j] := d[j] + hi ;
-      b := BitsPerBitset
-   END
-END RotateLeft ;
-
-
-(*
-   RotateRight - performs the rotate right for a multi word set.
-                 This procedure might be called by the back end of
-                 GNU Modula-2 depending whether amount is known at compile
-                 time.
-*)
-
-PROCEDURE RotateRight (VAR s, d: ARRAY OF BITSET;
-                       SetSizeInBits: CARDINAL;
-                       RotateCount: CARDINAL) ;
-BEGIN
-   RotateLeft(s, d, SetSizeInBits, SetSizeInBits-RotateCount)
-END RotateRight ;
-
-
 END SYSTEM.
diff --git a/gcc/m2/gm2-libs/SysStorage.def b/gcc/m2/gm2-libs/SysStorage.def
index 1d2baacec96..4a27495c6c0 100644
--- a/gcc/m2/gm2-libs/SysStorage.def
+++ b/gcc/m2/gm2-libs/SysStorage.def
@@ -28,7 +28,9 @@ DEFINITION MODULE SysStorage ;
 
 (*  Provides dynamic allocation for the system components.
     This allows the application to use the traditional Storage module
-    which can be handled differently.  *)
+    which can be handled differently.
+    ALLOCATE and DEALLOCATE will call M2Diagnostic to adjust the
+    global tracking of the application heap.  *)
 
 FROM SYSTEM IMPORT ADDRESS ;
 EXPORT QUALIFIED ALLOCATE, DEALLOCATE, REALLOCATE, Available, Init ;
@@ -56,6 +58,11 @@ PROCEDURE DEALLOCATE (VAR a: ADDRESS ; size: CARDINAL) ;
                 is called, or alternatively it should have already
                 been initialized by ALLOCATE. The allocated storage
                 is resized accordingly.
+                Note that this procedure does not adjust the
+                M2Diagnostic.TotalHeap it is expected that the caller
+                must track the reallocation differences and call
+                M2Diagnostic.TotalHeapIncr or M2Diagnostic.TotalHeapDecr
+                as appropriate.
 *)
 
 PROCEDURE REALLOCATE (VAR a: ADDRESS; size: CARDINAL) ;
diff --git a/gcc/m2/gm2-libs/SysStorage.mod b/gcc/m2/gm2-libs/SysStorage.mod
index 4558b579fab..3f9fab6d697 100644
--- a/gcc/m2/gm2-libs/SysStorage.mod
+++ b/gcc/m2/gm2-libs/SysStorage.mod
@@ -30,6 +30,8 @@ FROM libc IMPORT malloc, free, realloc, memset, getenv, printf ;
 FROM Debug IMPORT Halt ;
 FROM SYSTEM IMPORT ADR ;
 
+IMPORT M2Diagnostic ;
+
 
 CONST
    enableDeallocation =  TRUE ;
@@ -55,7 +57,8 @@ BEGIN
       printf ("<DEBUG-CALL> %d SysStorage.ALLOCATE (0x%x, %d bytes)\n", callno, a, size) ;
       printf ("<MEM-ALLOC> %ld %d\n", a, size);
       INC (callno)
-   END
+   END ;
+   M2Diagnostic.TotalHeapIncr (size)
 END ALLOCATE ;
 
 
@@ -87,6 +90,7 @@ BEGIN
       END ;
       free (a)
    END ;
+   M2Diagnostic.TotalHeapDecr (size) ;
    a := NIL
 END DEALLOCATE ;
 
@@ -97,6 +101,11 @@ END DEALLOCATE ;
                 is called, or alternatively it should have already
                 been initialized by ALLOCATE. The allocated storage
                 is resized accordingly.
+                Note that this procedure does not adjust the
+                M2Diagnostic.TotalHeap it is expected that the caller
+                must track the reallocation differences and call
+                M2Diagnostic.TotalHeapIncr or M2Diagnostic.TotalHeapDecr
+                as appropriate.
 *)
 
 PROCEDURE REALLOCATE (VAR a: ADDRESS; size: CARDINAL) ;
diff --git a/gcc/m2/init/ppginit b/gcc/m2/init/ppginit
index 5094c4e2364..33014b33018 100644
--- a/gcc/m2/init/ppginit
+++ b/gcc/m2/init/ppginit
@@ -25,6 +25,7 @@ RTExceptions
 M2EXCEPTION
 M2RTS
 SysExceptions
+M2Diagnostic
 StrLib
 errno
 termios
@@ -45,6 +46,7 @@ UnixArgs
 FIO
 SFIO
 StrCase
+StringConvert
 bnflex
 Lists
 Args
diff --git a/gcc/m2/lang.opt b/gcc/m2/lang.opt
index 2aea4ccb77e..dc6abb1b677 100644
--- a/gcc/m2/lang.opt
+++ b/gcc/m2/lang.opt
@@ -206,6 +206,10 @@ fm2-whole-program
 Modula-2
 compile all implementation modules and program module at once
 
+fmem-report
+Modula-2
+; Documented in c.opt
+
 fmod=
 Modula-2 Joined
 recognize the specified suffix as implementation and module filenames
@@ -290,6 +294,10 @@ fswig
 Modula-2
 create a swig interface file for the module
 
+ftime-report
+Modula-2
+; Documented in c.opt
+
 funbounded-by-reference
 Modula-2
 optimize non var unbounded parameters by passing it by reference, providing it is not written to within the callee procedure.
@@ -302,6 +310,10 @@ fversion
 Modula-2
 ; Documented in common.opt
 
+fwideset
+Modula-2
+link against the module M2WIDESET to perform the wideset operator, the negative version of this option will generate a warning if this module is required
+
 fwholediv
 Modula-2
 turns on all division and modulus by zero checking for ordinal values
diff --git a/gcc/m2/mc-boot/GM2Diagnostic.cc b/gcc/m2/mc-boot/GM2Diagnostic.cc
new file mode 100644
index 00000000000..ee26359eee7
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2Diagnostic.cc
@@ -0,0 +1,1484 @@
+/* do not edit automatically generated by mc from M2Diagnostic.  */
+/* M2Diagnotic provides memory and time diagnosics to the user.
+
+Copyright (C) 2024 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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include <stdbool.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 _M2Diagnostic_H
+#define _M2Diagnostic_C
+
+#   include "GASCII.h"
+#   include "GSelective.h"
+#   include "GStringConvert.h"
+#   include "GStorage.h"
+#   include "GDynamicStrings.h"
+#   include "GM2RTS.h"
+
+typedef struct M2Diagnostic_DiagProc_p M2Diagnostic_DiagProc;
+
+#   define EnableDiagnostics true
+#   define DefaultTimeEnableValue false
+#   define DefaultMemEnableValue false
+#   define MaxParam 4
+#   define MICROSEC 100000
+typedef struct M2Diagnostic_timeDiag_r M2Diagnostic_timeDiag;
+
+typedef struct M2Diagnostic_memDiag_r M2Diagnostic_memDiag;
+
+typedef struct M2Diagnostic__T1_r M2Diagnostic__T1;
+
+typedef struct M2Diagnostic__T2_a M2Diagnostic__T2;
+
+typedef enum {M2Diagnostic_timediag, M2Diagnostic_memdiag} M2Diagnostic_DiagType;
+
+#   define kilo 1024
+#   define mega (kilo*kilo)
+#   define giga (mega*kilo)
+typedef M2Diagnostic__T1 *M2Diagnostic_Diagnostic;
+
+typedef void (*M2Diagnostic_DiagProc_t) (M2Diagnostic_Diagnostic);
+struct M2Diagnostic_DiagProc_p { M2Diagnostic_DiagProc_t proc; };
+
+struct M2Diagnostic_timeDiag_r {
+                                 unsigned int count;
+                                 Selective_Timeval total;
+                                 Selective_Timeval enter;
+                                 Selective_Timeval exit_;
+                               };
+
+struct M2Diagnostic__T2_a { long unsigned int array[MaxParam-1+1]; };
+struct M2Diagnostic_memDiag_r {
+                                M2Diagnostic__T2 param;
+                              };
+
+struct M2Diagnostic__T1_r {
+                            DynamicStrings_String name;
+                            DynamicStrings_String format;
+                            bool enable;
+                            M2Diagnostic_Diagnostic next;
+                            M2Diagnostic_DiagType type;  /* case tag */
+                            union {
+                                    M2Diagnostic_timeDiag tdiag;
+                                    M2Diagnostic_memDiag mdiag;
+                                  };
+                          };
+
+static DynamicStrings_String Output;
+static long unsigned int TotalHeap;
+static M2Diagnostic_Diagnostic Head;
+static bool DefaultTimeEnable;
+static bool DefaultMemEnable;
+static Selective_Timeval StartTime;
+static Selective_Timeval TotalTime;
+
+/*
+   InitTimeDiagnostic - create and return a time diagnostic.
+                        The format string can be free form and may
+                        contain {1T}, {1C} or {1P}.
+                        {1T} will contain the time and
+                        {1C} the count of the number of times the
+                        code enters the time diagnostic code region.
+                        {1P} generates the time as a percentage.
+                        {0T} is the total time for the application.
+                        {{ is rendered as a single {.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_InitTimeDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high);
+
+/*
+   EnterDiagnostic - attribute all execution time from now to TimeDiag.
+*/
+
+extern "C" void M2Diagnostic_EnterDiagnostic (M2Diagnostic_Diagnostic TimeDiag);
+
+/*
+   ExitDiagnostic - stop attributing execution time to TimeDiag.
+*/
+
+extern "C" void M2Diagnostic_ExitDiagnostic (M2Diagnostic_Diagnostic TimeDiag);
+
+/*
+   InitMemDiagnostic - create and return a memory diagnostic.
+                       The format string can be free form and may
+                       contain {1M} {1d} {1x} {1P}.
+                       {1M} is replaced by the value of the first parameter
+                       with memory size units.
+                       {1d} unsigned decimal.  {1x} unsigned hexadecimal.
+                       {0M} is the global allocation (Storage.mod:ALLOCATE).
+                       {1P} is the percentage of param 1 relative
+                       to global memory.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_InitMemDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high);
+
+/*
+   MemIncr - allow the appropriate parameter to be incremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+extern "C" void M2Diagnostic_MemIncr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int incr);
+
+/*
+   MemDecr - allow the appropriate parameter to be decremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+extern "C" void M2Diagnostic_MemDecr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int decr);
+
+/*
+   MemSet - allow the appropriate parameter to be set to value.
+            All parameters are initially set to zero.
+*/
+
+extern "C" void M2Diagnostic_MemSet (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int value);
+
+/*
+   TotalHeapIncr - increments the total heap used.
+*/
+
+extern "C" void M2Diagnostic_TotalHeapIncr (unsigned int incr);
+
+/*
+   TotalHeapDecr - decrements the total heap used.
+*/
+
+extern "C" void M2Diagnostic_TotalHeapDecr (unsigned int incr);
+
+/*
+   SetEnable - set the enable flag in Diag to value.
+*/
+
+extern "C" void M2Diagnostic_SetEnable (M2Diagnostic_Diagnostic Diag, bool value);
+
+/*
+   Lookup - returns the Diagnostic containing name or NIL
+            if it does not exist.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_Lookup (const char *name_, unsigned int _name_high);
+
+/*
+   GetName - returns the name of Diag.
+*/
+
+extern "C" DynamicStrings_String M2Diagnostic_GetName (M2Diagnostic_Diagnostic Diag);
+
+/*
+   ForeachDiagDo - for diag in global diag list do
+                      dp (diag);
+                   end
+*/
+
+extern "C" void M2Diagnostic_ForeachDiagDo (M2Diagnostic_DiagProc dp);
+
+/*
+   SetDefaultConfig - force the Diag enable flag to the
+                      time or mem global default.
+*/
+
+extern "C" void M2Diagnostic_SetDefaultConfig (M2Diagnostic_Diagnostic Diag);
+
+/*
+   Configure - will turn on or off all the memory or time
+               instrumentation diagnostics and set the defaults
+               time and mem values.
+*/
+
+extern "C" void M2Diagnostic_Configure (bool time_, bool mem);
+
+/*
+   Generate - return a string containing the output from
+              all the diagnostics enabled.
+*/
+
+extern "C" DynamicStrings_String M2Diagnostic_Generate (void);
+
+/*
+   Assert - halt if b is false.
+*/
+
+static void Assert (bool b);
+
+/*
+   Error - generate a error simple message with indicating the
+           format specifier ch is incorrect.
+*/
+
+static void Error (const char *msg_, unsigned int _msg_high, char ch);
+
+/*
+   Accumulate - total := total + exit - enter
+*/
+
+static void Accumulate (Selective_Timeval total, Selective_Timeval enter, Selective_Timeval exit_);
+
+/*
+   IncTime - left := left + right.
+*/
+
+static void IncTime (Selective_Timeval left, Selective_Timeval right);
+
+/*
+   DecTime - left := left - right.
+*/
+
+static void DecTime (Selective_Timeval left, Selective_Timeval right);
+
+/*
+   CheckParam -
+*/
+
+static void CheckParam (unsigned int paramno);
+
+/*
+   CreateStartTime -
+*/
+
+static void CreateStartTime (void);
+
+/*
+   UpdateTotalTime -
+*/
+
+static void UpdateTotalTime (void);
+
+/*
+   GetTimeParam - a paramno of 0 will return the total time so far
+                  whereas a paramno > 0 will return the time associated
+                  with Diag.
+*/
+
+static Selective_Timeval GetTimeParam (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   GetMemParam - return the mem paramno from within Diag.  A paramno of 0
+                 will return the total heap.
+*/
+
+static long unsigned int GetMemParam (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   CreateDecimalMem - converts c to a decimal string.
+*/
+
+static DynamicStrings_String CreateDecimalMem (long unsigned int c);
+
+/*
+   CreateHexadecimalMem - converts c to a hexadecimal string.
+*/
+
+static DynamicStrings_String CreateHexadecimalMem (long unsigned int c);
+
+/*
+   CreateDecimalTime - return timeval as a decimal seconds.usecs string.
+*/
+
+static DynamicStrings_String CreateDecimalTime (Selective_Timeval timeval);
+
+/*
+   CreateHexadecimalTime - return timeval as a hexadecimal seconds.usecs string.
+*/
+
+static DynamicStrings_String CreateHexadecimalTime (Selective_Timeval timeval);
+
+/*
+   Decimal - convert paramno in Diag to a string.
+*/
+
+static DynamicStrings_String Decimal (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   Hexadecimal - convert paramno in Diag to a hex string.
+*/
+
+static DynamicStrings_String Hexadecimal (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   Count - return the count field for a time diag or return the decimal
+           value for a paramno in a mem diag.
+*/
+
+static DynamicStrings_String Count (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   Microsec - convert timeval into microseconds and return the value as
+              a longcard.
+*/
+
+static long unsigned int Microsec (Selective_Timeval timeval);
+
+/*
+   CreateTimePercent - return timeval as a percentage of the TotalTime.
+*/
+
+static DynamicStrings_String CreateTimePercent (Selective_Timeval timeval);
+
+/*
+   CreateMemPercent - return memval as a percentage of TotalHeap.
+*/
+
+static DynamicStrings_String CreateMemPercent (long unsigned int memval);
+
+/*
+   DescribePercent - call the appropriate mem or time percentage procedure.
+*/
+
+static DynamicStrings_String DescribePercent (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   DescribeMemory - return the memory diagnostic
+*/
+
+static DynamicStrings_String DescribeMemory (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   DescribeTime - returns the time diagnostic in seconds.
+*/
+
+static DynamicStrings_String DescribeTime (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   ParamSpec - ebnf:
+
+               ( '{' | '0' | '1' | '2' | '3' | '4' )
+               ( 'd' | 'x' | 'C' | 'T' | 'M' | 'N' | 'P' )
+               '}'
+*/
+
+static unsigned int ParamSpec (M2Diagnostic_Diagnostic Diag, unsigned int i);
+
+/*
+   FormatDiag - ebnf:
+
+                { ( '{' ParamSpec ) | any }
+*/
+
+static void FormatDiag (M2Diagnostic_Diagnostic Diag);
+
+
+/*
+   Assert - halt if b is false.
+*/
+
+static void Assert (bool b)
+{
+  if (! b)
+    {
+      M2RTS_HALT (-1);
+      __builtin_unreachable ();
+    }
+}
+
+
+/*
+   Error - generate a error simple message with indicating the
+           format specifier ch is incorrect.
+*/
+
+static void Error (const char *msg_, unsigned int _msg_high, char ch)
+{
+  char msg[_msg_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (msg, msg_, _msg_high+1);
+
+  M2RTS_HALT (-1);
+  __builtin_unreachable ();
+}
+
+
+/*
+   Accumulate - total := total + exit - enter
+*/
+
+static void Accumulate (Selective_Timeval total, Selective_Timeval enter, Selective_Timeval exit_)
+{
+  IncTime (total, exit_);
+  DecTime (total, enter);
+}
+
+
+/*
+   IncTime - left := left + right.
+*/
+
+static void IncTime (Selective_Timeval left, Selective_Timeval right)
+{
+  unsigned int lsec;
+  unsigned int lusec;
+  unsigned int rsec;
+  unsigned int rusec;
+
+  Selective_GetTime (left, &lsec, &lusec);
+  Selective_GetTime (right, &rsec, &rusec);
+  if ((lusec+rusec) < MICROSEC)
+    {
+      /* No carry  */
+      lusec += rusec;
+      lsec += rsec;
+    }
+  else
+    {
+      lusec += rusec;
+      lusec -= MICROSEC;
+      lsec += rsec+1;
+    }
+  Selective_SetTime (left, lsec, lusec);
+}
+
+
+/*
+   DecTime - left := left - right.
+*/
+
+static void DecTime (Selective_Timeval left, Selective_Timeval right)
+{
+  unsigned int lsec;
+  unsigned int lusec;
+  unsigned int rsec;
+  unsigned int rusec;
+
+  Selective_GetTime (left, &lsec, &lusec);
+  Selective_GetTime (right, &rsec, &rusec);
+  if (lusec >= rusec)
+    {
+      /* No borrow.  */
+      lusec -= rusec;
+      if (lsec >= rsec)
+        {
+          lsec -= rsec;
+        }
+      else
+        {
+          lsec = 0;
+        }
+    }
+  else
+    {
+      if (lsec > 0)
+        {
+          lusec += MICROSEC;
+          lusec -= rusec;
+          lsec -= 1;
+          if (lsec >= rsec)
+            {
+              lsec -= rsec;
+            }
+          else
+            {
+              lsec = 0;
+            }
+        }
+      else
+        {
+          lsec = 0;
+          lusec = 0;
+        }
+    }
+  Selective_SetTime (left, lsec, lusec);
+}
+
+
+/*
+   CheckParam -
+*/
+
+static void CheckParam (unsigned int paramno)
+{
+  if ((paramno < 1) || (paramno > MaxParam))
+    {
+      M2RTS_HALT (-1);
+      __builtin_unreachable ();
+    }
+}
+
+
+/*
+   CreateStartTime -
+*/
+
+static void CreateStartTime (void)
+{
+  if (EnableDiagnostics)
+    {
+      /* avoid dangling else.  */
+      if (StartTime == NULL)
+        {
+          StartTime = Selective_InitTime (0, 0);
+          if ((Selective_GetTimeOfDay (StartTime)) == 0)
+            {}  /* empty.  */
+        }
+      if (TotalTime == NULL)
+        {
+          TotalTime = Selective_InitTime (0, 0);
+        }
+    }
+  else
+    {
+      StartTime = NULL;
+      TotalTime = NULL;
+    }
+}
+
+
+/*
+   UpdateTotalTime -
+*/
+
+static void UpdateTotalTime (void)
+{
+  if ((Selective_GetTimeOfDay (TotalTime)) == 0)
+    {}  /* empty.  */
+  DecTime (TotalTime, StartTime);
+}
+
+
+/*
+   GetTimeParam - a paramno of 0 will return the total time so far
+                  whereas a paramno > 0 will return the time associated
+                  with Diag.
+*/
+
+static Selective_Timeval GetTimeParam (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  unsigned int sec;
+  unsigned int usec;
+
+  if (paramno == 0)
+    {
+      UpdateTotalTime ();
+      return TotalTime;
+    }
+  else
+    {
+      return Diag->tdiag.total;
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   GetMemParam - return the mem paramno from within Diag.  A paramno of 0
+                 will return the total heap.
+*/
+
+static long unsigned int GetMemParam (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  if (paramno == 0)
+    {
+      return TotalHeap;
+    }
+  else
+    {
+      return Diag->mdiag.param.array[paramno-1];
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateDecimalMem - converts c to a decimal string.
+*/
+
+static DynamicStrings_String CreateDecimalMem (long unsigned int c)
+{
+  return StringConvert_LongCardinalToString (c, 0, ' ', 10, true);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateHexadecimalMem - converts c to a hexadecimal string.
+*/
+
+static DynamicStrings_String CreateHexadecimalMem (long unsigned int c)
+{
+  return DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0x", 2), DynamicStrings_Mark (StringConvert_LongCardinalToString (c, 0, ' ', 16, true)));
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateDecimalTime - return timeval as a decimal seconds.usecs string.
+*/
+
+static DynamicStrings_String CreateDecimalTime (Selective_Timeval timeval)
+{
+  unsigned int sec;
+  unsigned int usec;
+
+  Selective_GetTime (timeval, &sec, &usec);
+  return DynamicStrings_ConCat (DynamicStrings_ConCat (StringConvert_LongCardinalToString (static_cast<long unsigned int> (sec), 0, ' ', 10, true), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1))), StringConvert_LongCardinalToString (static_cast<long unsigned int> (usec), 6, '0', 10, true));
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateHexadecimalTime - return timeval as a hexadecimal seconds.usecs string.
+*/
+
+static DynamicStrings_String CreateHexadecimalTime (Selective_Timeval timeval)
+{
+  unsigned int sec;
+  unsigned int usec;
+
+  Selective_GetTime (timeval, &sec, &usec);
+  return DynamicStrings_ConCat (DynamicStrings_ConCat (StringConvert_LongCardinalToString (static_cast<long unsigned int> (sec), 0, ' ', 16, true), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1))), StringConvert_LongCardinalToString (static_cast<long unsigned int> (usec), 5, '0', 16, true));
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   Decimal - convert paramno in Diag to a string.
+*/
+
+static DynamicStrings_String Decimal (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  switch (Diag->type)
+    {
+      case M2Diagnostic_memdiag:
+        return CreateDecimalMem (GetMemParam (Diag, paramno));
+        break;
+
+      case M2Diagnostic_timediag:
+        return CreateDecimalTime (GetTimeParam (Diag, paramno));
+        break;
+
+
+      default:
+        CaseException ("../../gcc/m2/gm2-libs/M2Diagnostic.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  return static_cast<DynamicStrings_String> (NULL);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   Hexadecimal - convert paramno in Diag to a hex string.
+*/
+
+static DynamicStrings_String Hexadecimal (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  switch (Diag->type)
+    {
+      case M2Diagnostic_memdiag:
+        return CreateHexadecimalMem (GetMemParam (Diag, paramno));
+        break;
+
+      case M2Diagnostic_timediag:
+        return CreateHexadecimalTime (GetTimeParam (Diag, paramno));
+        break;
+
+
+      default:
+        CaseException ("../../gcc/m2/gm2-libs/M2Diagnostic.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  return static_cast<DynamicStrings_String> (NULL);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   Count - return the count field for a time diag or return the decimal
+           value for a paramno in a mem diag.
+*/
+
+static DynamicStrings_String Count (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  switch (Diag->type)
+    {
+      case M2Diagnostic_memdiag:
+        return CreateDecimalMem (GetMemParam (Diag, paramno));
+        break;
+
+      case M2Diagnostic_timediag:
+        return StringConvert_ctos (Diag->tdiag.count, 0, ' ');
+        break;
+
+
+      default:
+        CaseException ("../../gcc/m2/gm2-libs/M2Diagnostic.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  return static_cast<DynamicStrings_String> (NULL);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   Microsec - convert timeval into microseconds and return the value as
+              a longcard.
+*/
+
+static long unsigned int Microsec (Selective_Timeval timeval)
+{
+  unsigned int sec;
+  unsigned int usec;
+  long unsigned int microsec;
+
+  Selective_GetTime (timeval, &sec, &usec);
+  microsec = (((long unsigned int ) (sec))*MICROSEC)+((long unsigned int ) (usec));
+  return microsec;
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateTimePercent - return timeval as a percentage of the TotalTime.
+*/
+
+static DynamicStrings_String CreateTimePercent (Selective_Timeval timeval)
+{
+  long unsigned int total;
+  long unsigned int param;
+
+  if (timeval == TotalTime)
+    {
+      param = 100;
+    }
+  else
+    {
+      UpdateTotalTime ();
+      param = (Microsec (timeval))*100;
+      total = Microsec (TotalTime);
+      if (total == 0)
+        {
+          param = 0;
+        }
+      else
+        {
+          param = param / total;
+        }
+    }
+  return DynamicStrings_ConCatChar (StringConvert_ctos ((unsigned int ) (param), 3, ' '), '%');
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateMemPercent - return memval as a percentage of TotalHeap.
+*/
+
+static DynamicStrings_String CreateMemPercent (long unsigned int memval)
+{
+  long unsigned int param;
+
+  if (memval == TotalHeap)
+    {
+      param = 100;
+    }
+  else
+    {
+      param = memval*100;
+      if (TotalHeap == 0)
+        {
+          param = 0;
+        }
+      else
+        {
+          param = param / TotalHeap;
+        }
+    }
+  return DynamicStrings_ConCatChar (StringConvert_ctos ((unsigned int ) (param), 3, ' '), '%');
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   DescribePercent - call the appropriate mem or time percentage procedure.
+*/
+
+static DynamicStrings_String DescribePercent (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  switch (Diag->type)
+    {
+      case M2Diagnostic_memdiag:
+        return CreateMemPercent (GetMemParam (Diag, paramno));
+        break;
+
+      case M2Diagnostic_timediag:
+        return CreateTimePercent (GetTimeParam (Diag, paramno));
+        break;
+
+
+      default:
+        CaseException ("../../gcc/m2/gm2-libs/M2Diagnostic.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  return static_cast<DynamicStrings_String> (NULL);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   DescribeMemory - return the memory diagnostic
+*/
+
+static DynamicStrings_String DescribeMemory (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  long unsigned int param;
+  DynamicStrings_String s;
+
+  param = GetMemParam (Diag, paramno);
+  if (param < kilo)
+    {
+      s = DynamicStrings_ConCat (StringConvert_LongCardinalToString (param, 0, ' ', 10, false), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " Bytes", 6)));
+    }
+  else if (param < mega)
+    {
+      /* avoid dangling else.  */
+      param = param / kilo;
+      s = DynamicStrings_ConCat (StringConvert_LongCardinalToString (param, 0, ' ', 10, false), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "KB", 2)));
+    }
+  else
+    {
+      /* avoid dangling else.  */
+      param = param / mega;
+      s = DynamicStrings_ConCat (StringConvert_LongCardinalToString (param, 0, ' ', 10, false), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MB", 2)));
+    }
+  return s;
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   DescribeTime - returns the time diagnostic in seconds.
+*/
+
+static DynamicStrings_String DescribeTime (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  unsigned int sec;
+  unsigned int usec;
+
+  switch (Diag->type)
+    {
+      case M2Diagnostic_memdiag:
+        M2RTS_HALT (-1);
+        __builtin_unreachable ();
+        break;
+
+      case M2Diagnostic_timediag:
+        Selective_GetTime (GetTimeParam (Diag, paramno), &sec, &usec);
+        return DynamicStrings_ConCat (DynamicStrings_ConCat (StringConvert_LongCardinalToString (static_cast<long unsigned int> (sec), 0, ' ', 10, true), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1))), DynamicStrings_ConCat (StringConvert_LongCardinalToString (static_cast<long unsigned int> (usec), 6, '0', 10, true), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " sec", 4))));
+        break;
+
+
+      default:
+        CaseException ("../../gcc/m2/gm2-libs/M2Diagnostic.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  return static_cast<DynamicStrings_String> (NULL);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   ParamSpec - ebnf:
+
+               ( '{' | '0' | '1' | '2' | '3' | '4' )
+               ( 'd' | 'x' | 'C' | 'T' | 'M' | 'N' | 'P' )
+               '}'
+*/
+
+static unsigned int ParamSpec (M2Diagnostic_Diagnostic Diag, unsigned int i)
+{
+  unsigned int paramno;
+  unsigned int length;
+  char ch;
+
+  length = DynamicStrings_Length (Diag->format);
+  paramno = 0;
+  if (i < length)
+    {
+      ch = DynamicStrings_char (Diag->format, static_cast<int> (i));
+      switch (ch)
+        {
+          case '{':
+            Output = DynamicStrings_ConCatChar (Output, '{');
+            return i+1;
+            break;
+
+          case '0':
+            paramno = 0;
+            break;
+
+          case '1':
+            paramno = 1;
+            break;
+
+          case '2':
+            paramno = 2;
+            break;
+
+          case '3':
+            paramno = 3;
+            break;
+
+          case '4':
+            paramno = 4;
+            break;
+
+
+          default:
+            Error ((const char *) "unexpected character: ", 22, ch);
+            break;
+        }
+      i += 1;
+      if (i < length)
+        {
+          ch = DynamicStrings_char (Diag->format, static_cast<int> (i));
+          switch (ch)
+            {
+              case 'd':
+                Output = DynamicStrings_ConCat (Output, Decimal (Diag, paramno));
+                break;
+
+              case 'x':
+                Output = DynamicStrings_ConCat (Output, Hexadecimal (Diag, paramno));
+                break;
+
+              case 'C':
+                Output = DynamicStrings_ConCat (Output, Count (Diag, paramno));
+                break;
+
+              case 'M':
+                Output = DynamicStrings_ConCat (Output, DescribeMemory (Diag, paramno));
+                break;
+
+              case 'N':
+                Output = DynamicStrings_ConCat (Output, Diag->name);
+                break;
+
+              case 'P':
+                Output = DynamicStrings_ConCat (Output, DescribePercent (Diag, paramno));
+                break;
+
+              case 'T':
+                Output = DynamicStrings_ConCat (Output, DescribeTime (Diag, paramno));
+                break;
+
+
+              default:
+                Error ((const char *) "unexpected character: ", 22, ch);
+                break;
+            }
+          i += 1;
+          if (i < length)
+            {
+              ch = DynamicStrings_char (Diag->format, static_cast<int> (i));
+              if (ch != '}')
+                {
+                  Error ((const char *) "expected } character, seen ", 27, ch);
+                }
+            }
+        }
+    }
+  return i+1;
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   FormatDiag - ebnf:
+
+                { ( '{' ParamSpec ) | any }
+*/
+
+static void FormatDiag (M2Diagnostic_Diagnostic Diag)
+{
+  unsigned int i;
+  unsigned int length;
+  char ch;
+
+  i = 0;
+  length = DynamicStrings_Length (Diag->format);
+  while (i < length)
+    {
+      ch = DynamicStrings_char (Diag->format, static_cast<int> (i));
+      if (ch == '{')
+        {
+          i += 1;
+          i = ParamSpec (Diag, i);
+        }
+      else
+        {
+          Output = DynamicStrings_ConCatChar (Output, ch);
+          i += 1;
+        }
+    }
+  Output = DynamicStrings_ConCatChar (Output, ASCII_nl);
+}
+
+
+/*
+   InitTimeDiagnostic - create and return a time diagnostic.
+                        The format string can be free form and may
+                        contain {1T}, {1C} or {1P}.
+                        {1T} will contain the time and
+                        {1C} the count of the number of times the
+                        code enters the time diagnostic code region.
+                        {1P} generates the time as a percentage.
+                        {0T} is the total time for the application.
+                        {{ is rendered as a single {.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_InitTimeDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high)
+{
+  M2Diagnostic_Diagnostic d;
+  char name[_name_high+1];
+  char format[_format_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (name, name_, _name_high+1);
+  memcpy (format, format_, _format_high+1);
+
+  if (EnableDiagnostics)
+    {
+      Storage_ALLOCATE ((void **) &d, sizeof (M2Diagnostic__T1));
+      d->name = DynamicStrings_InitString ((const char *) name, _name_high);
+      d->format = DynamicStrings_InitString ((const char *) format, _format_high);
+      d->enable = DefaultTimeEnable;
+      d->next = Head;
+      d->type = M2Diagnostic_timediag;
+      switch (d->type)
+        {
+          case M2Diagnostic_timediag:
+            d->tdiag.count = 0;
+            d->tdiag.total = Selective_InitTime (0, 0);
+            d->tdiag.enter = Selective_InitTime (0, 0);
+            d->tdiag.exit_ = Selective_InitTime (0, 0);
+            break;
+
+
+          default:
+            M2RTS_HALT (-1);
+            __builtin_unreachable ();
+            break;
+        }
+      Head = d;
+      return d;
+    }
+  else
+    {
+      return NULL;
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   EnterDiagnostic - attribute all execution time from now to TimeDiag.
+*/
+
+extern "C" void M2Diagnostic_EnterDiagnostic (M2Diagnostic_Diagnostic TimeDiag)
+{
+  if (EnableDiagnostics && (TimeDiag != NULL))
+    {
+      Assert (TimeDiag->type == M2Diagnostic_timediag);
+      Assert ((Selective_GetTimeOfDay (TimeDiag->tdiag.enter)) == 0);
+      TimeDiag->tdiag.count += 1;
+    }
+}
+
+
+/*
+   ExitDiagnostic - stop attributing execution time to TimeDiag.
+*/
+
+extern "C" void M2Diagnostic_ExitDiagnostic (M2Diagnostic_Diagnostic TimeDiag)
+{
+  if (EnableDiagnostics && (TimeDiag != NULL))
+    {
+      Assert (TimeDiag->type == M2Diagnostic_timediag);
+      Assert ((Selective_GetTimeOfDay (TimeDiag->tdiag.exit_)) == 0);
+      Accumulate (TimeDiag->tdiag.total, TimeDiag->tdiag.enter, TimeDiag->tdiag.exit_);
+    }
+}
+
+
+/*
+   InitMemDiagnostic - create and return a memory diagnostic.
+                       The format string can be free form and may
+                       contain {1M} {1d} {1x} {1P}.
+                       {1M} is replaced by the value of the first parameter
+                       with memory size units.
+                       {1d} unsigned decimal.  {1x} unsigned hexadecimal.
+                       {0M} is the global allocation (Storage.mod:ALLOCATE).
+                       {1P} is the percentage of param 1 relative
+                       to global memory.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_InitMemDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high)
+{
+  unsigned int i;
+  M2Diagnostic_Diagnostic d;
+  char name[_name_high+1];
+  char format[_format_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (name, name_, _name_high+1);
+  memcpy (format, format_, _format_high+1);
+
+  if (EnableDiagnostics)
+    {
+      Storage_ALLOCATE ((void **) &d, sizeof (M2Diagnostic__T1));
+      d->name = DynamicStrings_InitString ((const char *) name, _name_high);
+      d->format = DynamicStrings_InitString ((const char *) format, _format_high);
+      d->enable = DefaultMemEnable;
+      d->next = Head;
+      d->type = M2Diagnostic_memdiag;
+      switch (d->type)
+        {
+          case M2Diagnostic_memdiag:
+            for (i=1; i<=MaxParam; i++)
+              {
+                d->mdiag.param.array[i-1] = 0;
+              }
+            break;
+
+
+          default:
+            M2RTS_HALT (-1);
+            __builtin_unreachable ();
+            break;
+        }
+      Head = d;
+      return d;
+    }
+  else
+    {
+      return NULL;
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   MemIncr - allow the appropriate parameter to be incremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+extern "C" void M2Diagnostic_MemIncr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int incr)
+{
+  if (EnableDiagnostics && (MemDiag != NULL))
+    {
+      CheckParam (paramno);
+      switch (MemDiag->type)
+        {
+          case M2Diagnostic_memdiag:
+            MemDiag->mdiag.param.array[paramno-1] += (long unsigned int ) (incr);
+            break;
+
+
+          default:
+            M2RTS_HALT (-1);
+            __builtin_unreachable ();
+            break;
+        }
+    }
+}
+
+
+/*
+   MemDecr - allow the appropriate parameter to be decremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+extern "C" void M2Diagnostic_MemDecr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int decr)
+{
+  if (EnableDiagnostics && (MemDiag != NULL))
+    {
+      CheckParam (paramno);
+      switch (MemDiag->type)
+        {
+          case M2Diagnostic_memdiag:
+            MemDiag->mdiag.param.array[paramno-1] -= (long unsigned int ) (decr);
+            break;
+
+
+          default:
+            M2RTS_HALT (-1);
+            __builtin_unreachable ();
+            break;
+        }
+    }
+}
+
+
+/*
+   MemSet - allow the appropriate parameter to be set to value.
+            All parameters are initially set to zero.
+*/
+
+extern "C" void M2Diagnostic_MemSet (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int value)
+{
+  if (EnableDiagnostics && (MemDiag != NULL))
+    {
+      CheckParam (paramno);
+      switch (MemDiag->type)
+        {
+          case M2Diagnostic_memdiag:
+            MemDiag->mdiag.param.array[paramno-1] = (long unsigned int ) (value);
+            break;
+
+
+          default:
+            M2RTS_HALT (-1);
+            __builtin_unreachable ();
+            break;
+        }
+    }
+}
+
+
+/*
+   TotalHeapIncr - increments the total heap used.
+*/
+
+extern "C" void M2Diagnostic_TotalHeapIncr (unsigned int incr)
+{
+  if (EnableDiagnostics)
+    {
+      TotalHeap = TotalHeap+((long unsigned int ) (incr));
+    }
+}
+
+
+/*
+   TotalHeapDecr - decrements the total heap used.
+*/
+
+extern "C" void M2Diagnostic_TotalHeapDecr (unsigned int incr)
+{
+  if (EnableDiagnostics)
+    {
+      TotalHeap = TotalHeap-((long unsigned int ) (incr));
+    }
+}
+
+
+/*
+   SetEnable - set the enable flag in Diag to value.
+*/
+
+extern "C" void M2Diagnostic_SetEnable (M2Diagnostic_Diagnostic Diag, bool value)
+{
+  if (EnableDiagnostics && (Diag != NULL))
+    {
+      Diag->enable = value;
+    }
+}
+
+
+/*
+   Lookup - returns the Diagnostic containing name or NIL
+            if it does not exist.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_Lookup (const char *name_, unsigned int _name_high)
+{
+  M2Diagnostic_Diagnostic ptr;
+  DynamicStrings_String s;
+  char name[_name_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (name, name_, _name_high+1);
+
+  if (EnableDiagnostics)
+    {
+      s = DynamicStrings_InitString ((const char *) name, _name_high);
+      ptr = Head;
+      while (ptr != NULL)
+        {
+          if (DynamicStrings_Equal (ptr->name, s))
+            {
+              s = DynamicStrings_KillString (s);
+              return ptr;
+            }
+          ptr = ptr->next;
+        }
+      s = DynamicStrings_KillString (s);
+      return NULL;
+    }
+  else
+    {
+      return NULL;
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   GetName - returns the name of Diag.
+*/
+
+extern "C" DynamicStrings_String M2Diagnostic_GetName (M2Diagnostic_Diagnostic Diag)
+{
+  if (EnableDiagnostics && (Diag != NULL))
+    {
+      return Diag->name;
+    }
+  else
+    {
+      return static_cast<DynamicStrings_String> (NULL);
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   ForeachDiagDo - for diag in global diag list do
+                      dp (diag);
+                   end
+*/
+
+extern "C" void M2Diagnostic_ForeachDiagDo (M2Diagnostic_DiagProc dp)
+{
+  M2Diagnostic_Diagnostic ptr;
+
+  ptr = Head;
+  while (ptr != NULL)
+    {
+      (*dp.proc) (ptr);
+      ptr = ptr->next;
+    }
+}
+
+
+/*
+   SetDefaultConfig - force the Diag enable flag to the
+                      time or mem global default.
+*/
+
+extern "C" void M2Diagnostic_SetDefaultConfig (M2Diagnostic_Diagnostic Diag)
+{
+  if (Diag->type == M2Diagnostic_timediag)
+    {
+      Diag->enable = DefaultTimeEnable;
+    }
+  else
+    {
+      Diag->enable = DefaultMemEnable;
+    }
+}
+
+
+/*
+   Configure - will turn on or off all the memory or time
+               instrumentation diagnostics and set the defaults
+               time and mem values.
+*/
+
+extern "C" void M2Diagnostic_Configure (bool time_, bool mem)
+{
+  if (EnableDiagnostics)
+    {
+      DefaultTimeEnable = time_;
+      DefaultMemEnable = mem;
+      M2Diagnostic_ForeachDiagDo ((M2Diagnostic_DiagProc) {(M2Diagnostic_DiagProc_t) M2Diagnostic_SetDefaultConfig});
+    }
+}
+
+
+/*
+   Generate - return a string containing the output from
+              all the diagnostics enabled.
+*/
+
+extern "C" DynamicStrings_String M2Diagnostic_Generate (void)
+{
+  if (EnableDiagnostics)
+    {
+      Output = DynamicStrings_KillString (Output);
+      Output = DynamicStrings_InitString ((const char *) "", 0);
+      M2Diagnostic_ForeachDiagDo ((M2Diagnostic_DiagProc) {(M2Diagnostic_DiagProc_t) FormatDiag});
+      return Output;
+    }
+  else
+    {
+      return static_cast<DynamicStrings_String> (NULL);
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+extern "C" void _M2_M2Diagnostic_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+  TotalHeap = 0;
+  StartTime = NULL;
+  TotalTime = NULL;
+  CreateStartTime ();
+  Head = NULL;
+  Output = static_cast<DynamicStrings_String> (NULL);
+  DefaultTimeEnable = DefaultTimeEnableValue;
+  DefaultMemEnable = DefaultMemEnableValue;
+}
+
+extern "C" void _M2_M2Diagnostic_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GM2Diagnostic.h b/gcc/m2/mc-boot/GM2Diagnostic.h
new file mode 100644
index 00000000000..51f592daf3b
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2Diagnostic.h
@@ -0,0 +1,186 @@
+/* do not edit automatically generated by mc from M2Diagnostic.  */
+/* M2Diagnotic provides memory and time diagnosics to the user.
+
+Copyright (C) 2024 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/>.  */
+
+
+#if !defined (_M2Diagnostic_H)
+#   define _M2Diagnostic_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#include <stdbool.h>
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_M2Diagnostic_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (M2Diagnostic_Diagnostic_D)
+#  define M2Diagnostic_Diagnostic_D
+   typedef void *M2Diagnostic_Diagnostic;
+#endif
+
+typedef struct M2Diagnostic_DiagProc_p M2Diagnostic_DiagProc;
+
+typedef void (*M2Diagnostic_DiagProc_t) (M2Diagnostic_Diagnostic);
+struct M2Diagnostic_DiagProc_p { M2Diagnostic_DiagProc_t proc; };
+
+
+/*
+   InitTimeDiagnostic - create and return a time diagnostic.
+                        The format string can be free form and may
+                        contain {1T}, {1C} or {1P}.
+                        {1T} will contain the time and
+                        {1C} the count of the number of times the
+                        code enters the time diagnostic code region.
+                        {1P} generates the time as a percentage.
+                        {0T} is the total time for the application.
+                        {{ is rendered as a single {.
+*/
+
+EXTERN M2Diagnostic_Diagnostic M2Diagnostic_InitTimeDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high);
+
+/*
+   EnterDiagnostic - attribute all execution time from now to TimeDiag.
+*/
+
+EXTERN void M2Diagnostic_EnterDiagnostic (M2Diagnostic_Diagnostic TimeDiag);
+
+/*
+   ExitDiagnostic - stop attributing execution time to TimeDiag.
+*/
+
+EXTERN void M2Diagnostic_ExitDiagnostic (M2Diagnostic_Diagnostic TimeDiag);
+
+/*
+   InitMemDiagnostic - create and return a memory diagnostic.
+                       The format string can be free form and may
+                       contain {1M} {1d} {1x} {1P}.
+                       {1M} is replaced by the value of the first parameter
+                       with memory size units.
+                       {1d} unsigned decimal.  {1x} unsigned hexadecimal.
+                       {0M} is the global allocation (Storage.mod:ALLOCATE).
+                       {1P} is the percentage of param 1 relative
+                       to global memory.
+*/
+
+EXTERN M2Diagnostic_Diagnostic M2Diagnostic_InitMemDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high);
+
+/*
+   MemIncr - allow the appropriate parameter to be incremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+EXTERN void M2Diagnostic_MemIncr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int incr);
+
+/*
+   MemDecr - allow the appropriate parameter to be decremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+EXTERN void M2Diagnostic_MemDecr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int decr);
+
+/*
+   MemSet - allow the appropriate parameter to be set to value.
+            All parameters are initially set to zero.
+*/
+
+EXTERN void M2Diagnostic_MemSet (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int value);
+
+/*
+   TotalHeapIncr - increments the total heap used.
+*/
+
+EXTERN void M2Diagnostic_TotalHeapIncr (unsigned int incr);
+
+/*
+   TotalHeapDecr - decrements the total heap used.
+*/
+
+EXTERN void M2Diagnostic_TotalHeapDecr (unsigned int incr);
+
+/*
+   SetEnable - set the enable flag in Diag to value.
+*/
+
+EXTERN void M2Diagnostic_SetEnable (M2Diagnostic_Diagnostic Diag, bool value);
+
+/*
+   Lookup - returns the Diagnostic containing name or NIL
+            if it does not exist.
+*/
+
+EXTERN M2Diagnostic_Diagnostic M2Diagnostic_Lookup (const char *name_, unsigned int _name_high);
+
+/*
+   GetName - returns the name of Diag.
+*/
+
+EXTERN DynamicStrings_String M2Diagnostic_GetName (M2Diagnostic_Diagnostic Diag);
+
+/*
+   ForeachDiagDo - for diag in global diag list do
+                      dp (diag);
+                   end
+*/
+
+EXTERN void M2Diagnostic_ForeachDiagDo (M2Diagnostic_DiagProc dp);
+
+/*
+   SetDefaultConfig - force the Diag enable flag to the
+                      time or mem global default.
+*/
+
+EXTERN void M2Diagnostic_SetDefaultConfig (M2Diagnostic_Diagnostic Diag);
+
+/*
+   Configure - will turn on or off all the memory or time
+               instrumentation diagnostics and set the defaults
+               time and mem values.
+*/
+
+EXTERN void M2Diagnostic_Configure (bool time_, bool mem);
+
+/*
+   Generate - return a string containing the output from
+              all the diagnostics enabled.
+*/
+
+EXTERN DynamicStrings_String M2Diagnostic_Generate (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GM2Diagnostic.cc b/gcc/m2/pge-boot/GM2Diagnostic.cc
new file mode 100644
index 00000000000..8f901d14d5e
--- /dev/null
+++ b/gcc/m2/pge-boot/GM2Diagnostic.cc
@@ -0,0 +1,1485 @@
+/* do not edit automatically generated by mc from M2Diagnostic.  */
+/* M2Diagnotic provides memory and time diagnosics to the user.
+
+Copyright (C) 2024 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/>.  */
+
+#include <stdbool.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 <stddef.h>
+#include <string.h>
+#include <limits.h>
+#   include "GStorage.h"
+#   include "Gmcrts.h"
+#if defined(__cplusplus)
+#   undef NULL
+#   define NULL 0
+#endif
+#define _M2Diagnostic_H
+#define _M2Diagnostic_C
+
+#   include "GASCII.h"
+#   include "GSelective.h"
+#   include "GStringConvert.h"
+#   include "GStorage.h"
+#   include "GDynamicStrings.h"
+#   include "GM2RTS.h"
+
+typedef struct M2Diagnostic_DiagProc_p M2Diagnostic_DiagProc;
+
+#   define EnableDiagnostics true
+#   define DefaultTimeEnableValue false
+#   define DefaultMemEnableValue false
+#   define MaxParam 4
+#   define MICROSEC 100000
+typedef struct M2Diagnostic_timeDiag_r M2Diagnostic_timeDiag;
+
+typedef struct M2Diagnostic_memDiag_r M2Diagnostic_memDiag;
+
+typedef struct M2Diagnostic__T1_r M2Diagnostic__T1;
+
+typedef struct M2Diagnostic__T2_a M2Diagnostic__T2;
+
+typedef enum {M2Diagnostic_timediag, M2Diagnostic_memdiag} M2Diagnostic_DiagType;
+
+#   define kilo 1024
+#   define mega (kilo*kilo)
+#   define giga (mega*kilo)
+typedef M2Diagnostic__T1 *M2Diagnostic_Diagnostic;
+
+typedef void (*M2Diagnostic_DiagProc_t) (M2Diagnostic_Diagnostic);
+struct M2Diagnostic_DiagProc_p { M2Diagnostic_DiagProc_t proc; };
+
+struct M2Diagnostic_timeDiag_r {
+                                 unsigned int count;
+                                 Selective_Timeval total;
+                                 Selective_Timeval enter;
+                                 Selective_Timeval exit_;
+                               };
+
+struct M2Diagnostic__T2_a { long unsigned int array[MaxParam-1+1]; };
+struct M2Diagnostic_memDiag_r {
+                                M2Diagnostic__T2 param;
+                              };
+
+struct M2Diagnostic__T1_r {
+                            DynamicStrings_String name;
+                            DynamicStrings_String format;
+                            bool enable;
+                            M2Diagnostic_Diagnostic next;
+                            M2Diagnostic_DiagType type;  /* case tag */
+                            union {
+                                    M2Diagnostic_timeDiag tdiag;
+                                    M2Diagnostic_memDiag mdiag;
+                                  };
+                          };
+
+static DynamicStrings_String Output;
+static long unsigned int TotalHeap;
+static M2Diagnostic_Diagnostic Head;
+static bool DefaultTimeEnable;
+static bool DefaultMemEnable;
+static Selective_Timeval StartTime;
+static Selective_Timeval TotalTime;
+
+/*
+   InitTimeDiagnostic - create and return a time diagnostic.
+                        The format string can be free form and may
+                        contain {1T}, {1C} or {1P}.
+                        {1T} will contain the time and
+                        {1C} the count of the number of times the
+                        code enters the time diagnostic code region.
+                        {1P} generates the time as a percentage.
+                        {0T} is the total time for the application.
+                        {{ is rendered as a single {.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_InitTimeDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high);
+
+/*
+   EnterDiagnostic - attribute all execution time from now to TimeDiag.
+*/
+
+extern "C" void M2Diagnostic_EnterDiagnostic (M2Diagnostic_Diagnostic TimeDiag);
+
+/*
+   ExitDiagnostic - stop attributing execution time to TimeDiag.
+*/
+
+extern "C" void M2Diagnostic_ExitDiagnostic (M2Diagnostic_Diagnostic TimeDiag);
+
+/*
+   InitMemDiagnostic - create and return a memory diagnostic.
+                       The format string can be free form and may
+                       contain {1M} {1d} {1x} {1P}.
+                       {1M} is replaced by the value of the first parameter
+                       with memory size units.
+                       {1d} unsigned decimal.  {1x} unsigned hexadecimal.
+                       {0M} is the global allocation (Storage.mod:ALLOCATE).
+                       {1P} is the percentage of param 1 relative
+                       to global memory.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_InitMemDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high);
+
+/*
+   MemIncr - allow the appropriate parameter to be incremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+extern "C" void M2Diagnostic_MemIncr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int incr);
+
+/*
+   MemDecr - allow the appropriate parameter to be decremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+extern "C" void M2Diagnostic_MemDecr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int decr);
+
+/*
+   MemSet - allow the appropriate parameter to be set to value.
+            All parameters are initially set to zero.
+*/
+
+extern "C" void M2Diagnostic_MemSet (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int value);
+
+/*
+   TotalHeapIncr - increments the total heap used.
+*/
+
+extern "C" void M2Diagnostic_TotalHeapIncr (unsigned int incr);
+
+/*
+   TotalHeapDecr - decrements the total heap used.
+*/
+
+extern "C" void M2Diagnostic_TotalHeapDecr (unsigned int incr);
+
+/*
+   SetEnable - set the enable flag in Diag to value.
+*/
+
+extern "C" void M2Diagnostic_SetEnable (M2Diagnostic_Diagnostic Diag, bool value);
+
+/*
+   Lookup - returns the Diagnostic containing name or NIL
+            if it does not exist.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_Lookup (const char *name_, unsigned int _name_high);
+
+/*
+   GetName - returns the name of Diag.
+*/
+
+extern "C" DynamicStrings_String M2Diagnostic_GetName (M2Diagnostic_Diagnostic Diag);
+
+/*
+   ForeachDiagDo - for diag in global diag list do
+                      dp (diag);
+                   end
+*/
+
+extern "C" void M2Diagnostic_ForeachDiagDo (M2Diagnostic_DiagProc dp);
+
+/*
+   SetDefaultConfig - force the Diag enable flag to the
+                      time or mem global default.
+*/
+
+extern "C" void M2Diagnostic_SetDefaultConfig (M2Diagnostic_Diagnostic Diag);
+
+/*
+   Configure - will turn on or off all the memory or time
+               instrumentation diagnostics and set the defaults
+               time and mem values.
+*/
+
+extern "C" void M2Diagnostic_Configure (bool time_, bool mem);
+
+/*
+   Generate - return a string containing the output from
+              all the diagnostics enabled.
+*/
+
+extern "C" DynamicStrings_String M2Diagnostic_Generate (void);
+
+/*
+   Assert - halt if b is false.
+*/
+
+static void Assert (bool b);
+
+/*
+   Error - generate a error simple message with indicating the
+           format specifier ch is incorrect.
+*/
+
+static void Error (const char *msg_, unsigned int _msg_high, char ch);
+
+/*
+   Accumulate - total := total + exit - enter
+*/
+
+static void Accumulate (Selective_Timeval total, Selective_Timeval enter, Selective_Timeval exit_);
+
+/*
+   IncTime - left := left + right.
+*/
+
+static void IncTime (Selective_Timeval left, Selective_Timeval right);
+
+/*
+   DecTime - left := left - right.
+*/
+
+static void DecTime (Selective_Timeval left, Selective_Timeval right);
+
+/*
+   CheckParam -
+*/
+
+static void CheckParam (unsigned int paramno);
+
+/*
+   CreateStartTime -
+*/
+
+static void CreateStartTime (void);
+
+/*
+   UpdateTotalTime -
+*/
+
+static void UpdateTotalTime (void);
+
+/*
+   GetTimeParam - a paramno of 0 will return the total time so far
+                  whereas a paramno > 0 will return the time associated
+                  with Diag.
+*/
+
+static Selective_Timeval GetTimeParam (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   GetMemParam - return the mem paramno from within Diag.  A paramno of 0
+                 will return the total heap.
+*/
+
+static long unsigned int GetMemParam (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   CreateDecimalMem - converts c to a decimal string.
+*/
+
+static DynamicStrings_String CreateDecimalMem (long unsigned int c);
+
+/*
+   CreateHexadecimalMem - converts c to a hexadecimal string.
+*/
+
+static DynamicStrings_String CreateHexadecimalMem (long unsigned int c);
+
+/*
+   CreateDecimalTime - return timeval as a decimal seconds.usecs string.
+*/
+
+static DynamicStrings_String CreateDecimalTime (Selective_Timeval timeval);
+
+/*
+   CreateHexadecimalTime - return timeval as a hexadecimal seconds.usecs string.
+*/
+
+static DynamicStrings_String CreateHexadecimalTime (Selective_Timeval timeval);
+
+/*
+   Decimal - convert paramno in Diag to a string.
+*/
+
+static DynamicStrings_String Decimal (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   Hexadecimal - convert paramno in Diag to a hex string.
+*/
+
+static DynamicStrings_String Hexadecimal (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   Count - return the count field for a time diag or return the decimal
+           value for a paramno in a mem diag.
+*/
+
+static DynamicStrings_String Count (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   Microsec - convert timeval into microseconds and return the value as
+              a longcard.
+*/
+
+static long unsigned int Microsec (Selective_Timeval timeval);
+
+/*
+   CreateTimePercent - return timeval as a percentage of the TotalTime.
+*/
+
+static DynamicStrings_String CreateTimePercent (Selective_Timeval timeval);
+
+/*
+   CreateMemPercent - return memval as a percentage of TotalHeap.
+*/
+
+static DynamicStrings_String CreateMemPercent (long unsigned int memval);
+
+/*
+   DescribePercent - call the appropriate mem or time percentage procedure.
+*/
+
+static DynamicStrings_String DescribePercent (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   DescribeMemory - return the memory diagnostic
+*/
+
+static DynamicStrings_String DescribeMemory (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   DescribeTime - returns the time diagnostic in seconds.
+*/
+
+static DynamicStrings_String DescribeTime (M2Diagnostic_Diagnostic Diag, unsigned int paramno);
+
+/*
+   ParamSpec - ebnf:
+
+               ( '{' | '0' | '1' | '2' | '3' | '4' )
+               ( 'd' | 'x' | 'C' | 'T' | 'M' | 'N' | 'P' )
+               '}'
+*/
+
+static unsigned int ParamSpec (M2Diagnostic_Diagnostic Diag, unsigned int i);
+
+/*
+   FormatDiag - ebnf:
+
+                { ( '{' ParamSpec ) | any }
+*/
+
+static void FormatDiag (M2Diagnostic_Diagnostic Diag);
+
+
+/*
+   Assert - halt if b is false.
+*/
+
+static void Assert (bool b)
+{
+  if (! b)
+    {
+      M2RTS_HALT (-1);
+      __builtin_unreachable ();
+    }
+}
+
+
+/*
+   Error - generate a error simple message with indicating the
+           format specifier ch is incorrect.
+*/
+
+static void Error (const char *msg_, unsigned int _msg_high, char ch)
+{
+  char msg[_msg_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (msg, msg_, _msg_high+1);
+
+  M2RTS_HALT (-1);
+  __builtin_unreachable ();
+}
+
+
+/*
+   Accumulate - total := total + exit - enter
+*/
+
+static void Accumulate (Selective_Timeval total, Selective_Timeval enter, Selective_Timeval exit_)
+{
+  IncTime (total, exit_);
+  DecTime (total, enter);
+}
+
+
+/*
+   IncTime - left := left + right.
+*/
+
+static void IncTime (Selective_Timeval left, Selective_Timeval right)
+{
+  unsigned int lsec;
+  unsigned int lusec;
+  unsigned int rsec;
+  unsigned int rusec;
+
+  Selective_GetTime (left, &lsec, &lusec);
+  Selective_GetTime (right, &rsec, &rusec);
+  if ((lusec+rusec) < MICROSEC)
+    {
+      /* No carry  */
+      lusec += rusec;
+      lsec += rsec;
+    }
+  else
+    {
+      lusec += rusec;
+      lusec -= MICROSEC;
+      lsec += rsec+1;
+    }
+  Selective_SetTime (left, lsec, lusec);
+}
+
+
+/*
+   DecTime - left := left - right.
+*/
+
+static void DecTime (Selective_Timeval left, Selective_Timeval right)
+{
+  unsigned int lsec;
+  unsigned int lusec;
+  unsigned int rsec;
+  unsigned int rusec;
+
+  Selective_GetTime (left, &lsec, &lusec);
+  Selective_GetTime (right, &rsec, &rusec);
+  if (lusec >= rusec)
+    {
+      /* No borrow.  */
+      lusec -= rusec;
+      if (lsec >= rsec)
+        {
+          lsec -= rsec;
+        }
+      else
+        {
+          lsec = 0;
+        }
+    }
+  else
+    {
+      if (lsec > 0)
+        {
+          lusec += MICROSEC;
+          lusec -= rusec;
+          lsec -= 1;
+          if (lsec >= rsec)
+            {
+              lsec -= rsec;
+            }
+          else
+            {
+              lsec = 0;
+            }
+        }
+      else
+        {
+          lsec = 0;
+          lusec = 0;
+        }
+    }
+  Selective_SetTime (left, lsec, lusec);
+}
+
+
+/*
+   CheckParam -
+*/
+
+static void CheckParam (unsigned int paramno)
+{
+  if ((paramno < 1) || (paramno > MaxParam))
+    {
+      M2RTS_HALT (-1);
+      __builtin_unreachable ();
+    }
+}
+
+
+/*
+   CreateStartTime -
+*/
+
+static void CreateStartTime (void)
+{
+  if (EnableDiagnostics)
+    {
+      /* avoid dangling else.  */
+      if (StartTime == NULL)
+        {
+          StartTime = Selective_InitTime (0, 0);
+          if ((Selective_GetTimeOfDay (StartTime)) == 0)
+            {}  /* empty.  */
+        }
+      if (TotalTime == NULL)
+        {
+          TotalTime = Selective_InitTime (0, 0);
+        }
+    }
+  else
+    {
+      StartTime = NULL;
+      TotalTime = NULL;
+    }
+}
+
+
+/*
+   UpdateTotalTime -
+*/
+
+static void UpdateTotalTime (void)
+{
+  if ((Selective_GetTimeOfDay (TotalTime)) == 0)
+    {}  /* empty.  */
+  DecTime (TotalTime, StartTime);
+}
+
+
+/*
+   GetTimeParam - a paramno of 0 will return the total time so far
+                  whereas a paramno > 0 will return the time associated
+                  with Diag.
+*/
+
+static Selective_Timeval GetTimeParam (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  unsigned int sec;
+  unsigned int usec;
+
+  if (paramno == 0)
+    {
+      UpdateTotalTime ();
+      return TotalTime;
+    }
+  else
+    {
+      return Diag->tdiag.total;
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   GetMemParam - return the mem paramno from within Diag.  A paramno of 0
+                 will return the total heap.
+*/
+
+static long unsigned int GetMemParam (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  if (paramno == 0)
+    {
+      return TotalHeap;
+    }
+  else
+    {
+      return Diag->mdiag.param.array[paramno-1];
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateDecimalMem - converts c to a decimal string.
+*/
+
+static DynamicStrings_String CreateDecimalMem (long unsigned int c)
+{
+  return StringConvert_LongCardinalToString (c, 0, ' ', 10, true);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateHexadecimalMem - converts c to a hexadecimal string.
+*/
+
+static DynamicStrings_String CreateHexadecimalMem (long unsigned int c)
+{
+  return DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0x", 2), DynamicStrings_Mark (StringConvert_LongCardinalToString (c, 0, ' ', 16, true)));
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateDecimalTime - return timeval as a decimal seconds.usecs string.
+*/
+
+static DynamicStrings_String CreateDecimalTime (Selective_Timeval timeval)
+{
+  unsigned int sec;
+  unsigned int usec;
+
+  Selective_GetTime (timeval, &sec, &usec);
+  return DynamicStrings_ConCat (DynamicStrings_ConCat (StringConvert_LongCardinalToString (static_cast<long unsigned int> (sec), 0, ' ', 10, true), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1))), StringConvert_LongCardinalToString (static_cast<long unsigned int> (usec), 6, '0', 10, true));
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateHexadecimalTime - return timeval as a hexadecimal seconds.usecs string.
+*/
+
+static DynamicStrings_String CreateHexadecimalTime (Selective_Timeval timeval)
+{
+  unsigned int sec;
+  unsigned int usec;
+
+  Selective_GetTime (timeval, &sec, &usec);
+  return DynamicStrings_ConCat (DynamicStrings_ConCat (StringConvert_LongCardinalToString (static_cast<long unsigned int> (sec), 0, ' ', 16, true), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1))), StringConvert_LongCardinalToString (static_cast<long unsigned int> (usec), 5, '0', 16, true));
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   Decimal - convert paramno in Diag to a string.
+*/
+
+static DynamicStrings_String Decimal (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  switch (Diag->type)
+    {
+      case M2Diagnostic_memdiag:
+        return CreateDecimalMem (GetMemParam (Diag, paramno));
+        break;
+
+      case M2Diagnostic_timediag:
+        return CreateDecimalTime (GetTimeParam (Diag, paramno));
+        break;
+
+
+      default:
+        CaseException ("../../gcc/m2/gm2-libs/M2Diagnostic.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  return static_cast<DynamicStrings_String> (NULL);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   Hexadecimal - convert paramno in Diag to a hex string.
+*/
+
+static DynamicStrings_String Hexadecimal (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  switch (Diag->type)
+    {
+      case M2Diagnostic_memdiag:
+        return CreateHexadecimalMem (GetMemParam (Diag, paramno));
+        break;
+
+      case M2Diagnostic_timediag:
+        return CreateHexadecimalTime (GetTimeParam (Diag, paramno));
+        break;
+
+
+      default:
+        CaseException ("../../gcc/m2/gm2-libs/M2Diagnostic.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  return static_cast<DynamicStrings_String> (NULL);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   Count - return the count field for a time diag or return the decimal
+           value for a paramno in a mem diag.
+*/
+
+static DynamicStrings_String Count (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  switch (Diag->type)
+    {
+      case M2Diagnostic_memdiag:
+        return CreateDecimalMem (GetMemParam (Diag, paramno));
+        break;
+
+      case M2Diagnostic_timediag:
+        return StringConvert_ctos (Diag->tdiag.count, 0, ' ');
+        break;
+
+
+      default:
+        CaseException ("../../gcc/m2/gm2-libs/M2Diagnostic.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  return static_cast<DynamicStrings_String> (NULL);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   Microsec - convert timeval into microseconds and return the value as
+              a longcard.
+*/
+
+static long unsigned int Microsec (Selective_Timeval timeval)
+{
+  unsigned int sec;
+  unsigned int usec;
+  long unsigned int microsec;
+
+  Selective_GetTime (timeval, &sec, &usec);
+  microsec = (((long unsigned int ) (sec))*MICROSEC)+((long unsigned int ) (usec));
+  return microsec;
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateTimePercent - return timeval as a percentage of the TotalTime.
+*/
+
+static DynamicStrings_String CreateTimePercent (Selective_Timeval timeval)
+{
+  long unsigned int total;
+  long unsigned int param;
+
+  if (timeval == TotalTime)
+    {
+      param = 100;
+    }
+  else
+    {
+      UpdateTotalTime ();
+      param = (Microsec (timeval))*100;
+      total = Microsec (TotalTime);
+      if (total == 0)
+        {
+          param = 0;
+        }
+      else
+        {
+          param = param / total;
+        }
+    }
+  return DynamicStrings_ConCatChar (StringConvert_ctos ((unsigned int ) (param), 3, ' '), '%');
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   CreateMemPercent - return memval as a percentage of TotalHeap.
+*/
+
+static DynamicStrings_String CreateMemPercent (long unsigned int memval)
+{
+  long unsigned int param;
+
+  if (memval == TotalHeap)
+    {
+      param = 100;
+    }
+  else
+    {
+      param = memval*100;
+      if (TotalHeap == 0)
+        {
+          param = 0;
+        }
+      else
+        {
+          param = param / TotalHeap;
+        }
+    }
+  return DynamicStrings_ConCatChar (StringConvert_ctos ((unsigned int ) (param), 3, ' '), '%');
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   DescribePercent - call the appropriate mem or time percentage procedure.
+*/
+
+static DynamicStrings_String DescribePercent (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  switch (Diag->type)
+    {
+      case M2Diagnostic_memdiag:
+        return CreateMemPercent (GetMemParam (Diag, paramno));
+        break;
+
+      case M2Diagnostic_timediag:
+        return CreateTimePercent (GetTimeParam (Diag, paramno));
+        break;
+
+
+      default:
+        CaseException ("../../gcc/m2/gm2-libs/M2Diagnostic.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  return static_cast<DynamicStrings_String> (NULL);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   DescribeMemory - return the memory diagnostic
+*/
+
+static DynamicStrings_String DescribeMemory (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  long unsigned int param;
+  DynamicStrings_String s;
+
+  param = GetMemParam (Diag, paramno);
+  if (param < kilo)
+    {
+      s = DynamicStrings_ConCat (StringConvert_LongCardinalToString (param, 0, ' ', 10, false), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " Bytes", 6)));
+    }
+  else if (param < mega)
+    {
+      /* avoid dangling else.  */
+      param = param / kilo;
+      s = DynamicStrings_ConCat (StringConvert_LongCardinalToString (param, 0, ' ', 10, false), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "KB", 2)));
+    }
+  else
+    {
+      /* avoid dangling else.  */
+      param = param / mega;
+      s = DynamicStrings_ConCat (StringConvert_LongCardinalToString (param, 0, ' ', 10, false), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) "MB", 2)));
+    }
+  return s;
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   DescribeTime - returns the time diagnostic in seconds.
+*/
+
+static DynamicStrings_String DescribeTime (M2Diagnostic_Diagnostic Diag, unsigned int paramno)
+{
+  unsigned int sec;
+  unsigned int usec;
+
+  switch (Diag->type)
+    {
+      case M2Diagnostic_memdiag:
+        M2RTS_HALT (-1);
+        __builtin_unreachable ();
+        break;
+
+      case M2Diagnostic_timediag:
+        Selective_GetTime (GetTimeParam (Diag, paramno), &sec, &usec);
+        return DynamicStrings_ConCat (DynamicStrings_ConCat (StringConvert_LongCardinalToString (static_cast<long unsigned int> (sec), 0, ' ', 10, true), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) ".", 1))), DynamicStrings_ConCat (StringConvert_LongCardinalToString (static_cast<long unsigned int> (usec), 6, '0', 10, true), DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " sec", 4))));
+        break;
+
+
+      default:
+        CaseException ("../../gcc/m2/gm2-libs/M2Diagnostic.def", 20, 1);
+        __builtin_unreachable ();
+    }
+  return static_cast<DynamicStrings_String> (NULL);
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   ParamSpec - ebnf:
+
+               ( '{' | '0' | '1' | '2' | '3' | '4' )
+               ( 'd' | 'x' | 'C' | 'T' | 'M' | 'N' | 'P' )
+               '}'
+*/
+
+static unsigned int ParamSpec (M2Diagnostic_Diagnostic Diag, unsigned int i)
+{
+  unsigned int paramno;
+  unsigned int length;
+  char ch;
+
+  length = DynamicStrings_Length (Diag->format);
+  paramno = 0;
+  if (i < length)
+    {
+      ch = DynamicStrings_char (Diag->format, static_cast<int> (i));
+      switch (ch)
+        {
+          case '{':
+            Output = DynamicStrings_ConCatChar (Output, '{');
+            return i+1;
+            break;
+
+          case '0':
+            paramno = 0;
+            break;
+
+          case '1':
+            paramno = 1;
+            break;
+
+          case '2':
+            paramno = 2;
+            break;
+
+          case '3':
+            paramno = 3;
+            break;
+
+          case '4':
+            paramno = 4;
+            break;
+
+
+          default:
+            Error ((const char *) "unexpected character: ", 22, ch);
+            break;
+        }
+      i += 1;
+      if (i < length)
+        {
+          ch = DynamicStrings_char (Diag->format, static_cast<int> (i));
+          switch (ch)
+            {
+              case 'd':
+                Output = DynamicStrings_ConCat (Output, Decimal (Diag, paramno));
+                break;
+
+              case 'x':
+                Output = DynamicStrings_ConCat (Output, Hexadecimal (Diag, paramno));
+                break;
+
+              case 'C':
+                Output = DynamicStrings_ConCat (Output, Count (Diag, paramno));
+                break;
+
+              case 'M':
+                Output = DynamicStrings_ConCat (Output, DescribeMemory (Diag, paramno));
+                break;
+
+              case 'N':
+                Output = DynamicStrings_ConCat (Output, Diag->name);
+                break;
+
+              case 'P':
+                Output = DynamicStrings_ConCat (Output, DescribePercent (Diag, paramno));
+                break;
+
+              case 'T':
+                Output = DynamicStrings_ConCat (Output, DescribeTime (Diag, paramno));
+                break;
+
+
+              default:
+                Error ((const char *) "unexpected character: ", 22, ch);
+                break;
+            }
+          i += 1;
+          if (i < length)
+            {
+              ch = DynamicStrings_char (Diag->format, static_cast<int> (i));
+              if (ch != '}')
+                {
+                  Error ((const char *) "expected } character, seen ", 27, ch);
+                }
+            }
+        }
+    }
+  return i+1;
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   FormatDiag - ebnf:
+
+                { ( '{' ParamSpec ) | any }
+*/
+
+static void FormatDiag (M2Diagnostic_Diagnostic Diag)
+{
+  unsigned int i;
+  unsigned int length;
+  char ch;
+
+  i = 0;
+  length = DynamicStrings_Length (Diag->format);
+  while (i < length)
+    {
+      ch = DynamicStrings_char (Diag->format, static_cast<int> (i));
+      if (ch == '{')
+        {
+          i += 1;
+          i = ParamSpec (Diag, i);
+        }
+      else
+        {
+          Output = DynamicStrings_ConCatChar (Output, ch);
+          i += 1;
+        }
+    }
+  Output = DynamicStrings_ConCatChar (Output, ASCII_nl);
+}
+
+
+/*
+   InitTimeDiagnostic - create and return a time diagnostic.
+                        The format string can be free form and may
+                        contain {1T}, {1C} or {1P}.
+                        {1T} will contain the time and
+                        {1C} the count of the number of times the
+                        code enters the time diagnostic code region.
+                        {1P} generates the time as a percentage.
+                        {0T} is the total time for the application.
+                        {{ is rendered as a single {.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_InitTimeDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high)
+{
+  M2Diagnostic_Diagnostic d;
+  char name[_name_high+1];
+  char format[_format_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (name, name_, _name_high+1);
+  memcpy (format, format_, _format_high+1);
+
+  if (EnableDiagnostics)
+    {
+      Storage_ALLOCATE ((void **) &d, sizeof (M2Diagnostic__T1));
+      d->name = DynamicStrings_InitString ((const char *) name, _name_high);
+      d->format = DynamicStrings_InitString ((const char *) format, _format_high);
+      d->enable = DefaultTimeEnable;
+      d->next = Head;
+      d->type = M2Diagnostic_timediag;
+      switch (d->type)
+        {
+          case M2Diagnostic_timediag:
+            d->tdiag.count = 0;
+            d->tdiag.total = Selective_InitTime (0, 0);
+            d->tdiag.enter = Selective_InitTime (0, 0);
+            d->tdiag.exit_ = Selective_InitTime (0, 0);
+            break;
+
+
+          default:
+            M2RTS_HALT (-1);
+            __builtin_unreachable ();
+            break;
+        }
+      Head = d;
+      return d;
+    }
+  else
+    {
+      return NULL;
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   EnterDiagnostic - attribute all execution time from now to TimeDiag.
+*/
+
+extern "C" void M2Diagnostic_EnterDiagnostic (M2Diagnostic_Diagnostic TimeDiag)
+{
+  if (EnableDiagnostics && (TimeDiag != NULL))
+    {
+      Assert (TimeDiag->type == M2Diagnostic_timediag);
+      Assert ((Selective_GetTimeOfDay (TimeDiag->tdiag.enter)) == 0);
+      TimeDiag->tdiag.count += 1;
+    }
+}
+
+
+/*
+   ExitDiagnostic - stop attributing execution time to TimeDiag.
+*/
+
+extern "C" void M2Diagnostic_ExitDiagnostic (M2Diagnostic_Diagnostic TimeDiag)
+{
+  if (EnableDiagnostics && (TimeDiag != NULL))
+    {
+      Assert (TimeDiag->type == M2Diagnostic_timediag);
+      Assert ((Selective_GetTimeOfDay (TimeDiag->tdiag.exit_)) == 0);
+      Accumulate (TimeDiag->tdiag.total, TimeDiag->tdiag.enter, TimeDiag->tdiag.exit_);
+    }
+}
+
+
+/*
+   InitMemDiagnostic - create and return a memory diagnostic.
+                       The format string can be free form and may
+                       contain {1M} {1d} {1x} {1P}.
+                       {1M} is replaced by the value of the first parameter
+                       with memory size units.
+                       {1d} unsigned decimal.  {1x} unsigned hexadecimal.
+                       {0M} is the global allocation (Storage.mod:ALLOCATE).
+                       {1P} is the percentage of param 1 relative
+                       to global memory.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_InitMemDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high)
+{
+  unsigned int i;
+  M2Diagnostic_Diagnostic d;
+  char name[_name_high+1];
+  char format[_format_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (name, name_, _name_high+1);
+  memcpy (format, format_, _format_high+1);
+
+  if (EnableDiagnostics)
+    {
+      Storage_ALLOCATE ((void **) &d, sizeof (M2Diagnostic__T1));
+      d->name = DynamicStrings_InitString ((const char *) name, _name_high);
+      d->format = DynamicStrings_InitString ((const char *) format, _format_high);
+      d->enable = DefaultMemEnable;
+      d->next = Head;
+      d->type = M2Diagnostic_memdiag;
+      switch (d->type)
+        {
+          case M2Diagnostic_memdiag:
+            for (i=1; i<=MaxParam; i++)
+              {
+                d->mdiag.param.array[i-1] = 0;
+              }
+            break;
+
+
+          default:
+            M2RTS_HALT (-1);
+            __builtin_unreachable ();
+            break;
+        }
+      Head = d;
+      return d;
+    }
+  else
+    {
+      return NULL;
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   MemIncr - allow the appropriate parameter to be incremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+extern "C" void M2Diagnostic_MemIncr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int incr)
+{
+  if (EnableDiagnostics && (MemDiag != NULL))
+    {
+      CheckParam (paramno);
+      switch (MemDiag->type)
+        {
+          case M2Diagnostic_memdiag:
+            MemDiag->mdiag.param.array[paramno-1] += (long unsigned int ) (incr);
+            break;
+
+
+          default:
+            M2RTS_HALT (-1);
+            __builtin_unreachable ();
+            break;
+        }
+    }
+}
+
+
+/*
+   MemDecr - allow the appropriate parameter to be decremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+extern "C" void M2Diagnostic_MemDecr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int decr)
+{
+  if (EnableDiagnostics && (MemDiag != NULL))
+    {
+      CheckParam (paramno);
+      switch (MemDiag->type)
+        {
+          case M2Diagnostic_memdiag:
+            MemDiag->mdiag.param.array[paramno-1] -= (long unsigned int ) (decr);
+            break;
+
+
+          default:
+            M2RTS_HALT (-1);
+            __builtin_unreachable ();
+            break;
+        }
+    }
+}
+
+
+/*
+   MemSet - allow the appropriate parameter to be set to value.
+            All parameters are initially set to zero.
+*/
+
+extern "C" void M2Diagnostic_MemSet (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int value)
+{
+  if (EnableDiagnostics && (MemDiag != NULL))
+    {
+      CheckParam (paramno);
+      switch (MemDiag->type)
+        {
+          case M2Diagnostic_memdiag:
+            MemDiag->mdiag.param.array[paramno-1] = (long unsigned int ) (value);
+            break;
+
+
+          default:
+            M2RTS_HALT (-1);
+            __builtin_unreachable ();
+            break;
+        }
+    }
+}
+
+
+/*
+   TotalHeapIncr - increments the total heap used.
+*/
+
+extern "C" void M2Diagnostic_TotalHeapIncr (unsigned int incr)
+{
+  if (EnableDiagnostics)
+    {
+      TotalHeap = TotalHeap+((long unsigned int ) (incr));
+    }
+}
+
+
+/*
+   TotalHeapDecr - decrements the total heap used.
+*/
+
+extern "C" void M2Diagnostic_TotalHeapDecr (unsigned int incr)
+{
+  if (EnableDiagnostics)
+    {
+      TotalHeap = TotalHeap-((long unsigned int ) (incr));
+    }
+}
+
+
+/*
+   SetEnable - set the enable flag in Diag to value.
+*/
+
+extern "C" void M2Diagnostic_SetEnable (M2Diagnostic_Diagnostic Diag, bool value)
+{
+  if (EnableDiagnostics && (Diag != NULL))
+    {
+      Diag->enable = value;
+    }
+}
+
+
+/*
+   Lookup - returns the Diagnostic containing name or NIL
+            if it does not exist.
+*/
+
+extern "C" M2Diagnostic_Diagnostic M2Diagnostic_Lookup (const char *name_, unsigned int _name_high)
+{
+  M2Diagnostic_Diagnostic ptr;
+  DynamicStrings_String s;
+  char name[_name_high+1];
+
+  /* make a local copy of each unbounded array.  */
+  memcpy (name, name_, _name_high+1);
+
+  if (EnableDiagnostics)
+    {
+      s = DynamicStrings_InitString ((const char *) name, _name_high);
+      ptr = Head;
+      while (ptr != NULL)
+        {
+          if (DynamicStrings_Equal (ptr->name, s))
+            {
+              s = DynamicStrings_KillString (s);
+              return ptr;
+            }
+          ptr = ptr->next;
+        }
+      s = DynamicStrings_KillString (s);
+      return NULL;
+    }
+  else
+    {
+      return NULL;
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   GetName - returns the name of Diag.
+*/
+
+extern "C" DynamicStrings_String M2Diagnostic_GetName (M2Diagnostic_Diagnostic Diag)
+{
+  if (EnableDiagnostics && (Diag != NULL))
+    {
+      return Diag->name;
+    }
+  else
+    {
+      return static_cast<DynamicStrings_String> (NULL);
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+
+/*
+   ForeachDiagDo - for diag in global diag list do
+                      dp (diag);
+                   end
+*/
+
+extern "C" void M2Diagnostic_ForeachDiagDo (M2Diagnostic_DiagProc dp)
+{
+  M2Diagnostic_Diagnostic ptr;
+
+  ptr = Head;
+  while (ptr != NULL)
+    {
+      (*dp.proc) (ptr);
+      ptr = ptr->next;
+    }
+}
+
+
+/*
+   SetDefaultConfig - force the Diag enable flag to the
+                      time or mem global default.
+*/
+
+extern "C" void M2Diagnostic_SetDefaultConfig (M2Diagnostic_Diagnostic Diag)
+{
+  if (Diag->type == M2Diagnostic_timediag)
+    {
+      Diag->enable = DefaultTimeEnable;
+    }
+  else
+    {
+      Diag->enable = DefaultMemEnable;
+    }
+}
+
+
+/*
+   Configure - will turn on or off all the memory or time
+               instrumentation diagnostics and set the defaults
+               time and mem values.
+*/
+
+extern "C" void M2Diagnostic_Configure (bool time_, bool mem)
+{
+  if (EnableDiagnostics)
+    {
+      DefaultTimeEnable = time_;
+      DefaultMemEnable = mem;
+      M2Diagnostic_ForeachDiagDo ((M2Diagnostic_DiagProc) {(M2Diagnostic_DiagProc_t) M2Diagnostic_SetDefaultConfig});
+    }
+}
+
+
+/*
+   Generate - return a string containing the output from
+              all the diagnostics enabled.
+*/
+
+extern "C" DynamicStrings_String M2Diagnostic_Generate (void)
+{
+  if (EnableDiagnostics)
+    {
+      Output = DynamicStrings_KillString (Output);
+      Output = DynamicStrings_InitString ((const char *) "", 0);
+      M2Diagnostic_ForeachDiagDo ((M2Diagnostic_DiagProc) {(M2Diagnostic_DiagProc_t) FormatDiag});
+      return Output;
+    }
+  else
+    {
+      return static_cast<DynamicStrings_String> (NULL);
+    }
+  /* static analysis guarentees a RETURN statement will be used before here.  */
+  __builtin_unreachable ();
+}
+
+extern "C" void _M2_M2Diagnostic_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+  TotalHeap = 0;
+  StartTime = NULL;
+  TotalTime = NULL;
+  CreateStartTime ();
+  Head = NULL;
+  Output = static_cast<DynamicStrings_String> (NULL);
+  DefaultTimeEnable = DefaultTimeEnableValue;
+  DefaultMemEnable = DefaultMemEnableValue;
+}
+
+extern "C" void _M2_M2Diagnostic_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/pge-boot/GM2Diagnostic.h b/gcc/m2/pge-boot/GM2Diagnostic.h
new file mode 100644
index 00000000000..51f592daf3b
--- /dev/null
+++ b/gcc/m2/pge-boot/GM2Diagnostic.h
@@ -0,0 +1,186 @@
+/* do not edit automatically generated by mc from M2Diagnostic.  */
+/* M2Diagnotic provides memory and time diagnosics to the user.
+
+Copyright (C) 2024 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/>.  */
+
+
+#if !defined (_M2Diagnostic_H)
+#   define _M2Diagnostic_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#include <stdbool.h>
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GDynamicStrings.h"
+
+#   if defined (_M2Diagnostic_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+#if !defined (M2Diagnostic_Diagnostic_D)
+#  define M2Diagnostic_Diagnostic_D
+   typedef void *M2Diagnostic_Diagnostic;
+#endif
+
+typedef struct M2Diagnostic_DiagProc_p M2Diagnostic_DiagProc;
+
+typedef void (*M2Diagnostic_DiagProc_t) (M2Diagnostic_Diagnostic);
+struct M2Diagnostic_DiagProc_p { M2Diagnostic_DiagProc_t proc; };
+
+
+/*
+   InitTimeDiagnostic - create and return a time diagnostic.
+                        The format string can be free form and may
+                        contain {1T}, {1C} or {1P}.
+                        {1T} will contain the time and
+                        {1C} the count of the number of times the
+                        code enters the time diagnostic code region.
+                        {1P} generates the time as a percentage.
+                        {0T} is the total time for the application.
+                        {{ is rendered as a single {.
+*/
+
+EXTERN M2Diagnostic_Diagnostic M2Diagnostic_InitTimeDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high);
+
+/*
+   EnterDiagnostic - attribute all execution time from now to TimeDiag.
+*/
+
+EXTERN void M2Diagnostic_EnterDiagnostic (M2Diagnostic_Diagnostic TimeDiag);
+
+/*
+   ExitDiagnostic - stop attributing execution time to TimeDiag.
+*/
+
+EXTERN void M2Diagnostic_ExitDiagnostic (M2Diagnostic_Diagnostic TimeDiag);
+
+/*
+   InitMemDiagnostic - create and return a memory diagnostic.
+                       The format string can be free form and may
+                       contain {1M} {1d} {1x} {1P}.
+                       {1M} is replaced by the value of the first parameter
+                       with memory size units.
+                       {1d} unsigned decimal.  {1x} unsigned hexadecimal.
+                       {0M} is the global allocation (Storage.mod:ALLOCATE).
+                       {1P} is the percentage of param 1 relative
+                       to global memory.
+*/
+
+EXTERN M2Diagnostic_Diagnostic M2Diagnostic_InitMemDiagnostic (const char *name_, unsigned int _name_high, const char *format_, unsigned int _format_high);
+
+/*
+   MemIncr - allow the appropriate parameter to be incremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+EXTERN void M2Diagnostic_MemIncr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int incr);
+
+/*
+   MemDecr - allow the appropriate parameter to be decremented.
+             All parameters are initially set to zero and are stored
+             as LONGCARD.
+*/
+
+EXTERN void M2Diagnostic_MemDecr (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int decr);
+
+/*
+   MemSet - allow the appropriate parameter to be set to value.
+            All parameters are initially set to zero.
+*/
+
+EXTERN void M2Diagnostic_MemSet (M2Diagnostic_Diagnostic MemDiag, unsigned int paramno, unsigned int value);
+
+/*
+   TotalHeapIncr - increments the total heap used.
+*/
+
+EXTERN void M2Diagnostic_TotalHeapIncr (unsigned int incr);
+
+/*
+   TotalHeapDecr - decrements the total heap used.
+*/
+
+EXTERN void M2Diagnostic_TotalHeapDecr (unsigned int incr);
+
+/*
+   SetEnable - set the enable flag in Diag to value.
+*/
+
+EXTERN void M2Diagnostic_SetEnable (M2Diagnostic_Diagnostic Diag, bool value);
+
+/*
+   Lookup - returns the Diagnostic containing name or NIL
+            if it does not exist.
+*/
+
+EXTERN M2Diagnostic_Diagnostic M2Diagnostic_Lookup (const char *name_, unsigned int _name_high);
+
+/*
+   GetName - returns the name of Diag.
+*/
+
+EXTERN DynamicStrings_String M2Diagnostic_GetName (M2Diagnostic_Diagnostic Diag);
+
+/*
+   ForeachDiagDo - for diag in global diag list do
+                      dp (diag);
+                   end
+*/
+
+EXTERN void M2Diagnostic_ForeachDiagDo (M2Diagnostic_DiagProc dp);
+
+/*
+   SetDefaultConfig - force the Diag enable flag to the
+                      time or mem global default.
+*/
+
+EXTERN void M2Diagnostic_SetDefaultConfig (M2Diagnostic_Diagnostic Diag);
+
+/*
+   Configure - will turn on or off all the memory or time
+               instrumentation diagnostics and set the defaults
+               time and mem values.
+*/
+
+EXTERN void M2Diagnostic_Configure (bool time_, bool mem);
+
+/*
+   Generate - return a string containing the output from
+              all the diagnostics enabled.
+*/
+
+EXTERN DynamicStrings_String M2Diagnostic_Generate (void);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GSelective.h b/gcc/m2/pge-boot/GSelective.h
new file mode 100644
index 00000000000..67b7f0643f0
--- /dev/null
+++ b/gcc/m2/pge-boot/GSelective.h
@@ -0,0 +1,83 @@
+/* do not edit automatically generated by mc from Selective.  */
+/* Selective.def provides Modula-2 with access to the select(2) primitive.
+
+Copyright (C) 2001-2024 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
+<http://www.gnu.org/licenses/>.  */
+
+
+#if !defined (_Selective_H)
+#   define _Selective_H
+
+#include "config.h"
+#include "system.h"
+#   ifdef __cplusplus
+extern "C" {
+#   endif
+#include <stdbool.h>
+#   if !defined (PROC_D)
+#      define PROC_D
+       typedef void (*PROC_t) (void);
+       typedef struct { PROC_t proc; } PROC;
+#   endif
+
+#   include "GSYSTEM.h"
+
+#   if defined (_Selective_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+typedef void *Selective_SetOfFd;
+
+typedef void *Selective_Timeval;
+
+EXTERN int Selective_Select (unsigned int nooffds, Selective_SetOfFd readfds, Selective_SetOfFd writefds, Selective_SetOfFd exceptfds, Selective_Timeval timeout);
+EXTERN Selective_Timeval Selective_InitTime (unsigned int sec, unsigned int usec);
+EXTERN Selective_Timeval Selective_KillTime (Selective_Timeval t);
+EXTERN void Selective_GetTime (Selective_Timeval t, unsigned int *sec, unsigned int *usec);
+EXTERN void Selective_SetTime (Selective_Timeval t, unsigned int sec, unsigned int usec);
+EXTERN Selective_SetOfFd Selective_InitSet (void);
+EXTERN Selective_SetOfFd Selective_KillSet (Selective_SetOfFd s);
+EXTERN void Selective_FdZero (Selective_SetOfFd s);
+EXTERN void Selective_FdSet (int fd, Selective_SetOfFd s);
+EXTERN void Selective_FdClr (int fd, Selective_SetOfFd s);
+EXTERN bool Selective_FdIsSet (int fd, Selective_SetOfFd s);
+EXTERN int Selective_MaxFdsPlusOne (int a, int b);
+EXTERN void Selective_WriteCharRaw (int fd, char ch);
+EXTERN char Selective_ReadCharRaw (int fd);
+
+/*
+   GetTimeOfDay - fills in a record, Timeval, filled in with the
+                  current system time in seconds and microseconds.
+                  It returns zero (see man 3p gettimeofday)
+*/
+
+EXTERN int Selective_GetTimeOfDay (Selective_Timeval tv);
+#   ifdef __cplusplus
+}
+#   endif
+
+#   undef EXTERN
+#endif
diff --git a/gcc/m2/pge-boot/GStringConvert.cc b/gcc/m2/pge-boot/GStringConvert.cc
new file mode 100644
index 00000000000..b0dc826b647
--- /dev/null
+++ b/gcc/m2/pge-boot/GStringConvert.cc
@@ -0,0 +1,2006 @@
+/* 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 <stdbool.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 <stddef.h>
+#include <string.h>
+#include <limits.h>
+#include <stdlib.h>
+#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, bool sign, unsigned int base, bool 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, bool 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, bool *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, bool *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, bool sign, unsigned int base, bool 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, bool *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, bool 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, bool *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, bool 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, bool *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, bool 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, bool *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 (bool 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 bool 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 bool 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 bool 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 bool 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 bool 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 bool 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 bool 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 (bool 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 bool 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 bool 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 bool 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 bool 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 bool 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 bool 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 bool 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 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, bool sign, unsigned int base, bool 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, bool 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, bool *found)
+{
+  unsigned int n;
+  unsigned int l;
+  unsigned int c;
+  bool 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, bool *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, bool sign, unsigned int base, bool 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, bool *found)
+{
+  unsigned int n;
+  unsigned int l;
+  long unsigned int c;
+  bool 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, bool 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, bool *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, bool 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, bool *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)
+{
+  bool 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, bool 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)
+{
+  bool 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)
+{
+  bool 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)
+{
+  bool 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)
+{
+  bool 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)
+{
+  bool 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)
+{
+  bool 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)
+{
+  bool 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, bool *found)
+{
+  bool 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)
+{
+  bool maxprecision;
+  DynamicStrings_String s;
+  void * r;
+  int point;
+  bool 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)
+{
+  bool 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)
+{
+  bool 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/m2/gm2-libs/StringConvert.mod", 39, 1220, (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/m2/gm2-libs/StringConvert.mod", 39, 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[])
+{
+}
diff --git a/gcc/m2/pge-boot/main.cc b/gcc/m2/pge-boot/main.cc
index b6f29f628f7..645304c1921 100644
--- a/gcc/m2/pge-boot/main.cc
+++ b/gcc/m2/pge-boot/main.cc
@@ -6,6 +6,8 @@ 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_M2Diagnostic_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2Diagnostic_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[]);
@@ -46,6 +48,8 @@ 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_StringConvert_init (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StringConvert_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[]);
@@ -65,6 +69,7 @@ int main(int argc, char *argv[], char *envp[])
    _M2_M2EXCEPTION_init (argc, argv, envp);
    _M2_M2RTS_init (argc, argv, envp);
    _M2_SysExceptions_init (argc, argv, envp);
+   _M2_M2Diagnostic_init (argc, argv, envp);
    _M2_StrLib_init (argc, argv, envp);
    _M2_errno_init (argc, argv, envp);
    _M2_termios_init (argc, argv, envp);
@@ -85,6 +90,7 @@ int main(int argc, char *argv[], char *envp[])
    _M2_FIO_init (argc, argv, envp);
    _M2_SFIO_init (argc, argv, envp);
    _M2_StrCase_init (argc, argv, envp);
+   _M2_StringConvert_init (argc, argv, envp);
    _M2_bnflex_init (argc, argv, envp);
    _M2_Lists_init (argc, argv, envp);
    _M2_Args_init (argc, argv, envp);
@@ -95,6 +101,7 @@ int main(int argc, char *argv[], char *envp[])
    _M2_Args_fini (argc, argv, envp);
    _M2_Lists_fini (argc, argv, envp);
    _M2_bnflex_fini (argc, argv, envp);
+   _M2_StringConvert_fini (argc, argv, envp);
    _M2_StrCase_fini (argc, argv, envp);
    _M2_SFIO_fini (argc, argv, envp);
    _M2_FIO_fini (argc, argv, envp);
@@ -115,6 +122,7 @@ int main(int argc, char *argv[], char *envp[])
    _M2_termios_fini (argc, argv, envp);
    _M2_errno_fini (argc, argv, envp);
    _M2_StrLib_fini (argc, argv, envp);
+   _M2_M2Diagnostic_fini (argc, argv, envp);
    _M2_SysExceptions_fini (argc, argv, envp);
    _M2_M2RTS_fini (argc, argv, envp);
    _M2_M2EXCEPTION_fini (argc, argv, envp);
diff --git a/gcc/m2/tools-src/makeSystem b/gcc/m2/tools-src/makeSystem
index 407af8e1dd4..b7fea6ac5d1 100644
--- a/gcc/m2/tools-src/makeSystem
+++ b/gcc/m2/tools-src/makeSystem
@@ -23,7 +23,7 @@
 
 
 Usage () {
-   echo "Usage: makesystem dialectflag SYSTEM.def SYSTEM.mod { librarypath } compiler"
+   echo "Usage: makesystem [-gdb] dialectflag SYSTEM.def SYSTEM.mod { librarypath } compiler"
 }
 
 if [ $# -lt 6 ] ; then
@@ -31,6 +31,12 @@ if [ $# -lt 6 ] ; then
    exit 1
 fi
 
+if [ "$1" = "-gdb" ] ; then
+    DEBUG=$1
+    shift
+else
+    DEBUG=""
+fi
 DIALECT=$1
 SYSTEMDEF=$2
 SYSTEMMOD=$3
@@ -101,6 +107,14 @@ displayEnd () {
 MINIMAL="-fno-scaffold-main -fno-scaffold-dynamic -fno-scaffold-static -fno-m2-plugin"
 
 rm -f ${OUTPUTFILE}
+
+if [ "$DEBUG" != "" ] ; then
+    echo "entering gdb to debug cc1gm2 when using -fdump-system-exports"
+    ${COMPILER} ${DIALECT} ${LIBRARY} ${MINIMAL} \
+		-c -fdump-system-exports ${SYSTEMMOD} -wrapper gdb,--args
+    exit $?
+fi
+
 ${COMPILER} ${DIALECT} ${LIBRARY} ${MINIMAL} \
 	    -S -fdump-system-exports ${SYSTEMMOD} -o /dev/null 2>&1 > /dev/null
 res=$?
diff --git a/gcc/testsuite/gm2/errors/fail/testbit2.mod b/gcc/testsuite/gm2/errors/fail/testbit2.mod
index d851b0990cc..0e07a80d6bd 100644
--- a/gcc/testsuite/gm2/errors/fail/testbit2.mod
+++ b/gcc/testsuite/gm2/errors/fail/testbit2.mod
@@ -19,11 +19,14 @@ MODULE testbit2 ;
 
 FROM StrIO IMPORT WriteString, WriteLn ;
 
+TYPE
+   index = CARDINAL ;
+
 VAR
-   c   : CARDINAL ;
+   c   : index ;
    a, b: BITSET ;
 BEGIN
-   IF b IN b
+   IF c IN c
    THEN
       WriteString('hmm') ; WriteLn
    END
diff --git a/gcc/testsuite/gm2/iso/run/pass/assigncons.mod b/gcc/testsuite/gm2/iso/run/pass/assigncons.mod
new file mode 100644
index 00000000000..b2f00bf6b95
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/assigncons.mod
@@ -0,0 +1,23 @@
+MODULE assigncons ;
+
+
+TYPE
+   rec = RECORD
+            x, y: CARDINAL ;
+         END ;
+
+CONST
+   z = rec {1, 2} ;
+
+
+PROCEDURE Init ;
+VAR
+   r: rec ;
+BEGIN
+   r := z
+END Init ;
+
+
+BEGIN
+   Init
+END assigncons.
diff --git a/gcc/testsuite/gm2/iso/run/pass/constructor3.mod b/gcc/testsuite/gm2/iso/run/pass/constructor3.mod
new file mode 100644
index 00000000000..cc94b578021
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/constructor3.mod
@@ -0,0 +1,42 @@
+(* Copyright (C) 2008 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING.  If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+MODULE constructor3 ;
+
+FROM libc IMPORT exit ;
+
+
+VAR
+   f: position ;
+
+TYPE
+   position = RECORD
+                 x1, y1, x2, y2: CARDINAL ;
+              END ;
+
+CONST
+   first = position{1,2,3,4} ;
+
+BEGIN
+   f := first ;
+   IF (f.x1=1) AND (f.y1=2) AND (f.x2=3) AND (f.y2=4)
+   THEN
+      (* all ok *)
+   ELSE
+      exit(1)
+   END
+END constructor3.
diff --git a/gcc/testsuite/gm2/iso/run/pass/proc_test.mod b/gcc/testsuite/gm2/iso/run/pass/proc_test.mod
new file mode 100644
index 00000000000..00242db413b
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/proc_test.mod
@@ -0,0 +1,10 @@
+MODULE proc_test;
+
+    PROCEDURE Calc () : CARDINAL;
+    BEGIN
+        RETURN 2;
+    END Calc;
+
+BEGIN
+
+END proc_test.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/iso/run/pass/shift4.mod b/gcc/testsuite/gm2/iso/run/pass/shift4.mod
index 26b2d53d904..b0d0278a457 100644
--- a/gcc/testsuite/gm2/iso/run/pass/shift4.mod
+++ b/gcc/testsuite/gm2/iso/run/pass/shift4.mod
@@ -18,7 +18,39 @@ Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
 MODULE shift4 ;
 
 FROM libc IMPORT exit, printf ;
-FROM SYSTEM IMPORT SHIFT, BITSPERLOC ;
+FROM SYSTEM IMPORT SHIFT, BITSPERLOC, TBITSIZE, BYTE ;
+
+
+CONST
+   EarlyFail = TRUE ;
+   Verbose = FALSE ;
+
+
+(*
+   assert -
+*)
+
+PROCEDURE assert (condition: BOOLEAN) ;
+BEGIN
+   IF NOT condition
+   THEN
+      printf ("assert failed\n");
+      exit (1)
+   END
+END assert ;
+
+
+(*
+   SanityCheck -
+*)
+
+PROCEDURE SanityCheck ;
+BEGIN
+   assert (MIN (large) = 0) ;
+   assert (MAX (large) = 1023) ;
+   assert (TBITSIZE (BYTE) = 8) ;
+END SanityCheck ;
+
 
 TYPE
    large = SET OF [0..1023] ;
@@ -27,37 +59,107 @@ VAR
    i   : INTEGER ;
    b, c: large ;
 BEGIN
+   SanityCheck ;
    r := 0 ;
    b := large{1, 2, 3, 1022} ;
-   b := SHIFT(b, 1) ;
+   IF b # large{1, 2, 3, 1022}
+   THEN
+      printf ("failed to assign a large set with a constant set\n");
+      exit (1)
+   END ;
+   b := SHIFT(b, 1) ;  (* Shift left by 1 bit.  *)
    IF b#large{2, 3, 4, 1023}
    THEN
+      printf ("failed (exit 1) as b#large{2, 3, 4, 1023}\n");
       exit(1)
    END ;
    b := large{1, 2, 3, 1023} ;
-   b := SHIFT(b, -1) ;
+   b := SHIFT(b, -1) ;    (* Shift right by 1 bit.  *)
    IF b#large{0, 1, 2, 1022}
    THEN
+      printf ("failed (exit 2) as b#large{1, 2, 3, 1022}\n");
       exit(2)
    END ;
    b := large{1+SIZE(BITSET)*BITSPERLOC} ;
    b := SHIFT(b, -1) ;
    IF b#large{SIZE(BITSET)*BITSPERLOC}
    THEN
+      printf ("failed (exit 3)\n");
       exit(3)
    END ;
    b := SHIFT(b, -1) ;
    IF b#large{SIZE(BITSET)*BITSPERLOC-1}
    THEN
+      printf ("failed (exit 4)\n");
       exit(4)
    END ;
+
+   printf ("test left shift on byte boundaries\n");
+   FOR i := 0 TO MAX(large) BY 8 DO
+      b := large{0} ;
+      b := SHIFT(b, i) ;
+      c := large{i} ;
+      IF b # c
+      THEN
+         printf("failed shift left in loop on iteration %d, failed to shift bit 0 left by %i bits\n", i, i) ;
+         IF EarlyFail
+         THEN
+            exit (5)
+         END ;
+         r := 5
+      END
+   END ;
+   IF r = 0
+   THEN
+      printf ("test left shift on byte boundaries passed\n")
+   ELSE
+      printf ("test left shift on byte boundaries failed\n")
+   END ;
+
+   printf ("test right shift on byte boundaries\n");
+   FOR i := 0 TO MAX(large) BY 8 DO
+      b := large{i} ;
+      b := SHIFT(b, -i) ;
+      c := large{0} ;
+      IF b = c
+      THEN
+         IF Verbose
+         THEN
+            printf ("success shifted large set right by %d bits\n", i)
+         END
+      ELSE
+         printf("failed shift right in loop on iteration %d\n", i) ;
+         IF EarlyFail
+         THEN
+            exit (6)
+         END ;
+         r := 6
+      END
+   END ;
+   IF r = 0
+   THEN
+      printf ("test right shift on byte boundaries passed\n")
+   ELSE
+      printf ("test right shift on byte boundaries failed\n")
+   END ;
+
+   printf ("test shift on each bit\n");
    FOR i := 0 TO MAX(large) DO
       b := large{0} ;
       b := SHIFT(b, i) ;
       c := large{i} ;
-      IF b#c
+      IF b = c
       THEN
-         printf("failed shift left in loop on iteration %d\n", i) ;
+         IF Verbose
+         THEN
+            printf ("success shifted large set left by %d bits\n", i)
+         END
+      ELSE
+         printf("failed shift left in loop on iteration %d, failed to shift bit 0 left by %i bits\n", i, i) ;
+         IF EarlyFail
+         THEN
+            exit (5)
+         END ;
          r := 5
       END
    END ;
@@ -65,9 +167,18 @@ BEGIN
       b := large{i} ;
       b := SHIFT(b, -i) ;
       c := large{0} ;
-      IF b#c
+      IF b = c
       THEN
+         IF Verbose
+         THEN
+            printf ("success shifted large set right by %d bits\n", i)
+         END
+      ELSE
          printf("failed shift right in loop on iteration %d\n", i) ;
+         IF EarlyFail
+         THEN
+            exit (6)
+         END ;
          r := 6
       END
    END ;
diff --git a/gcc/testsuite/gm2/iso/run/pass/simplelarge2.mod b/gcc/testsuite/gm2/iso/run/pass/simplelarge2.mod
new file mode 100644
index 00000000000..c78dda894df
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/simplelarge2.mod
@@ -0,0 +1,99 @@
+(* Copyright (C) 2014 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING.  If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+MODULE simplelarge2 ;
+
+FROM STextIO IMPORT WriteString, WriteLn, WriteChar, ReadToken, SkipLine ;
+FROM SWholeIO IMPORT WriteCard, WriteInt ;
+FROM WholeStr IMPORT StrToCard, ConvResults ;
+FROM SYSTEM IMPORT CARDINAL8 ;
+FROM libc IMPORT printf ;
+
+CONST
+   BoardX         =              16 ;
+   BoardY         =              16 ;
+   BoardSize      = BoardX * BoardY ;
+
+TYPE
+   Squares = [0..BoardSize-1] ;
+   SoS     = SET OF Squares ;
+   Colour  = (Blue, Red, Green, White) ;
+
+VAR
+   homeBase: ARRAY [MIN(Colour)..MAX(Colour)] OF SoS ;
+
+
+PROCEDURE dumpSet (c: Colour) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   printf ("inside dumpSet (%d)\n", ORD(c)) ;
+   printf ("      :  0 2 4 6 8 a c e \n") ;
+   FOR n := MIN(Squares) TO MAX(Squares) DO
+      IF n MOD 16 = 0
+      THEN
+         printf ("\nrow %2d:  ", n DIV 16)
+      END ;
+      IF n IN homeBase[c]
+      THEN
+         printf ("1")
+      ELSE
+         printf ("0")
+      END
+   END ;
+   printf ("\n")
+END dumpSet ;
+
+
+(*
+   assert -
+*)
+
+PROCEDURE assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      WriteString('assert failed') ; WriteLn ;
+      HALT
+   END
+END assert ;
+
+
+BEGIN
+   homeBase[Blue] := SoS {0, 1, 2, 3,
+                          16, 17, 18, 19,
+                          32, 33, 34,
+                          48, 49} ;
+
+   dumpSet(Blue) ;
+
+   assert (0 IN homeBase[Blue]) ;
+   assert (1 IN homeBase[Blue]) ;
+   assert (2 IN homeBase[Blue]) ;
+   assert (3 IN homeBase[Blue]) ;
+
+   homeBase[Blue] := homeBase[Blue] + SoS {4, 20, 35, 50, 65, 64} ;
+   dumpSet(Blue) ;
+
+   assert (0 IN homeBase[Blue]) ;
+   assert (1 IN homeBase[Blue]) ;
+   assert (2 IN homeBase[Blue]) ;
+   assert (3 IN homeBase[Blue]) ;
+   assert (4 IN homeBase[Blue]) ;
+   assert (NOT (5 IN homeBase[Blue])) ;
+   assert (NOT (6 IN homeBase[Blue])) ;
+END simplelarge2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/simplelarge3.mod b/gcc/testsuite/gm2/iso/run/pass/simplelarge3.mod
new file mode 100644
index 00000000000..41742affd95
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/simplelarge3.mod
@@ -0,0 +1,88 @@
+(* Copyright (C) 2014 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING.  If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+MODULE simplelarge3 ;
+
+FROM STextIO IMPORT WriteString, WriteLn, WriteChar, ReadToken, SkipLine ;
+FROM SWholeIO IMPORT WriteCard, WriteInt ;
+FROM WholeStr IMPORT StrToCard, ConvResults ;
+FROM SYSTEM IMPORT CARDINAL8 ;
+FROM libc IMPORT printf ;
+
+CONST
+   BoardX         =              16 ;
+   BoardY         =              16 ;
+   BoardSize      = BoardX * BoardY ;
+
+TYPE
+   Squares = [0..BoardSize-1] ;
+   SoS     = SET OF Squares ;
+   Colour  = (Blue, Red, Green, White) ;
+
+VAR
+   homeBase: ARRAY [MIN(Colour)..MAX(Colour)] OF SoS ;
+
+
+PROCEDURE dumpSet (c: Colour) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   printf ("inside dumpSet (%d)\n", ORD(c)) ;
+   printf ("      :  0 2 4 6 8 a c e \n") ;
+   FOR n := MIN(Squares) TO MAX(Squares) DO
+      IF n MOD 16 = 0
+      THEN
+         printf ("\nrow %2d:  ", n DIV 16)
+      END ;
+      IF n IN homeBase[c]
+      THEN
+         printf ("1")
+      ELSE
+         printf ("0")
+      END
+   END ;
+   printf ("\n")
+END dumpSet ;
+
+
+(*
+   assert -
+*)
+
+PROCEDURE assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      WriteString('assert failed') ; WriteLn ;
+      HALT
+   END
+END assert ;
+
+
+BEGIN
+   homeBase[Blue] := SoS {0, 1, 2, 3,
+                          16, 17, 18, 19,
+                          32, 33, 34,
+                          48, 49} ;
+
+   dumpSet(Blue) ;
+
+   homeBase[Blue] := homeBase[Blue] + SoS {4, 20, 35, 50, 65, 64} ;
+   dumpSet(Blue) ;
+
+   assert (0 IN homeBase[Blue])
+END simplelarge3.
diff --git a/gcc/testsuite/gm2/iso/run/pass/simplelarge4.mod b/gcc/testsuite/gm2/iso/run/pass/simplelarge4.mod
new file mode 100644
index 00000000000..ea9fa619121
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/simplelarge4.mod
@@ -0,0 +1,88 @@
+(* Copyright (C) 2014 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING.  If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+MODULE simplelarge4 ;
+
+FROM STextIO IMPORT WriteString, WriteLn, WriteChar, ReadToken, SkipLine ;
+FROM SWholeIO IMPORT WriteCard, WriteInt ;
+FROM WholeStr IMPORT StrToCard, ConvResults ;
+FROM SYSTEM IMPORT CARDINAL8 ;
+FROM libc IMPORT printf ;
+
+CONST
+   BoardX         =              16 ;
+   BoardY         =              16 ;
+   BoardSize      = BoardX * BoardY ;
+
+TYPE
+   Squares = [0..BoardSize-1] ;
+   SoS     = SET OF Squares ;
+   Colour  = (Blue, Red, Green, White) ;
+
+VAR
+   homeBase: SoS ;
+
+
+PROCEDURE dumpSet (c: Colour) ;
+VAR
+   n: CARDINAL ;
+BEGIN
+   printf ("inside dumpSet (%d)\n", ORD(c)) ;
+   printf ("      :  0 2 4 6 8 a c e \n") ;
+   FOR n := MIN(Squares) TO MAX(Squares) DO
+      IF n MOD 16 = 0
+      THEN
+         printf ("\nrow %2d:  ", n DIV 16)
+      END ;
+      IF n IN homeBase
+      THEN
+         printf ("1")
+      ELSE
+         printf ("0")
+      END
+   END ;
+   printf ("\n")
+END dumpSet ;
+
+
+(*
+   assert -
+*)
+
+PROCEDURE assert (b: BOOLEAN) ;
+BEGIN
+   IF NOT b
+   THEN
+      WriteString('assert failed') ; WriteLn ;
+      HALT
+   END
+END assert ;
+
+
+BEGIN
+   homeBase := SoS {0, 1, 2, 3,
+                    16, 17, 18, 19,
+                    32, 33, 34,
+                    48, 49} ;
+
+   dumpSet(Blue) ;
+
+   homeBase := homeBase + SoS {4, 20, 35, 50, 65, 64} ;
+   dumpSet(Blue) ;
+
+   assert (0 IN homeBase)
+END simplelarge4.
diff --git a/gcc/testsuite/gm2/iso/run/pass/testsystem.mod b/gcc/testsuite/gm2/iso/run/pass/testsystem.mod
index c22f25be0c6..51c7162e4b6 100644
--- a/gcc/testsuite/gm2/iso/run/pass/testsystem.mod
+++ b/gcc/testsuite/gm2/iso/run/pass/testsystem.mod
@@ -29,7 +29,7 @@ FROM FIO IMPORT Close, StdOut ;
 
 PROCEDURE FindFirstElement (start: CARDINAL; s: LargeSet) : CARDINAL ;
 BEGIN
-   WHILE NOT (start IN s) DO
+   WHILE (start < 1024) AND (NOT (start IN s)) DO
       INC(start)
    END ;
    RETURN( start )
diff --git a/gcc/testsuite/gm2/pimlib/wideset/run/pass/bitset.mod b/gcc/testsuite/gm2/pimlib/wideset/run/pass/bitset.mod
new file mode 100644
index 00000000000..e5a6ba40b69
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/wideset/run/pass/bitset.mod
@@ -0,0 +1,46 @@
+MODULE bitset ;
+
+FROM libc IMPORT printf, exit ;
+FROM M2WIDESET IMPORT Equal, Clear ;
+
+TYPE
+   set = BITSET ;
+
+CONST
+   HighBit = MAX (set) ;
+
+
+(*
+   Assert -
+*)
+
+PROCEDURE Assert (bool: BOOLEAN; line: CARDINAL) ;
+BEGIN
+   IF NOT bool
+   THEN
+      printf ("%s:%d:assert failed\n", __FILE__, line);
+      exit (1)
+   END
+END Assert ;
+
+
+(*
+   init -
+*)
+
+PROCEDURE init ;
+VAR
+   left, right: set ;
+BEGIN
+   left := set {} ;
+   right := set {1} ;
+   Assert (NOT Equal (left, right, HighBit), __LINE__) ;
+   Clear (right, HighBit) ;
+   Assert (Equal (left, right, HighBit), __LINE__) ;
+   printf ("All tests pass in %s\n", __FILE__)
+END init ;
+
+
+BEGIN
+   init
+END bitset.
diff --git a/gcc/testsuite/gm2/pimlib/wideset/run/pass/bitset2.mod b/gcc/testsuite/gm2/pimlib/wideset/run/pass/bitset2.mod
new file mode 100644
index 00000000000..2466a63ea38
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/wideset/run/pass/bitset2.mod
@@ -0,0 +1,43 @@
+MODULE bitset ;
+
+FROM libc IMPORT printf, exit ;
+FROM M2WIDESET IMPORT Equal, Clear ;
+
+CONST
+   HighBit = MAX (BITSET) ;
+
+
+(*
+   Assert -
+*)
+
+PROCEDURE Assert (bool: BOOLEAN; line: CARDINAL) ;
+BEGIN
+   IF NOT bool
+   THEN
+      printf ("%s:%d:assert failed\n", __FILE__, line);
+      exit (1)
+   END
+END Assert ;
+
+
+(*
+   init -
+*)
+
+PROCEDURE init ;
+VAR
+   left, right: BITSET ;
+BEGIN
+   left := BITSET {} ;
+   right := BITSET {1} ;
+   Assert (NOT Equal (left, right, HighBit), __LINE__) ;
+   Clear (right, HighBit) ;
+   Assert (Equal (left, right, HighBit), __LINE__) ;
+   printf ("All tests pass in %s\n", __FILE__)
+END init ;
+
+
+BEGIN
+   init
+END bitset.
diff --git a/gcc/testsuite/gm2/pimlib/wideset/run/pass/colorset.mod b/gcc/testsuite/gm2/pimlib/wideset/run/pass/colorset.mod
new file mode 100644
index 00000000000..61b609635e9
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/wideset/run/pass/colorset.mod
@@ -0,0 +1,47 @@
+MODULE colorset ;
+
+FROM libc IMPORT printf, exit ;
+FROM M2WIDESET IMPORT Equal, Clear ;
+
+TYPE
+   color = SET OF (red, green, blue) ;
+   set = color ;
+
+CONST
+   HighBit = MAX (set) ;
+
+
+(*
+   Assert -
+*)
+
+PROCEDURE Assert (bool: BOOLEAN; line: CARDINAL) ;
+BEGIN
+   IF NOT bool
+   THEN
+      printf ("%s:%d:assert failed\n", __FILE__, line);
+      exit (1)
+   END
+END Assert ;
+
+
+(*
+   init -
+*)
+
+PROCEDURE init ;
+VAR
+   left, right: set ;
+BEGIN
+   left := set {} ;
+   right := set {green} ;
+   Assert (NOT Equal (left, right, HighBit), __LINE__) ;
+   Clear (right, HighBit) ;
+   Assert (Equal (left, right, HighBit), __LINE__) ;
+   printf ("All tests pass in %s\n", __FILE__)
+END init ;
+
+
+BEGIN
+   init
+END colorset.
diff --git a/gcc/testsuite/gm2/pimlib/wideset/run/pass/colorset2.mod b/gcc/testsuite/gm2/pimlib/wideset/run/pass/colorset2.mod
new file mode 100644
index 00000000000..41b8a3be52f
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/wideset/run/pass/colorset2.mod
@@ -0,0 +1,72 @@
+MODULE colorset2 ;
+
+FROM libc IMPORT printf, exit ;
+FROM M2WIDESET IMPORT Equal, Clear, Shift, Rotate ;
+
+TYPE
+   color = SET OF (red, green, blue) ;
+   set = color ;
+
+CONST
+   HighBit = MAX (set) ;
+
+
+(*
+   Assert -
+*)
+
+PROCEDURE Assert (bool: BOOLEAN; line: CARDINAL) ;
+BEGIN
+   IF NOT bool
+   THEN
+      printf ("%s:%d:assert failed\n", __FILE__, line);
+      exit (1)
+   END
+END Assert ;
+
+
+(*
+   init -
+*)
+
+PROCEDURE init ;
+VAR
+   left, right: set ;
+BEGIN
+   left := set {} ;
+   right := set {green} ;
+   Assert (NOT Equal (left, right, HighBit), __LINE__) ;
+   Clear (right, HighBit) ;
+   Assert (Equal (left, right, HighBit), __LINE__) ;
+
+   left := set {red} ;
+   right := set {green} ;
+   Assert (NOT Equal (left, right, HighBit), __LINE__) ;
+   Shift (right, right, MAX (set), -1) ;
+   Assert (Equal (left, right, HighBit), __LINE__) ;
+   left := set {red} ;
+   right := set {green} ;
+   Shift (left, left, MAX (set), 1) ;
+   Assert (Equal (left, right, HighBit), __LINE__) ;
+
+   left := set {red} ;
+   right := set {green} ;
+   Rotate (left, left, MAX (set), 1) ;
+   Assert (Equal (left, right, HighBit), __LINE__) ;
+
+   left := set {green} ;
+   right := set {red} ;
+   Rotate (left, left, MAX (set), -1) ;
+   Assert (Equal (left, right, HighBit), __LINE__) ;
+
+   left := set {red} ;
+   right := set {blue} ;
+   Rotate (left, left, MAX (set), -1) ;
+   Assert (Equal (left, right, HighBit), __LINE__) ;
+   printf ("All tests pass in %s\n", __FILE__)
+END init ;
+
+
+BEGIN
+   init
+END colorset2.
diff --git a/gcc/testsuite/gm2/pimlib/wideset/run/pass/colorset3.mod b/gcc/testsuite/gm2/pimlib/wideset/run/pass/colorset3.mod
new file mode 100644
index 00000000000..170abb0ff60
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/wideset/run/pass/colorset3.mod
@@ -0,0 +1,46 @@
+MODULE colorset3 ;
+
+FROM libc IMPORT printf, exit ;
+FROM M2WIDESET IMPORT Equal, Clear, Shift, Rotate ;
+
+TYPE
+   color = SET OF (red, green, blue) ;
+   set = color ;
+
+CONST
+   HighBit = MAX (set) ;
+
+
+(*
+   Assert -
+*)
+
+PROCEDURE Assert (bool: BOOLEAN; line: CARDINAL) ;
+BEGIN
+   IF NOT bool
+   THEN
+      printf ("%s:%d:assert failed\n", __FILE__, line);
+      exit (1)
+   END
+END Assert ;
+
+
+(*
+   init -
+*)
+
+PROCEDURE init ;
+VAR
+   left, right: set ;
+BEGIN
+   left := set {green} ;
+   right := set {red} ;
+   Rotate (left, left, MAX (set), -1) ;
+   Assert (Equal (left, right, HighBit), __LINE__) ;
+   printf ("All tests pass in %s\n", __FILE__)
+END init ;
+
+
+BEGIN
+   init
+END colorset3.
diff --git a/gcc/testsuite/gm2/pimlib/wideset/run/pass/highbit.mod b/gcc/testsuite/gm2/pimlib/wideset/run/pass/highbit.mod
new file mode 100644
index 00000000000..c9c872a62f3
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/wideset/run/pass/highbit.mod
@@ -0,0 +1,13 @@
+MODULE highbit ;
+
+FROM libc IMPORT printf ;
+
+TYPE
+   set = BITSET ;
+
+CONST
+   HighBit = MAX (set) ;
+
+BEGIN
+   printf ("the MAX (set) = %d\n", HighBit)
+END highbit.
diff --git a/gcc/testsuite/gm2/pimlib/wideset/run/pass/highbit2.mod b/gcc/testsuite/gm2/pimlib/wideset/run/pass/highbit2.mod
new file mode 100644
index 00000000000..940556da5fe
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/wideset/run/pass/highbit2.mod
@@ -0,0 +1,13 @@
+MODULE highbit2 ;
+
+FROM libc IMPORT printf ;
+
+TYPE
+   set = BITSET ;
+
+CONST
+   HighBit = MAX (BITSET) ;
+
+BEGIN
+   printf ("the MAX (BITSET) = %d\n", HighBit)
+END highbit2.
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetrotate4.mod b/gcc/testsuite/gm2/sets/run/pass/multisetrotate4.mod
index f7524eb9444..19a085be2bc 100644
--- a/gcc/testsuite/gm2/sets/run/pass/multisetrotate4.mod
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetrotate4.mod
@@ -18,7 +18,7 @@ Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
 MODULE multisetrotate4 ;
 
 FROM libc IMPORT printf, exit ;
-FROM SYSTEM IMPORT ROTATE, WORD, BITSPERLOC ;
+FROM SYSTEM IMPORT ROTATE, WORD, BITSPERLOC, TBITSIZE ;
 
 TYPE
    multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
@@ -29,12 +29,21 @@ VAR
 BEGIN
    set := multi {1} ;
    bits := SIZE (multi) * BITSPERLOC ;
+   IF bits # TBITSIZE (set)
+   THEN
+      printf ("test code is invalid, set must match TBITSIZE\n");
+      exit (3)
+   END ;
    IF ROTATE (set, bits-1) # multi {0}
    THEN
+      printf ("rotate %d on a set type of %d bits failed\n",
+              bits-1, bits) ;
       exit (1)
    END ;
    IF ROTATE (set, -(bits - 1)) # multi {2}
    THEN
+      printf ("rotate %d on a set type of %d bits failed\n",
+              - (bits-1), bits) ;
       exit (2)
    END ;
    exit (0)
diff --git a/gcc/testsuite/gm2/sets/run/pass/multisetrotate5.mod b/gcc/testsuite/gm2/sets/run/pass/multisetrotate5.mod
new file mode 100644
index 00000000000..ff0e28849cf
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/multisetrotate5.mod
@@ -0,0 +1,70 @@
+(* Copyright (C) 2025 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING.  If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+MODULE multisetrotate5 ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ROTATE, WORD, BITSPERLOC ;
+
+TYPE
+   multi = SET OF [0..SIZE (WORD) * 2 * BITSPERLOC-1] ;
+
+
+(*
+   dump -
+*)
+
+PROCEDURE dump (s: multi) ;
+VAR
+   bits, i: CARDINAL ;
+BEGIN
+   bits := SIZE (multi) * BITSPERLOC -1;
+   FOR i := 0 TO bits DO
+      printf (" %2d", i)
+   END ;
+   printf ("\n") ;
+   FOR i := 0 TO bits DO
+      IF i IN s
+      THEN
+         printf ("  X")
+      ELSE
+         printf ("   ")
+      END
+   END ;
+   printf ("\n")
+END dump ;
+
+
+VAR
+   set : multi ;
+   bits: INTEGER ;
+BEGIN
+   dump (multi {1}) ;
+   dump (multi {2}) ;
+   set := multi {2} ;
+   dump (set) ;
+   set := multi {1} ;
+   dump (set) ;
+   IF ROTATE (set, 1) = multi {2}
+   THEN
+      exit (0)
+   END ;
+   set := multi {2} ;
+   set := ROTATE (set, 1) ;
+   dump (set) ;
+   exit (1)
+END multisetrotate5.
diff --git a/gcc/testsuite/gm2/sets/run/pass/setcard.mod b/gcc/testsuite/gm2/sets/run/pass/setcard.mod
new file mode 100644
index 00000000000..5b964b93149
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setcard.mod
@@ -0,0 +1,18 @@
+MODULE setcard ;
+
+FROM libc IMPORT exit ;
+
+TYPE
+   large = SET OF CARDINAL ;
+VAR
+   set: large ;
+BEGIN
+   set := large {} ;
+   INCL (set, 2) ;
+   IF 2 IN set
+   THEN
+      exit (0)
+   ELSE
+      exit (1)
+   END
+END setcard.
diff --git a/gcc/testsuite/gm2/sets/run/pass/setincl.mod b/gcc/testsuite/gm2/sets/run/pass/setincl.mod
new file mode 100644
index 00000000000..ad65b1aff42
--- /dev/null
+++ b/gcc/testsuite/gm2/sets/run/pass/setincl.mod
@@ -0,0 +1,51 @@
+(* Copyright (C) 2024 Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING.  If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
+
+MODULE setincl ;
+
+FROM libc IMPORT printf, exit ;
+FROM SYSTEM IMPORT ROTATE ;
+
+
+PROCEDURE incl (VAR set: BITSET; bit: CARDINAL) ;
+BEGIN
+   INCL (set, bit)
+END incl ;
+
+
+PROCEDURE excl (VAR set: BITSET; bit: CARDINAL) ;
+BEGIN
+   EXCL (set, bit)
+END excl ;
+
+
+VAR
+   set: BITSET ;
+BEGIN
+   set := BITSET {} ;
+   incl (set, 1) ;
+   IF set # BITSET {1}
+   THEN
+      exit (1)
+   END ;
+   excl (set, 1) ;
+   IF set # BITSET {}
+   THEN
+      exit (2)
+   END ;
+   exit (0)
+END setincl.
diff --git a/gcc/testsuite/gm2/sets/run/pass/simplepacked.mod b/gcc/testsuite/gm2/sets/run/pass/simplepacked.mod
index 4cc598baca4..d173700b728 100644
--- a/gcc/testsuite/gm2/sets/run/pass/simplepacked.mod
+++ b/gcc/testsuite/gm2/sets/run/pass/simplepacked.mod
@@ -57,7 +57,7 @@ BEGIN
    assert (ROTATE (psettype {1}, 1) = ROTATE (psettype {1}, 1), __LINE__, "comparision between constant rotated packed sets") ;
    assert (ROTATE (psettype {1}, 1) # ROTATE (psettype {2}, 1), __LINE__, "comparision between constant rotated packed sets") ;
    assert (ROTATE (a, 1) = psettype {2}, __LINE__, "comparision between rotated variable and constant packed sets") ;
-   assert (ROTATE (a, -1) = settype {0}, __LINE__, "comparision between rotated variable and constant packed sets") ;         
+   assert (ROTATE (a, -1) = psettype {0}, __LINE__, "comparision between rotated variable and constant packed sets") ;
 END testpset ;
 
 
diff --git a/gcc/testsuite/lib/gm2.exp b/gcc/testsuite/lib/gm2.exp
index 5760bc02b1e..1b03118ccd5 100644
--- a/gcc/testsuite/lib/gm2.exp
+++ b/gcc/testsuite/lib/gm2.exp
@@ -633,6 +633,7 @@ proc gm2_init_minx { dialect paths args } {
     gm2_link_lib "m2min"
     lappend args -fno-exceptions
     lappend args -fno-libs=-
+    lappend args -fno-wideset
     gm2_init {*}${theIpath} {*}${dialect} {*}${theLpath} {*}${args}
 }
 
diff --git a/libgm2/libm2pim/Makefile.am b/libgm2/libm2pim/Makefile.am
index 56bbb3e4a07..91990d71092 100644
--- a/libgm2/libm2pim/Makefile.am
+++ b/libgm2/libm2pim/Makefile.am
@@ -99,6 +99,8 @@ toolexeclib_LTLIBRARIES = libm2pim.la
 M2MODS = ASCII.mod IO.mod \
        Args.mod M2RTS.mod \
        M2Dependent.mod \
+       M2Diagnostic.mod \
+       M2WIDESET.mod \
        Assertion.mod NumberIO.mod \
        Break.mod SYSTEM.mod \
        CmdArgs.mod Scan.mod \
@@ -142,8 +144,10 @@ M2DEFS = Args.def   ASCII.def \
          LegacyReal.def  libc.def \
          libm.def  LMathLib0.def \
          M2Dependent.def \
+         M2Diagnostic.def \
          M2EXCEPTION.def \
          M2RTS.def \
+         M2WIDESET.def \
          MathLib0.def  MemUtils.def \
          NumberIO.def  PushBackInput.def \
          RTExceptions.def  RTint.def \
diff --git a/libgm2/libm2pim/Makefile.in b/libgm2/libm2pim/Makefile.in
index 63f8fc90873..abc826e6281 100644
--- a/libgm2/libm2pim/Makefile.in
+++ b/libgm2/libm2pim/Makefile.in
@@ -158,11 +158,12 @@ am__installdirs = "$(DESTDIR)$(toolexeclibdir)"
 LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
 libm2pim_la_LIBADD =
 @BUILD_PIMLIB_TRUE@am__objects_1 = ASCII.lo IO.lo Args.lo M2RTS.lo \
-@BUILD_PIMLIB_TRUE@	M2Dependent.lo Assertion.lo NumberIO.lo \
-@BUILD_PIMLIB_TRUE@	Break.lo SYSTEM.lo CmdArgs.lo Scan.lo \
-@BUILD_PIMLIB_TRUE@	StrCase.lo FIO.lo StrIO.lo StrLib.lo \
-@BUILD_PIMLIB_TRUE@	TimeString.lo Environment.lo FpuIO.lo \
-@BUILD_PIMLIB_TRUE@	Debug.lo SysStorage.lo Storage.lo StdIO.lo \
+@BUILD_PIMLIB_TRUE@	M2Dependent.lo M2Diagnostic.lo M2WIDESET.lo \
+@BUILD_PIMLIB_TRUE@	Assertion.lo NumberIO.lo Break.lo SYSTEM.lo \
+@BUILD_PIMLIB_TRUE@	CmdArgs.lo Scan.lo StrCase.lo FIO.lo \
+@BUILD_PIMLIB_TRUE@	StrIO.lo StrLib.lo TimeString.lo \
+@BUILD_PIMLIB_TRUE@	Environment.lo FpuIO.lo Debug.lo \
+@BUILD_PIMLIB_TRUE@	SysStorage.lo Storage.lo StdIO.lo \
 @BUILD_PIMLIB_TRUE@	SEnvironment.lo DynamicStrings.lo SFIO.lo \
 @BUILD_PIMLIB_TRUE@	SArgs.lo SCmdArgs.lo PushBackInput.lo \
 @BUILD_PIMLIB_TRUE@	StringConvert.lo FormatStrings.lo \
@@ -478,6 +479,8 @@ FLAGS_TO_PASS = $(AM_MAKEFLAGS)
 @BUILD_PIMLIB_TRUE@M2MODS = ASCII.mod IO.mod \
 @BUILD_PIMLIB_TRUE@       Args.mod M2RTS.mod \
 @BUILD_PIMLIB_TRUE@       M2Dependent.mod \
+@BUILD_PIMLIB_TRUE@       M2Diagnostic.mod \
+@BUILD_PIMLIB_TRUE@       M2WIDESET.mod \
 @BUILD_PIMLIB_TRUE@       Assertion.mod NumberIO.mod \
 @BUILD_PIMLIB_TRUE@       Break.mod SYSTEM.mod \
 @BUILD_PIMLIB_TRUE@       CmdArgs.mod Scan.mod \
@@ -521,8 +524,10 @@ FLAGS_TO_PASS = $(AM_MAKEFLAGS)
 @BUILD_PIMLIB_TRUE@         LegacyReal.def  libc.def \
 @BUILD_PIMLIB_TRUE@         libm.def  LMathLib0.def \
 @BUILD_PIMLIB_TRUE@         M2Dependent.def \
+@BUILD_PIMLIB_TRUE@         M2Diagnostic.def \
 @BUILD_PIMLIB_TRUE@         M2EXCEPTION.def \
 @BUILD_PIMLIB_TRUE@         M2RTS.def \
+@BUILD_PIMLIB_TRUE@         M2WIDESET.def \
 @BUILD_PIMLIB_TRUE@         MathLib0.def  MemUtils.def \
 @BUILD_PIMLIB_TRUE@         NumberIO.def  PushBackInput.def \
 @BUILD_PIMLIB_TRUE@         RTExceptions.def  RTint.def \