public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] New files for new scaffold linking mechanism.
@ 2022-07-07 16:03 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2022-07-07 16:03 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:abd47db32747da2f65c021a70888ead398dd8f59
commit abd47db32747da2f65c021a70888ead398dd8f59
Author: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Date: Thu Jul 7 16:11:44 2022 +0100
New files for new scaffold linking mechanism.
gcc/m2/ChangeLog:
* gm2-compiler/M2Scaffold.def (New file).
* gm2-compiler/M2Scaffold.mod (New file).
* gm2-libs-ch/M2LINK.c (New file).
* gm2-libs-ch/UnixArgs.cc (New file).
* gm2-libs-ch/dtoa.cc (New file).
* gm2-libs-ch/ldtoa.cc (New file).
* gm2-libs-ch/m2rts.h (New file).
* gm2-libs/M2Dependent.def (New file).
* gm2-libs/M2Dependent.mod (New file).
* gm2-libs/M2LINK.def (New file).
* mc-boot-ch/GM2LINK.c (New file).
* mc-boot-ch/GUnixArgs.cc (New file).
* mc-boot-ch/Gtermios.cc (New file).
* mc-boot-ch/m2rts.h (New file).
* mc-boot/GM2Dependent.c (New file).
* mc-boot/GM2Dependent.h (New file).
* mc-boot/GM2LINK.h (New file).
gcc/testsuite/gm2/ChangeLog:
* gcc/testsuite/gm2/link/externalscaffold/pass/hello.mod (New file).
* gcc/testsuite/gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp (New file).
* gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c (New file).
libgm2/ChangeLog:
* libgm2/libm2iso/ErrnoCategory.cc (New file).
* libgm2/libm2iso/RTco.cc (New file).
* libgm2/libm2iso/m2rts.h (New file).
* libgm2/libm2pim/Selective.cc (New file).
* libgm2/libm2pim/SysExceptions.cc (New file).
* libgm2/libm2pim/UnixArgs.cc (New file).
* libgm2/libm2pim/dtoa.cc (New file).
* libgm2/libm2pim/errno.cc (New file).
* libgm2/libm2pim/ldtoa.cc (New file).
* libgm2/libm2pim/sckt.cc (New file).
* libgm2/libm2pim/termios.cc (New file).
Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk>
Diff:
---
gcc/m2/gm2-compiler/M2Scaffold.def | 73 +
gcc/m2/gm2-compiler/M2Scaffold.mod | 395 ++++
gcc/m2/gm2-libs-ch/M2LINK.c | 44 +
gcc/m2/gm2-libs-ch/UnixArgs.cc | 91 +
gcc/m2/gm2-libs-ch/dtoa.cc | 206 ++
gcc/m2/gm2-libs-ch/ldtoa.cc | 135 ++
gcc/m2/gm2-libs-ch/m2rts.h | 41 +
gcc/m2/gm2-libs/M2Dependent.def | 62 +
gcc/m2/gm2-libs/M2Dependent.mod | 791 ++++++++
gcc/m2/gm2-libs/M2LINK.def | 41 +
gcc/m2/mc-boot-ch/GM2LINK.c | 27 +
gcc/m2/mc-boot-ch/GUnixArgs.cc | 91 +
gcc/m2/mc-boot-ch/Gtermios.cc | 1947 +++++++++++++++++++
gcc/m2/mc-boot-ch/m2rts.h | 41 +
gcc/m2/mc-boot/GM2Dependent.c | 1113 +++++++++++
gcc/m2/mc-boot/GM2Dependent.h | 78 +
gcc/m2/mc-boot/GM2LINK.h | 59 +
.../gm2/link/externalscaffold/pass/hello.mod | 7 +
.../pass/link-externalscaffold-pass.exp | 39 +
.../gm2/link/externalscaffold/pass/scaffold.c | 37 +
libgm2/libm2iso/ErrnoCategory.cc | 180 ++
libgm2/libm2iso/RTco.cc | 467 +++++
libgm2/libm2iso/m2rts.h | 41 +
libgm2/libm2pim/Selective.cc | 319 ++++
libgm2/libm2pim/SysExceptions.cc | 259 +++
libgm2/libm2pim/UnixArgs.cc | 91 +
libgm2/libm2pim/dtoa.cc | 265 +++
libgm2/libm2pim/errno.cc | 70 +
libgm2/libm2pim/ldtoa.cc | 190 ++
libgm2/libm2pim/sckt.cc | 430 +++++
libgm2/libm2pim/termios.cc | 1987 ++++++++++++++++++++
31 files changed, 9617 insertions(+)
diff --git a/gcc/m2/gm2-compiler/M2Scaffold.def b/gcc/m2/gm2-compiler/M2Scaffold.def
new file mode 100644
index 00000000000..f99efbc1656
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Scaffold.def
@@ -0,0 +1,73 @@
+(* M2Scaffold.def declare and create scaffold entities.
+
+Copyright (C) 2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+DEFINITION MODULE M2Scaffold ;
+
+
+VAR
+ linkFunction,
+ finiFunction,
+ initFunction,
+ mainFunction: CARDINAL ;
+
+
+(*
+ DeclareScaffold - declare scaffold related entities.
+*)
+
+PROCEDURE DeclareScaffold (tokno: CARDINAL) ;
+
+
+(*
+ DeclareArgEnvParams - declares (int argc, void *argv, void *envp)
+*)
+
+PROCEDURE DeclareArgEnvParams (tokno: CARDINAL; proc: CARDINAL) ;
+
+
+(*
+ PopulateCtorArray - assign each element of the ctorArray to the external module ctor.
+ This is only used to force the linker to pull in the ctors from
+ a library.
+*)
+
+PROCEDURE PopulateCtorArray (tok: CARDINAL) ;
+
+
+(*
+ ForeachModuleCallInit - precondition: the module list will be ordered.
+ postcondition: foreach module in the application universe
+ call _M2_module_init (argc, argv, envp);
+*)
+
+PROCEDURE ForeachModuleCallInit (tok: CARDINAL; argc, argv, envp: CARDINAL) ;
+
+
+(*
+ ForeachModuleCallFinish - precondition: the module list will be ordered.
+ postcondition: foreach module in the application universe
+ call _M2_module_finish (argc, argv, envp);
+*)
+
+PROCEDURE ForeachModuleCallFinish (tok: CARDINAL; argc, argv, envp: CARDINAL) ;
+
+
+END M2Scaffold.
diff --git a/gcc/m2/gm2-compiler/M2Scaffold.mod b/gcc/m2/gm2-compiler/M2Scaffold.mod
new file mode 100644
index 00000000000..47ada7b5a98
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2Scaffold.mod
@@ -0,0 +1,395 @@
+(* M2Scaffold.mod declare and create scaffold entities.
+
+Copyright (C) 2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+IMPLEMENTATION MODULE M2Scaffold ;
+
+FROM SymbolTable IMPORT NulSym, MakeProcedure, PutFunction,
+ PutPublic, PutCtor, PutParam, IsProcedure,
+ MakeConstant, PutExtern, MakeArray, PutArray,
+ MakeSubrange, PutSubrange,
+ MakeSubscript, PutSubscript, PutArraySubscript,
+ MakeVar, PutVar, MakeProcedureCtorExtern,
+ GetMainModule, GetModuleCtors, MakeDefImp,
+ PutModuleCtorExtern,
+ GetSymName, StartScope, EndScope ;
+
+FROM NameKey IMPORT NulName, Name, MakeKey, makekey, KeyToCharStar ;
+FROM M2Base IMPORT Integer, Cardinal ;
+FROM M2System IMPORT Address ;
+FROM M2LexBuf IMPORT GetTokenNo ;
+FROM Assertion IMPORT Assert ;
+FROM Lists IMPORT List, InitList, IncludeItemIntoList, NoOfItemsInList, GetItemFromList ;
+FROM M2MetaError IMPORT MetaErrorT0 ;
+
+FROM SFIO IMPORT OpenToWrite, WriteS, ReadS, OpenToRead, Exists ;
+FROM FIO IMPORT File, EOF, IsNoError, Close ;
+FROM M2Options IMPORT GetUselist, ScaffoldStatic ;
+FROM M2Base IMPORT Proc ;
+
+FROM M2Quads IMPORT PushTFtok, PushTtok, PushT, BuildDesignatorArray, BuildAssignment,
+ BuildProcedureCall ;
+
+FROM M2Batch IMPORT IsModuleKnown, Get ;
+
+FROM DynamicStrings IMPORT String, InitString, KillString, ConCat, RemoveWhitePrefix,
+ EqualArray, Mark, Assign, Fin, InitStringChar, Length, Slice, Equal,
+ RemoveComment, string ;
+
+CONST
+ Comment = '#' ; (* Comment leader *)
+
+VAR
+ uselistModules,
+ ctorModules,
+ ctorGlobals : List ;
+ ctorArray,
+ ctorArrayType : CARDINAL ;
+
+
+(* The dynamic scaffold takes the form:
+
+static void _M2_init (int argc, char *argv[], char *envp[])
+{
+ M2RTS_ConstructModules (module_name, argc, argv, envp);
+}
+
+
+static void _M2_finish (int argc, char *argv[], char *envp[])
+{
+ M2RTS_Terminate ();
+ M2RTS_DeconstructModules (module_name, argc, argv, envp);
+}
+
+
+int
+main (int argc, char *argv[], char *envp[])
+{
+ init (argc, argv, envp);
+ finish ();
+ return (0);
+} *)
+
+
+(*
+ DeclareCtorArrayType - declare an ARRAY [0..high] OF PROC which will
+ be used to reference every module ctor.
+*)
+
+PROCEDURE DeclareCtorArrayType (tokenno: CARDINAL; high: CARDINAL) : CARDINAL ;
+VAR
+ subscript,
+ subrange : CARDINAL ;
+BEGIN
+ (* ctorArrayType = ARRAY [0..n] OF PROC ; *)
+ ctorArrayType := MakeArray (tokenno, MakeKey ('ctorGlobalType')) ;
+ PutArray (ctorArrayType, Proc) ;
+ subrange := MakeSubrange (tokenno, NulName) ;
+ PutSubrange (subrange,
+ MakeConstant (tokenno, 0),
+ MakeConstant (tokenno, high),
+ Cardinal) ;
+ subscript := MakeSubscript () ;
+ PutSubscript (subscript, subrange) ;
+ PutArraySubscript (ctorArrayType, subscript) ;
+ RETURN ctorArrayType
+END DeclareCtorArrayType ;
+
+
+(*
+ DeclareCtorGlobal - declare the ctorArray variable.
+*)
+
+PROCEDURE DeclareCtorGlobal (tokenno: CARDINAL) ;
+VAR
+ n: CARDINAL ;
+BEGIN
+ n := NoOfItemsInList (ctorGlobals) ;
+ ctorArrayType := DeclareCtorArrayType (tokenno, n) ;
+ ctorArray := MakeVar (tokenno, MakeKey ('_M2_ctorArray')) ;
+ PutVar (ctorArray, ctorArrayType)
+END DeclareCtorGlobal ;
+
+
+(*
+ ForeachModuleCallInit - is only called when -fscaffold-static is enabled.
+ precondition: the module list will be ordered.
+ postcondition: foreach module in the application universe
+ call _M2_module_init (argc, argv, envp);
+*)
+
+PROCEDURE ForeachModuleCallInit (tok: CARDINAL; argc, argv, envp: CARDINAL) ;
+VAR
+ module : CARDINAL ;
+ i, n : CARDINAL ;
+ ctor, init,
+ fini, dep : CARDINAL ;
+BEGIN
+ i := 1 ;
+ n := NoOfItemsInList (uselistModules) ;
+ WHILE i <= n DO
+ module := GetItemFromList (uselistModules, i) ;
+ IF module # NulSym
+ THEN
+ GetModuleCtors (module, ctor, init, fini, dep) ;
+ IF init # NulSym
+ THEN
+ PushTtok (init, tok) ;
+ PushTtok (argc, tok) ;
+ PushTtok (argv, tok) ;
+ PushTtok (envp, tok) ;
+ PushT (3) ;
+ BuildProcedureCall (tok)
+ END
+ END ;
+ INC (i)
+ END
+END ForeachModuleCallInit ;
+
+
+(*
+ ForeachModuleCallFinish - precondition: the module list will be ordered.
+ postcondition: foreach module in the application universe
+ call _M2_module_finish (argc, argv, envp);
+*)
+
+PROCEDURE ForeachModuleCallFinish (tok: CARDINAL; argc, argv, envp: CARDINAL) ;
+VAR
+ module : CARDINAL ;
+ i : CARDINAL ;
+ ctor, init,
+ fini, dep : CARDINAL ;
+BEGIN
+ i := NoOfItemsInList (uselistModules) ;
+ WHILE i >= 1 DO
+ module := GetItemFromList (uselistModules, i) ;
+ IF module # NulSym
+ THEN
+ GetModuleCtors (module, ctor, init, fini, dep) ;
+ IF fini # NulSym
+ THEN
+ PushTtok (fini, tok) ;
+ PushTtok (argc, tok) ;
+ PushTtok (argv, tok) ;
+ PushTtok (envp, tok) ;
+ PushT (3) ;
+ BuildProcedureCall (tok)
+ END
+ END ;
+ DEC (i)
+ END
+END ForeachModuleCallFinish ;
+
+
+(*
+ PopulateCtorArray - assign each element of the ctorArray to the external module ctor.
+ This is only used to force the linker to pull in the ctors from
+ a library.
+*)
+
+PROCEDURE PopulateCtorArray (tok: CARDINAL) ;
+VAR
+ i, n: CARDINAL ;
+BEGIN
+ n := NoOfItemsInList (ctorModules) ;
+ i := 1 ;
+ WHILE i <= n DO
+ PushTFtok (ctorArray, ctorArrayType, tok) ;
+ PushTtok (MakeConstant (tok, i), tok) ;
+ BuildDesignatorArray ;
+ PushTtok (GetItemFromList (ctorModules, i), tok) ;
+ BuildAssignment (tok) ;
+ INC (i)
+ END
+END PopulateCtorArray ;
+
+
+(*
+ LookupModuleSym - returns a defimp module. It looks up an existing
+ module and if this does not exist creates a new one.
+*)
+
+PROCEDURE LookupModuleSym (tok: CARDINAL; name: Name) : CARDINAL ;
+VAR
+ sym: CARDINAL ;
+BEGIN
+ sym := Get (name) ;
+ IF sym = NulSym
+ THEN
+ sym := MakeDefImp (tok, name)
+ END ;
+ IF sym # GetMainModule ()
+ THEN
+ PutModuleCtorExtern (tok, sym)
+ END ;
+ RETURN sym
+END LookupModuleSym ;
+
+
+(*
+ ReadModules - populate ctorGlobals with the modules specified by -fuselist=filename.
+*)
+
+PROCEDURE ReadModules (tok: CARDINAL; filename: String) ;
+VAR
+ f : File ;
+ s : String ;
+ name: Name ;
+BEGIN
+ InitList (ctorGlobals) ;
+ InitList (uselistModules) ;
+ f := OpenToRead (filename) ;
+ WHILE NOT EOF (f) DO
+ s := ReadS (f) ;
+ s := RemoveComment (RemoveWhitePrefix (s), Comment) ;
+ IF (NOT Equal (Mark (InitStringChar (Comment)),
+ Mark (Slice (s, 0, Length (Mark (InitStringChar (Comment)))-1)))) AND
+ (NOT EqualArray (s, ''))
+ THEN
+ name := makekey (string (s)) ;
+ IncludeItemIntoList (ctorGlobals, name) ;
+ IncludeItemIntoList (uselistModules, LookupModuleSym (tok, name))
+ END ;
+ s := KillString (s)
+ END ;
+ Close (f)
+END ReadModules ;
+
+
+(*
+ CreateCtorList - uses GetUselist as the filename and then reads the list of modules.
+*)
+
+PROCEDURE CreateCtorList (tok: CARDINAL) : BOOLEAN ;
+VAR
+ filename: String ;
+BEGIN
+ filename := GetUselist () ;
+ IF filename = NIL
+ THEN
+ RETURN FALSE
+ ELSE
+ IF Exists (filename)
+ THEN
+ ReadModules (tok, filename)
+ ELSE
+ MetaErrorT0 (tok,
+ '{%E}the filename specified by the -fuselist= option does not exist') ;
+ RETURN FALSE
+ END
+ END ;
+ RETURN TRUE
+END CreateCtorList ;
+
+
+(*
+ DeclareModuleExtern - declare the extern _M2_modulename_ctor, _M2_modulename_init,
+ _M2_modulename_fini, _M2_modulename_dep for each external module.
+*)
+
+PROCEDURE DeclareModuleExtern (tokenno: CARDINAL) ;
+VAR
+ init,
+ fini,
+ dep,
+ ctor,
+ module: CARDINAL ;
+ n, i : CARDINAL ;
+BEGIN
+ InitList (ctorModules) ;
+ i := 1 ;
+ n := NoOfItemsInList (uselistModules) ;
+ WHILE i <= n DO
+ module := GetItemFromList (uselistModules, i) ;
+ IF module # GetMainModule ()
+ THEN
+ PutModuleCtorExtern (tokenno, module)
+ END ;
+ GetModuleCtors (module, ctor, init, fini, dep) ;
+ IncludeItemIntoList (ctorModules, ctor) ;
+ INC (i)
+ END
+END DeclareModuleExtern ;
+
+
+(*
+ DeclareScaffoldFunctions - declare main, _M2_init,_M2_finish
+ and _M2_link to the modula-2
+ front end.
+*)
+
+PROCEDURE DeclareScaffoldFunctions (tokenno: CARDINAL) ;
+BEGIN
+ IF CreateCtorList (tokenno)
+ THEN
+ DeclareCtorGlobal (tokenno) ;
+ DeclareModuleExtern (tokenno) ;
+ linkFunction := MakeProcedure (tokenno, MakeKey ("_M2_link"))
+ END ;
+
+ mainFunction := MakeProcedure (tokenno, MakeKey ("main")) ;
+ StartScope (mainFunction) ;
+ PutFunction (mainFunction, Integer) ;
+ DeclareArgEnvParams (tokenno, mainFunction) ;
+ PutPublic (mainFunction, TRUE) ;
+ EndScope ;
+
+ initFunction := MakeProcedure (tokenno, MakeKey ("_M2_init")) ;
+ DeclareArgEnvParams (tokenno, initFunction) ;
+
+ finiFunction := MakeProcedure (tokenno, MakeKey ("_M2_finish")) ;
+ DeclareArgEnvParams (tokenno, finiFunction)
+END DeclareScaffoldFunctions ;
+
+
+(*
+ DeclareArgEnvParams - declares (int argc, void *argv, void *envp)
+*)
+
+PROCEDURE DeclareArgEnvParams (tokno: CARDINAL; proc: CARDINAL) ;
+BEGIN
+ Assert (IsProcedure (proc)) ;
+ StartScope (proc) ;
+ Assert (PutParam (tokno, proc, 1, MakeKey ("argc"), Integer, FALSE)) ;
+ Assert (PutParam (tokno, proc, 2, MakeKey ("argv"), Address, FALSE)) ;
+ Assert (PutParam (tokno, proc, 3, MakeKey ("envp"), Address, FALSE)) ;
+ EndScope
+END DeclareArgEnvParams ;
+
+
+(*
+ DeclareScaffold - declare scaffold related entities.
+*)
+
+PROCEDURE DeclareScaffold (tokno: CARDINAL) ;
+BEGIN
+ DeclareScaffoldFunctions (tokno)
+END DeclareScaffold ;
+
+
+BEGIN
+ finiFunction := NulSym ;
+ initFunction := NulSym ;
+ mainFunction := NulSym ;
+ linkFunction := NulSym ;
+ ctorGlobals := NIL ;
+ ctorModules := NIL ;
+ uselistModules := NIL
+END M2Scaffold.
diff --git a/gcc/m2/gm2-libs-ch/M2LINK.c b/gcc/m2/gm2-libs-ch/M2LINK.c
new file mode 100644
index 00000000000..70b4c3d889a
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/M2LINK.c
@@ -0,0 +1,44 @@
+/* M2LINK.c provide a bootstrap minimal definitions.
+
+Copyright (C) 2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+#include "ansidecl.h"
+#include "math.h"
+
+#include "gm2-libs-host.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ /* These definitions are only used during bootstrap to disable the dynamic
+ initialization features of M2RTS. */
+
+ char *M2LINK_ForcedModuleInitOrder = NULL;
+ int M2LINK_StaticInitialization = 1;
+
+}
diff --git a/gcc/m2/gm2-libs-ch/UnixArgs.cc b/gcc/m2/gm2-libs-ch/UnixArgs.cc
new file mode 100644
index 00000000000..1180f351b24
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/UnixArgs.cc
@@ -0,0 +1,91 @@
+/* UnixArgs.cc record argc, argv as global variables.
+
+Copyright (C) 2009-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+#include "m2rts.h"
+
+
+extern "C" int UnixArgs_GetArgC (void);
+extern "C" char **UnixArgs_GetArgV (void);
+extern "C" char **UnixArgs_GetEnvV (void);
+
+static int UnixArgs_ArgC;
+static char **UnixArgs_ArgV;
+static char **UnixArgs_EnvV;
+
+
+/* GetArgC returns argc. */
+
+extern "C" int
+UnixArgs_GetArgC (void)
+{
+ return UnixArgs_ArgC;
+}
+
+
+/* GetArgV returns argv. */
+
+extern "C" char **
+UnixArgs_GetArgV (void)
+{
+ return UnixArgs_ArgV;
+}
+
+
+/* GetEnvV returns envv. */
+
+extern "C" char **
+UnixArgs_GetEnvV (void)
+{
+ return UnixArgs_EnvV;
+}
+
+
+extern "C" void
+_M2_UnixArgs_init (int argc, char *argv[], char *envp[])
+{
+ UnixArgs_ArgC = argc;
+ UnixArgs_ArgV = argv;
+ UnixArgs_EnvV = envp;
+}
+
+extern "C" void
+_M2_UnixArgs_finish (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_UnixArgs_dep (void)
+{
+}
+
+struct _M2_UnixArgs_ctor { _M2_UnixArgs_ctor (); } _M2_UnixArgs_ctor;
+
+_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
+{
+ M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_finish,
+ _M2_UnixArgs_dep);
+}
diff --git a/gcc/m2/gm2-libs-ch/dtoa.cc b/gcc/m2/gm2-libs-ch/dtoa.cc
new file mode 100644
index 00000000000..57317588ba1
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/dtoa.cc
@@ -0,0 +1,206 @@
+/* dtoa.c provide floating point string conversion routines.
+
+Copyright (C) 2009-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+#include "ansidecl.h"
+
+#include "gm2-libs-host.h"
+#include "m2rts.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define MAX_FP_DIGITS 500
+
+typedef enum Mode { maxsignicant, decimaldigits } Mode;
+
+/* maxsignicant: return a string containing max(1,ndigits)
+ significant digits. The return string contains the string
+ produced by ecvt. decimaldigits: return a string produced by
+ fcvt. The string will contain ndigits past the decimal point
+ (ndigits may be negative). */
+
+double
+dtoa_strtod (const char *s, int *error)
+{
+ char *endp;
+ double d;
+
+ errno = 0;
+ d = strtod (s, &endp);
+ if (endp != NULL && (*endp == '\0'))
+ *error = (errno != 0);
+ else
+ *error = TRUE;
+ return d;
+}
+
+/* dtoa_calcmaxsig - calculates the position of the decimal point it
+ also removes the decimal point and exponent from string, p. */
+
+int
+dtoa_calcmaxsig (char *p, int ndigits)
+{
+ char *e;
+ char *o;
+ int x;
+
+ e = index (p, 'E');
+ if (e == NULL)
+ x = 0;
+ else
+ {
+ *e = (char)0;
+ x = atoi (e + 1);
+ }
+
+ o = index (p, '.');
+ if (o == NULL)
+ return strlen (p) + x;
+ else
+ {
+ memmove (o, o + 1, ndigits - (o - p));
+ return o - p + x;
+ }
+}
+
+/* dtoa_calcdecimal - calculates the position of the decimal point it
+ also removes the decimal point and exponent from string, p. It
+ truncates the digits in p accordingly to ndigits. Ie ndigits is
+ the number of digits after the '.' */
+
+int
+dtoa_calcdecimal (char *p, int str_size, int ndigits)
+{
+ char *e;
+ char *o;
+ int x;
+ int l;
+
+ e = index (p, 'E');
+ if (e == NULL)
+ x = 0;
+ else
+ {
+ *e = (char)0;
+ x = atoi (e + 1);
+ }
+
+ l = strlen (p);
+ o = index (p, '.');
+ if (o == NULL)
+ x += strlen (p);
+ else
+ {
+ int m = strlen (o);
+ memmove (o, o + 1, l - (o - p));
+ if (m > 0)
+ o[m - 1] = '0';
+ x += o - p;
+ }
+ if ((x + ndigits >= 0) && (x + ndigits < str_size))
+ p[x + ndigits] = (char)0;
+ return x;
+}
+
+int
+dtoa_calcsign (char *p, int str_size)
+{
+ if (p[0] == '-')
+ {
+ memmove (p, p + 1, str_size - 1);
+ return TRUE;
+ }
+ else
+ return FALSE;
+}
+
+char *
+dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign)
+{
+ char format[50];
+ char *p;
+ int r;
+ switch (mode)
+ {
+
+ case maxsignicant:
+ ndigits += 20; /* enough for exponent. */
+ p = (char *) malloc (ndigits);
+ snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "E");
+ snprintf (p, ndigits, format, d);
+ *sign = dtoa_calcsign (p, ndigits);
+ *decpt = dtoa_calcmaxsig (p, ndigits);
+ return p;
+ case decimaldigits:
+ p = (char *) malloc (MAX_FP_DIGITS + 20);
+ snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "E");
+ snprintf (p, MAX_FP_DIGITS + 20, format, d);
+ *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
+ *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ return p;
+ default:
+ abort ();
+ }
+}
+
+/* GNU Modula-2 hooks */
+
+void
+_M2_dtoa_init (int, char **, char **)
+{
+}
+
+void
+_M2_dtoa_finish (int, char **, char **)
+{
+}
+
+void
+_M2_dtoa_dep (void)
+{
+}
+
+#ifdef __cplusplus
+}
+
+struct _M2_dtoa_ctor { _M2_dtoa_ctor (); } _M2_dtoa_ctor;
+
+_M2_dtoa_ctor::_M2_dtoa_ctor (void)
+{
+ M2RTS_RegisterModule ("dtoa", _M2_dtoa_init, _M2_dtoa_finish,
+ _M2_dtoa_dep);
+}
+
+#else
+void
+_M2_dtoa_ctor (void)
+{
+}
+
+#endif
diff --git a/gcc/m2/gm2-libs-ch/ldtoa.cc b/gcc/m2/gm2-libs-ch/ldtoa.cc
new file mode 100644
index 00000000000..ac14297ec24
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/ldtoa.cc
@@ -0,0 +1,135 @@
+/* ldtoa.c provide long double floating point string conversion routines.
+
+Copyright (C) 2009-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+#include "ansidecl.h"
+
+#include "gm2-libs-host.h"
+#include "m2rts.h"
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+#define MAX_FP_DIGITS 500
+
+typedef enum Mode { maxsignicant, decimaldigits } Mode;
+
+extern int dtoa_calcmaxsig (char *p, int ndigits);
+extern int dtoa_calcdecimal (char *p, int str_size, int ndigits);
+extern int dtoa_calcsign (char *p, int str_size);
+
+/* maxsignicant: return a string containing max(1,ndigits)
+ significant digits. The return string contains the string
+ produced by snprintf. decimaldigits: return a string produced by
+ fcvt. The string will contain ndigits past the decimal point
+ (ndigits may be negative). */
+
+long double
+ldtoa_strtold (const char *s, int *error)
+{
+ char *endp;
+ long double d;
+
+ errno = 0;
+#if defined(HAVE_STRTOLD)
+ d = strtold (s, &endp);
+#else
+ /* fall back to using strtod. */
+ d = (long double)strtod (s, &endp);
+#endif
+ if (endp != NULL && (*endp == '\0'))
+ *error = (errno != 0);
+ else
+ *error = TRUE;
+ return d;
+}
+
+char *
+ldtoa_ldtoa (long double d, int mode, int ndigits, int *decpt, int *sign)
+{
+ char format[50];
+ char *p;
+ int r;
+ switch (mode)
+ {
+
+ case maxsignicant:
+ ndigits += 20; /* enough for exponent. */
+ p = (char *) malloc (ndigits);
+ snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "LE");
+ snprintf (p, ndigits, format, d);
+ *sign = dtoa_calcsign (p, ndigits);
+ *decpt = dtoa_calcmaxsig (p, ndigits);
+ return p;
+ case decimaldigits:
+ p = (char *) malloc (MAX_FP_DIGITS + 20);
+ snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "LE");
+ snprintf (p, MAX_FP_DIGITS + 20, format, d);
+ *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
+ *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ return p;
+ default:
+ abort ();
+ }
+}
+
+/* GNU Modula-2 hooks */
+
+void
+_M2_ldtoa_init (int, char **, char **)
+{
+}
+
+void
+_M2_ldtoa_finish (int, char **, char **)
+{
+}
+
+void
+_M2_ldtoa_dep (void)
+{
+}
+
+# ifdef __cplusplus
+}
+
+struct _M2_ldtoa_ctor { _M2_ldtoa_ctor (); } _M2_ldtoa_ctor;
+
+_M2_ldtoa_ctor::_M2_ldtoa_ctor (void)
+{
+ M2RTS_RegisterModule ("ldtoa", _M2_ldtoa_init, _M2_ldtoa_finish,
+ _M2_ldtoa_dep);
+}
+
+#else
+void
+_M2_ldtoa_ctor (void)
+{
+}
+
+# endif
diff --git a/gcc/m2/gm2-libs-ch/m2rts.h b/gcc/m2/gm2-libs-ch/m2rts.h
new file mode 100644
index 00000000000..57e6e90d94d
--- /dev/null
+++ b/gcc/m2/gm2-libs-ch/m2rts.h
@@ -0,0 +1,41 @@
+/* m2rts.h provides a C interface to M2RTS.mod.
+
+Copyright (C) 2019-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+
+typedef void (*proc_con) (int, char **, char **);
+typedef void (*proc_dep) (void);
+
+extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy);
+extern "C" void M2RTS_RegisterModule (const char *modulename,
+ proc_con init, proc_con fini, proc_dep dependencies);
+extern "C" void _M2_M2RTS_init (void);
+
+extern "C" void M2RTS_ConstructModules (const char *,
+ int argc, char *argv[], char *envp[]);
+extern "C" void M2RTS_Terminate (void);
+extern "C" void M2RTS_DeconstructModules (void);
+
+extern "C" void M2RTS_Halt (const char *, int, const char *, const char *) __attribute__ ((noreturn));
diff --git a/gcc/m2/gm2-libs/M2Dependent.def b/gcc/m2/gm2-libs/M2Dependent.def
new file mode 100644
index 00000000000..a7c18159b12
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2Dependent.def
@@ -0,0 +1,62 @@
+(* M2Dependent.def defines the run time module dependencies interface.
+
+Copyright (C) 2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
+
+DEFINITION MODULE M2Dependent ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+ ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
+
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
+
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
+
+
+(*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+ init, fini: ArgCVEnvP;
+ dependencies: PROC) ;
+
+
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+
+
+END M2Dependent.
diff --git a/gcc/m2/gm2-libs/M2Dependent.mod b/gcc/m2/gm2-libs/M2Dependent.mod
new file mode 100644
index 00000000000..3780cdb33bd
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2Dependent.mod
@@ -0,0 +1,791 @@
+(* M2Dependent.mod implements the run time module dependencies.
+
+Copyright (C) 2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
+
+IMPLEMENTATION MODULE M2Dependent ;
+
+
+FROM libc IMPORT abort, exit, write, getenv, printf ;
+(* FROM Builtins IMPORT strncmp, strcmp ; not available during bootstrap. *)
+FROM M2LINK IMPORT ForcedModuleInitOrder, StaticInitialization, PtrToChar ;
+FROM ASCII IMPORT nul, nl ;
+FROM SYSTEM IMPORT ADR ;
+FROM Storage IMPORT ALLOCATE ;
+FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
+
+IMPORT M2RTS ;
+
+
+TYPE
+ DependencyState = (unregistered, unordered, started, ordered, user) ;
+
+ DependencyList = RECORD
+ proc : PROC ;
+ (* Has this module order been forced by the user? *)
+ forced,
+ (* Is the module a definition module for C? *)
+ forc : BOOLEAN ;
+ appl : BOOLEAN ; (* The application module? *)
+ state : DependencyState ;
+ END ;
+
+ ModuleChain = POINTER TO RECORD
+ name : ADDRESS ;
+ init,
+ fini : ArgCVEnvP ;
+ dependency: DependencyList ;
+ prev,
+ next : ModuleChain ;
+ END ;
+
+VAR
+ Modules : ARRAY DependencyState OF ModuleChain ;
+ Initialized,
+ ModuleTrace,
+ DependencyTrace,
+ PreTrace,
+ PostTrace,
+ ForceTrace : BOOLEAN ;
+
+
+(*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*)
+
+PROCEDURE CreateModule (name: ADDRESS;
+ init, fini: ArgCVEnvP;
+ dependencies: PROC) : ModuleChain ;
+VAR
+ mptr: ModuleChain ;
+BEGIN
+ NEW (mptr) ;
+ mptr^.name := name ;
+ mptr^.init := init ;
+ mptr^.fini := fini ;
+ mptr^.dependency.proc := dependencies ;
+ mptr^.dependency.state := unregistered ;
+ mptr^.prev := NIL ;
+ mptr^.next := NIL ;
+ RETURN mptr
+END CreateModule ;
+
+
+(*
+ AppendModule - append chain to end of the list.
+*)
+
+PROCEDURE AppendModule (VAR head: ModuleChain; chain: ModuleChain) ;
+BEGIN
+ IF head = NIL
+ THEN
+ head := chain ;
+ chain^.prev := chain ;
+ chain^.next := chain
+ ELSE
+ chain^.next := head ; (* Add Item to the end of list. *)
+ chain^.prev := head^.prev ;
+ head^.prev^.next := chain ;
+ head^.prev := chain
+ END
+END AppendModule ;
+
+
+(*
+ RemoveModule - remove chain from double linked list head.
+*)
+
+PROCEDURE RemoveModule (VAR head: ModuleChain; chain: ModuleChain) ;
+BEGIN
+ IF (chain^.next=head) AND (chain=head)
+ THEN
+ head := NIL
+ ELSE
+ IF head=chain
+ THEN
+ head := head^.next
+ END ;
+ chain^.prev^.next := chain^.next ;
+ chain^.next^.prev := chain^.prev
+ END
+END RemoveModule ;
+
+
+(*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*)
+
+PROCEDURE onChain (state: DependencyState; mptr: ModuleChain) : BOOLEAN ;
+VAR
+ ptr: ModuleChain ;
+BEGIN
+ IF Modules[state] # NIL
+ THEN
+ ptr := Modules[state] ;
+ REPEAT
+ IF ptr = mptr
+ THEN
+ RETURN TRUE
+ END ;
+ ptr := ptr^.next
+ UNTIL ptr=Modules[state]
+ END ;
+ RETURN FALSE
+END onChain ;
+
+
+(*
+ LookupModuleN - lookup module from the state list. The string is limited
+ to nchar.
+*)
+
+PROCEDURE LookupModuleN (state: DependencyState;
+ name: ADDRESS; nchar: CARDINAL) : ModuleChain ;
+VAR
+ ptr: ModuleChain ;
+BEGIN
+ IF Modules[state] # NIL
+ THEN
+ ptr := Modules[state] ;
+ REPEAT
+ IF strncmp (ptr^.name, name, nchar) = 0
+ THEN
+ RETURN ptr
+ END ;
+ ptr := ptr^.next
+ UNTIL ptr = Modules[state]
+ END ;
+ RETURN NIL
+END LookupModuleN ;
+
+
+(*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*)
+
+PROCEDURE LookupModule (state: DependencyState; name: ADDRESS) : ModuleChain ;
+BEGIN
+ RETURN LookupModuleN (state, name, strlen (name))
+END LookupModule ;
+
+
+(*
+ toCString - replace any character sequence \n into a newline.
+*)
+
+PROCEDURE toCString (VAR str: ARRAY OF CHAR) ;
+VAR
+ high, i, j: CARDINAL ;
+BEGIN
+ i := 0 ;
+ high := HIGH (str) ;
+ WHILE i < high DO
+ IF (str[i] = "\") AND (i < high)
+ THEN
+ IF str[i+1] = "n"
+ THEN
+ str[i] := nl ;
+ j := i+1 ;
+ WHILE j < high DO
+ str[j] := str[j+1] ;
+ INC (j)
+ END
+ END
+ END ;
+ INC (i)
+ END
+END toCString ;
+
+
+(*
+ strcmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*)
+
+PROCEDURE strcmp (a, b: PtrToChar) : INTEGER ;
+BEGIN
+ IF (a # NIL) AND (b # NIL)
+ THEN
+ IF a = b
+ THEN
+ RETURN 0
+ ELSE
+ WHILE a^ = b^ DO
+ IF a^ = nul
+ THEN
+ RETURN 0
+ END ;
+ INC (a) ;
+ INC (b)
+ END
+ END
+ END ;
+ RETURN 1
+END strcmp ;
+
+
+(*
+ strncmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*)
+
+PROCEDURE strncmp (a, b: PtrToChar; n: CARDINAL) : INTEGER ;
+BEGIN
+ IF (a # NIL) AND (b # NIL) AND (n > 0)
+ THEN
+ IF a = b
+ THEN
+ RETURN 0
+ ELSE
+ WHILE (a^ = b^) AND (n > 0) DO
+ IF (a^ = nul) OR (n = 1)
+ THEN
+ RETURN 0
+ END ;
+ INC (a) ;
+ INC (b) ;
+ DEC (n)
+ END
+ END
+ END ;
+ RETURN 1
+END strncmp ;
+
+
+(*
+ strlen - returns the length of string.
+*)
+
+PROCEDURE strlen (string: PtrToChar) : INTEGER ;
+VAR
+ count: INTEGER ;
+BEGIN
+ IF string = NIL
+ THEN
+ RETURN 0
+ ELSE
+ count := 0 ;
+ WHILE string^ # nul DO
+ INC (string) ;
+ INC (count)
+ END ;
+ RETURN count
+ END
+END strlen ;
+
+
+(*
+ traceprintf - wrap printf with a boolean flag.
+*)
+
+PROCEDURE traceprintf (flag: BOOLEAN; str: ARRAY OF CHAR) ;
+BEGIN
+ IF flag
+ THEN
+ toCString (str) ;
+ printf (str)
+ END
+END traceprintf ;
+
+
+(*
+ traceprintf2 - wrap printf with a boolean flag.
+*)
+
+PROCEDURE traceprintf2 (flag: BOOLEAN; str: ARRAY OF CHAR; arg: ADDRESS) ;
+BEGIN
+ IF flag
+ THEN
+ toCString (str) ;
+ printf (str, arg)
+ END
+END traceprintf2 ;
+
+
+(*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*)
+
+PROCEDURE moveTo (newstate: DependencyState; mptr: ModuleChain) ;
+BEGIN
+ IF onChain (mptr^.dependency.state, mptr)
+ THEN
+ RemoveModule (Modules[mptr^.dependency.state], mptr)
+ END ;
+ mptr^.dependency.state := newstate ;
+ AppendModule (Modules[mptr^.dependency.state], mptr)
+END moveTo ;
+
+
+(*
+ ResolveDependant -
+*)
+
+PROCEDURE ResolveDependant (mptr: ModuleChain; currentmodule: ADDRESS) ;
+BEGIN
+ IF mptr = NIL
+ THEN
+ traceprintf (DependencyTrace, " module has not been registered via a global constructor\n");
+ ELSE
+ IF onChain (started, mptr)
+ THEN
+ traceprintf (DependencyTrace, " processing...\n");
+ ELSE
+ moveTo (started, mptr) ;
+ traceprintf2 (DependencyTrace, " starting: %s\n",
+ currentmodule);
+ mptr^.dependency.proc ; (* Invoke and process the dependency graph. *)
+ traceprintf2 (DependencyTrace, " finished: %s\n",
+ currentmodule);
+ moveTo (ordered, mptr)
+ END
+ END
+END ResolveDependant ;
+
+
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*)
+
+PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+BEGIN
+ CheckInitialized ;
+ IF NOT StaticInitialization
+ THEN
+ PerformRequestDependant (modulename, dependantmodule)
+ END
+END RequestDependant ;
+
+
+(*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*)
+
+PROCEDURE PerformRequestDependant (modulename, dependantmodule: ADDRESS) ;
+VAR
+ mptr: ModuleChain ;
+BEGIN
+ traceprintf2 (DependencyTrace, " module %s", modulename) ;
+ IF dependantmodule = NIL
+ THEN
+ traceprintf2 (DependencyTrace, " has finished its import graph\n", modulename) ;
+ mptr := LookupModule (unordered, modulename) ;
+ IF mptr # NIL
+ THEN
+ traceprintf2 (DependencyTrace, " module %s is now ordered\n", modulename) ;
+ moveTo (ordered, mptr)
+ END
+ ELSE
+ traceprintf2 (DependencyTrace, " imports from %s\n", dependantmodule) ;
+ mptr := LookupModule (ordered, dependantmodule) ;
+ IF mptr = NIL
+ THEN
+ traceprintf2 (DependencyTrace, " module %s is not ordered\n", dependantmodule) ;
+ mptr := LookupModule (unordered, dependantmodule) ;
+ IF mptr = NIL
+ THEN
+ traceprintf2 (DependencyTrace, " module %s is not unordered\n", dependantmodule) ;
+ mptr := LookupModule (started, dependantmodule) ;
+ IF mptr = NIL
+ THEN
+ traceprintf2 (DependencyTrace, " module %s has not started\n", dependantmodule) ;
+ traceprintf2 (DependencyTrace, " module %s attempting to import from",
+ modulename) ;
+ traceprintf2 (DependencyTrace, " %s which has not registered itself via a constructor\n",
+ dependantmodule)
+ ELSE
+ traceprintf2 (DependencyTrace, " module %s has registered itself and has started\n", dependantmodule)
+ END
+ ELSE
+ traceprintf2 (DependencyTrace, " module %s resolving\n", dependantmodule) ;
+ ResolveDependant (mptr, dependantmodule)
+ END
+ ELSE
+ traceprintf2 (DependencyTrace, " module %s ", modulename) ;
+ traceprintf2 (DependencyTrace, " dependant %s is ordered\n", dependantmodule)
+ END
+ END
+END PerformRequestDependant ;
+
+
+(*
+ ResolveDependencies - resolve dependencies for currentmodule.
+*)
+
+PROCEDURE ResolveDependencies (currentmodule: ADDRESS) ;
+VAR
+ mptr: ModuleChain ;
+BEGIN
+ mptr := LookupModule (unordered, currentmodule) ;
+ WHILE mptr # NIL DO
+ traceprintf2 (DependencyTrace, " attempting to resolve the dependants for %s\n",
+ currentmodule);
+ ResolveDependant (mptr, currentmodule) ;
+ mptr := Modules[unordered]
+ END
+END ResolveDependencies ;
+
+
+(*
+ DisplayModuleInfo - displays all module in the state.
+*)
+
+PROCEDURE DisplayModuleInfo (state: DependencyState; name: ARRAY OF CHAR) ;
+VAR
+ mptr: ModuleChain ;
+BEGIN
+ IF Modules[state] # NIL
+ THEN
+ printf ("%s modules\n", ADR (name)) ;
+ mptr := Modules[state] ;
+ REPEAT
+ printf (" %s", mptr^.name) ;
+ IF mptr^.dependency.appl
+ THEN
+ printf (" application")
+ END ;
+ IF mptr^.dependency.forc
+ THEN
+ printf (" for C")
+ END ;
+ IF mptr^.dependency.forced
+ THEN
+ printf (" forced ordering")
+ END ;
+ printf ("\n") ;
+ mptr := mptr^.next ;
+ UNTIL mptr = Modules[state]
+ END
+END DisplayModuleInfo ;
+
+
+(*
+ DumpModuleData -
+*)
+
+PROCEDURE DumpModuleData (flag: BOOLEAN) ;
+VAR
+ mptr: ModuleChain ;
+BEGIN
+ IF flag
+ THEN
+ DisplayModuleInfo (unregistered, "unregistered") ;
+ DisplayModuleInfo (unordered, "unordered") ;
+ DisplayModuleInfo (started, "started") ;
+ DisplayModuleInfo (ordered, "ordered") ;
+ END
+END DumpModuleData ;
+
+
+(*
+ combine - dest := src + dest. Places src at the front of list dest.
+ Pre condition: src, dest are lists.
+ Post condition : dest := src + dest
+ src := NIL.
+*)
+
+PROCEDURE combine (src, dest: DependencyState) ;
+VAR
+ last: ModuleChain ;
+BEGIN
+ WHILE Modules[src] # NIL DO
+ last := Modules[src]^.prev ;
+ moveTo (ordered, last) ;
+ Modules[dest] := last (* New item is at the head. *)
+ END
+END combine ;
+
+
+(*
+ ForceDependencies - if the user has specified a forced order then we override
+ the dynamic ordering with the preference.
+*)
+
+PROCEDURE ForceDependencies ;
+VAR
+ mptr,
+ userChain: ModuleChain ;
+ count : CARDINAL ;
+ pc, start: PtrToChar ;
+BEGIN
+ IF ForcedModuleInitOrder # NIL
+ THEN
+ userChain := NIL ;
+ pc := ForcedModuleInitOrder ;
+ start := pc ;
+ count := 0 ;
+ WHILE pc^ # nul DO
+ IF pc^ = ','
+ THEN
+ mptr := LookupModuleN (ordered, start, count) ;
+ IF mptr # NIL
+ THEN
+ moveTo (user, mptr)
+ END ;
+ INC (pc) ;
+ start := pc ;
+ count := 0
+ ELSE
+ INC (pc) ;
+ INC (count)
+ END
+ END ;
+ IF start # pc
+ THEN
+ mptr := LookupModuleN (ordered, start, count) ;
+ IF mptr # NIL
+ THEN
+ moveTo (user, mptr)
+ END
+ END ;
+ combine (user, ordered)
+ END
+END ForceDependencies ;
+
+
+(*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*)
+
+PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
+VAR
+ mptr: ModuleChain ;
+ nulp: ArgCVEnvP ;
+BEGIN
+ CheckInitialized ;
+ traceprintf2 (ModuleTrace, "application module: %s\n", applicationmodule);
+ mptr := LookupModule (unordered, applicationmodule) ;
+ IF mptr # NIL
+ THEN
+ mptr^.dependency.appl := TRUE
+ END ;
+ traceprintf (PreTrace, "Pre resolving dependents\n");
+ DumpModuleData (PreTrace) ;
+ ResolveDependencies (applicationmodule) ;
+ traceprintf (PreTrace, "Post resolving dependents\n");
+ DumpModuleData (PostTrace) ;
+ ForceDependencies ;
+ traceprintf (ForceTrace, "After user forcing ordering\n");
+ DumpModuleData (ForceTrace) ;
+ IF Modules[ordered] = NIL
+ THEN
+ traceprintf2 (ModuleTrace, " module: %s has not registered itself using a global constructor\n", applicationmodule);
+ traceprintf2 (ModuleTrace, " hint try compile and linking using: gm2 %s.mod\n", applicationmodule);
+ traceprintf2 (ModuleTrace, " or try using: gm2 -fscaffold-static %s.mod\n",
+ applicationmodule);
+ ELSE
+ mptr := Modules[ordered] ;
+ REPEAT
+ IF mptr^.dependency.forc
+ THEN
+ traceprintf2 (ModuleTrace, "initializing module: %s for C\n", mptr^.name);
+ ELSE
+ traceprintf2 (ModuleTrace, "initializing module: %s\n", mptr^.name);
+ END ;
+ IF mptr^.dependency.appl
+ THEN
+ traceprintf2 (ModuleTrace, "application module: %s\n", mptr^.name);
+ traceprintf (ModuleTrace, " calling M2RTS_ExecuteInitialProcedures\n");
+ M2RTS.ExecuteInitialProcedures ;
+ traceprintf (ModuleTrace, " calling application module\n");
+ END ;
+ mptr^.init (argc, argv, envp) ;
+ mptr := mptr^.next
+ UNTIL mptr = Modules[ordered]
+ END
+END ConstructModules ;
+
+
+(*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*)
+
+PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+ argc: INTEGER; argv, envp: ADDRESS) ;
+VAR
+ mptr: ModuleChain ;
+BEGIN
+ traceprintf2 (ModuleTrace, "application module finishing: %s\n", applicationmodule);
+ IF Modules[ordered] = NIL
+ THEN
+ traceprintf (ModuleTrace, " no ordered modules found during finishing\n")
+ ELSE
+ traceprintf (ModuleTrace, "ExecuteTerminationProcedures\n") ;
+ M2RTS.ExecuteTerminationProcedures ;
+ traceprintf (ModuleTrace, "terminating modules in sequence\n") ;
+ mptr := Modules[ordered]^.prev ;
+ REPEAT
+ IF mptr^.dependency.forc
+ THEN
+ traceprintf2 (ModuleTrace, "finalizing module: %s for C\n", mptr^.name);
+ ELSE
+ traceprintf2 (ModuleTrace, "finalizing module: %s\n", mptr^.name);
+ END ;
+ mptr^.fini (argc, argv, envp) ;
+ mptr := mptr^.prev
+ UNTIL mptr = Modules[ordered]^.prev
+ END
+END DeconstructModules ;
+
+
+(*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name: ADDRESS;
+ init, fini: ArgCVEnvP;
+ dependencies: PROC) ;
+BEGIN
+ CheckInitialized ;
+ IF NOT StaticInitialization
+ THEN
+ traceprintf2 (ModuleTrace, "module: %s registering\n",
+ name);
+ moveTo (unordered,
+ CreateModule (name, init, fini, dependencies))
+ END
+END RegisterModule ;
+
+
+(*
+ equal - return TRUE if C string cstr is equal to str.
+*)
+
+PROCEDURE equal (cstr: ADDRESS; str: ARRAY OF CHAR) : BOOLEAN ;
+BEGIN
+ RETURN strncmp (cstr, ADR (str), StrLen (str)) = 0
+END equal ;
+
+
+(*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved dynamically.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*)
+
+PROCEDURE SetupDebugFlags ;
+VAR
+ pc: POINTER TO CHAR ;
+BEGIN
+ ModuleTrace := FALSE ;
+ DependencyTrace := FALSE ;
+ PostTrace := FALSE ;
+ PreTrace := FALSE ;
+ pc := getenv (ADR ("GCC_M2LINK_RTFLAG")) ;
+ WHILE (pc # NIL) AND (pc^ # nul) DO
+ IF equal (pc, "all")
+ THEN
+ ModuleTrace := TRUE ;
+ DependencyTrace := TRUE ;
+ PreTrace := TRUE ;
+ PostTrace := TRUE ;
+ ForceTrace := TRUE ;
+ INC (pc, 3)
+ ELSIF equal (pc, "module")
+ THEN
+ ModuleTrace := TRUE ;
+ INC (pc, 6)
+ ELSIF equal (pc, "dep")
+ THEN
+ DependencyTrace := TRUE ;
+ INC (pc, 3)
+ ELSIF equal (pc, "pre")
+ THEN
+ PreTrace := TRUE ;
+ INC (pc, 3)
+ ELSIF equal (pc, "post")
+ THEN
+ PostTrace := TRUE ;
+ INC (pc, 4)
+ ELSIF equal (pc, "force")
+ THEN
+ ForceTrace := TRUE ;
+ INC (pc, 5)
+ ELSE
+ INC (pc)
+ END
+ END
+END SetupDebugFlags ;
+
+
+(*
+ Init - initialize the debug flags and set all lists to NIL.
+*)
+
+PROCEDURE Init ;
+VAR
+ state: DependencyState ;
+BEGIN
+ SetupDebugFlags ;
+ FOR state := MIN (DependencyState) TO MAX (DependencyState) DO
+ Modules[state] := NIL
+ END
+END Init ;
+
+
+(*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*)
+
+PROCEDURE CheckInitialized ;
+BEGIN
+ IF NOT Initialized
+ THEN
+ Initialized := TRUE ;
+ Init
+ END
+END CheckInitialized ;
+
+
+BEGIN
+ CheckInitialized
+END M2Dependent.
diff --git a/gcc/m2/gm2-libs/M2LINK.def b/gcc/m2/gm2-libs/M2LINK.def
new file mode 100644
index 00000000000..409142a2af5
--- /dev/null
+++ b/gcc/m2/gm2-libs/M2LINK.def
@@ -0,0 +1,41 @@
+(* M2LINK.def defines the linking mode used in Modula-2.
+
+Copyright (C) 2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
+
+DEFINITION MODULE FOR "C" M2LINK ;
+
+
+TYPE
+ PtrToChar = POINTER TO CHAR ;
+
+(* These variables are set by the compiler in the program module
+ according to linking command line options. *)
+
+VAR
+ ForcedModuleInitOrder: PtrToChar ;
+ StaticInitialization : BOOLEAN ;
+
+
+END M2LINK.
diff --git a/gcc/m2/mc-boot-ch/GM2LINK.c b/gcc/m2/mc-boot-ch/GM2LINK.c
new file mode 100644
index 00000000000..302f219ed5f
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/GM2LINK.c
@@ -0,0 +1,27 @@
+/* GM2LINK.c a handwritten module for mc.
+
+Copyright (C) 2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaiusmod2@gmail.com>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+/* mc currently is built using a static scaffold. */
+
+#include <cstddef>
+
+int M2LINK_StaticInitialization = 1;
+char *M2LINK_ForcedModuleInitOrder = NULL;
diff --git a/gcc/m2/mc-boot-ch/GUnixArgs.cc b/gcc/m2/mc-boot-ch/GUnixArgs.cc
new file mode 100644
index 00000000000..1180f351b24
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/GUnixArgs.cc
@@ -0,0 +1,91 @@
+/* UnixArgs.cc record argc, argv as global variables.
+
+Copyright (C) 2009-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+#include "m2rts.h"
+
+
+extern "C" int UnixArgs_GetArgC (void);
+extern "C" char **UnixArgs_GetArgV (void);
+extern "C" char **UnixArgs_GetEnvV (void);
+
+static int UnixArgs_ArgC;
+static char **UnixArgs_ArgV;
+static char **UnixArgs_EnvV;
+
+
+/* GetArgC returns argc. */
+
+extern "C" int
+UnixArgs_GetArgC (void)
+{
+ return UnixArgs_ArgC;
+}
+
+
+/* GetArgV returns argv. */
+
+extern "C" char **
+UnixArgs_GetArgV (void)
+{
+ return UnixArgs_ArgV;
+}
+
+
+/* GetEnvV returns envv. */
+
+extern "C" char **
+UnixArgs_GetEnvV (void)
+{
+ return UnixArgs_EnvV;
+}
+
+
+extern "C" void
+_M2_UnixArgs_init (int argc, char *argv[], char *envp[])
+{
+ UnixArgs_ArgC = argc;
+ UnixArgs_ArgV = argv;
+ UnixArgs_EnvV = envp;
+}
+
+extern "C" void
+_M2_UnixArgs_finish (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_UnixArgs_dep (void)
+{
+}
+
+struct _M2_UnixArgs_ctor { _M2_UnixArgs_ctor (); } _M2_UnixArgs_ctor;
+
+_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
+{
+ M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_finish,
+ _M2_UnixArgs_dep);
+}
diff --git a/gcc/m2/mc-boot-ch/Gtermios.cc b/gcc/m2/mc-boot-ch/Gtermios.cc
new file mode 100644
index 00000000000..5982b5f9ea2
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gtermios.cc
@@ -0,0 +1,1947 @@
+/* Gtermios.c handwritten module for mc.
+
+Copyright (C) 2010-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+
+#include "gm2-libs-host.h"
+
+#ifdef HAVE_TERMIOS_H
+# include <termios.h>
+#endif
+
+#ifdef TERMIOS_NEEDS_XOPEN_SOURCE
+#define _XOPEN_SOURCE
+#endif
+
+#if defined(__cplusplus)
+#define EXTERN extern "C"
+#else
+#define EXTERN
+#endif
+
+#define EXPORT(X) termios##_##X
+
+typedef enum {
+ vintr,
+ vquit,
+ verase,
+ vkill,
+ veof,
+ vtime,
+ vmin,
+ vswtc,
+ vstart,
+ vstop,
+ vsusp,
+ veol,
+ vreprint,
+ vdiscard,
+ vwerase,
+ vlnext,
+ veol2
+} ControlChar;
+
+typedef enum {
+ /* input flag bits. */
+ ignbrk,
+ ibrkint,
+ ignpar,
+ iparmrk,
+ inpck,
+ istrip,
+ inlcr,
+ igncr,
+ icrnl,
+ iuclc,
+ ixon,
+ ixany,
+ ixoff,
+ imaxbel,
+ /* output flag bits. */
+ opost,
+ olcuc,
+ onlcr,
+ ocrnl,
+ onocr,
+ onlret,
+ ofill,
+ ofdel,
+ onl0,
+ onl1,
+ ocr0,
+ ocr1,
+ ocr2,
+ ocr3,
+ otab0,
+ otab1,
+ otab2,
+ otab3,
+ obs0,
+ obs1,
+ off0,
+ off1,
+ ovt0,
+ ovt1,
+ /* baud rate. */
+ b0,
+ b50,
+ b75,
+ b110,
+ b135,
+ b150,
+ b200,
+ b300,
+ b600,
+ b1200,
+ b1800,
+ b2400,
+ b4800,
+ b9600,
+ b19200,
+ b38400,
+ b57600,
+ b115200,
+ b240400,
+ b460800,
+ b500000,
+ b576000,
+ b921600,
+ b1000000,
+ b1152000,
+ b1500000,
+ b2000000,
+ b2500000,
+ b3000000,
+ b3500000,
+ b4000000,
+ maxbaud,
+ crtscts,
+ /* character size. */
+ cs5,
+ cs6,
+ cs7,
+ cs8,
+ cstopb,
+ cread,
+ parenb,
+ parodd,
+ hupcl,
+ clocal,
+ /* local flags. */
+ lisig,
+ licanon,
+ lxcase,
+ lecho,
+ lechoe,
+ lechok,
+ lechonl,
+ lnoflsh,
+ ltopstop,
+ lechoctl,
+ lechoprt,
+ lechoke,
+ lflusho,
+ lpendin,
+ liexten
+} Flag;
+
+int
+doSetUnset (unsigned int *bitset, unsigned int mask, int value)
+{
+ if (value)
+ (*bitset) |= mask;
+ else
+ (*bitset) &= (~mask);
+ return 1;
+}
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* InitTermios - new data structure. */
+
+void *
+EXPORT (InitTermios) (void)
+{
+ struct termios *p = (struct termios *)malloc (sizeof (struct termios));
+
+ memset (p, 0, sizeof (struct termios));
+ return p;
+}
+
+/* KillTermios - delete data structure. */
+
+void *
+EXPORT (KillTermios) (struct termios *p)
+{
+ free (p);
+ return NULL;
+}
+
+/* tcsnow - return the value of TCSANOW. */
+
+int
+EXPORT (tcsnow) (void)
+{
+ return TCSANOW;
+}
+
+/* tcsdrain - return the value of TCSADRAIN. */
+
+int
+EXPORT (tcsdrain) (void)
+{
+ return TCSADRAIN;
+}
+
+/* tcsflush - return the value of TCSAFLUSH. */
+
+int
+EXPORT (tcsflush) (void)
+{
+ return TCSAFLUSH;
+}
+
+/* cfgetospeed - return output baud rate. */
+
+int
+EXPORT (cfgetospeed) (struct termios *t)
+{
+ return cfgetospeed (t);
+}
+
+/* cfgetispeed - return input baud rate. */
+
+int
+EXPORT (cfgetispeed) (struct termios *t)
+{
+ return cfgetispeed (t);
+}
+
+/* cfsetospeed - set output baud rate. */
+
+int
+EXPORT (cfsetospeed) (struct termios *t, unsigned int b)
+{
+ return cfsetospeed (t, b);
+}
+
+/* cfsetispeed - set input baud rate. */
+
+int
+EXPORT (cfsetispeed) (struct termios *t, unsigned int b)
+{
+ return cfsetispeed (t, b);
+}
+
+/* cfsetspeed - set input and output baud rate. */
+
+int
+EXPORT (cfsetspeed) (struct termios *t, unsigned int b)
+{
+ int val = cfsetispeed (t, b);
+ if (val == 0)
+ return cfsetospeed (t, b);
+ cfsetospeed (t, b);
+ return val;
+}
+
+/* tcgetattr - get state of, fd, into, t. */
+
+int
+EXPORT (tcgetattr) (int fd, struct termios *t)
+{
+ return tcgetattr (fd, t);
+}
+
+/* tcsetattr - set state of, fd, to, t, using option. */
+
+int
+EXPORT (tcsetattr) (int fd, int option, struct termios *t)
+{
+ return tcsetattr (fd, option, t);
+}
+
+/* cfmakeraw - sets the terminal to raw mode. */
+
+void
+EXPORT (cfmakeraw) (struct termios *t)
+{
+#if defined(HAVE_CFMAKERAW)
+ return cfmakeraw (t);
+#endif
+}
+
+/* tcsendbreak - send zero bits for duration. */
+
+int
+EXPORT (tcsendbreak) (int fd, int duration)
+{
+ return tcsendbreak (fd, duration);
+}
+
+/* tcdrain - waits for pending output to be written on, fd. */
+
+int
+EXPORT (tcdrain) (int fd)
+{
+ return tcdrain (fd);
+}
+
+/* tcflushi - flush input. */
+
+int
+EXPORT (tcflushi) (int fd)
+{
+#if defined(TCIFLUSH)
+ return tcflush (fd, TCIFLUSH);
+#else
+ return 1;
+#endif
+}
+
+/* tcflusho - flush output. */
+
+int
+EXPORT (tcflusho) (int fd)
+{
+#if defined(TCOFLUSH)
+ return tcflush (fd, TCOFLUSH);
+#else
+ return 1;
+#endif
+}
+
+/* tcflushio - flush input and output. */
+
+int
+EXPORT (tcflushio) (int fd)
+{
+#if defined(TCIOFLUSH)
+ return tcflush (fd, TCIOFLUSH);
+#else
+ return 1;
+#endif
+}
+
+/* tcflowoni - restart input on, fd. */
+
+int
+EXPORT (tcflowoni) (int fd)
+{
+#if defined(TCION)
+ return tcflow (fd, TCION);
+#else
+ return 1;
+#endif
+}
+
+/* tcflowoffi - stop input on, fd. */
+
+int
+EXPORT (tcflowoffi) (int fd)
+{
+#if defined(TCIOFF)
+ return tcflow (fd, TCIOFF);
+#else
+ return 1;
+#endif
+}
+
+/* tcflowono - restart output on, fd. */
+
+int
+EXPORT (tcflowono) (int fd)
+{
+#if defined(TCOON)
+ return tcflow (fd, TCOON);
+#else
+ return 1;
+#endif
+}
+
+/* tcflowoffo - stop output on, fd. */
+
+int
+EXPORT (tcflowoffo) (int fd)
+{
+#if defined(TCOOFF)
+ return tcflow (fd, TCOOFF);
+#else
+ return 1;
+#endif
+}
+
+/* GetFlag - sets a flag value from, t, in, b, and returns TRUE if,
+ t, supports, f. */
+
+int
+EXPORT (GetFlag) (struct termios *t, Flag f, int *b)
+{
+ switch (f)
+ {
+
+ case ignbrk:
+#if defined(IGNBRK)
+ *b = ((t->c_iflag & IGNBRK) == IGNBRK);
+ return 1;
+#else
+ return 0;
+#endif
+ case ibrkint:
+#if defined(BRKINT)
+ *b = ((t->c_iflag & BRKINT) == BRKINT);
+ return 1;
+#else
+ return 0;
+#endif
+ case ignpar:
+#if defined(IGNPAR)
+ *b = ((t->c_iflag & IGNPAR) == IGNPAR);
+ return 1;
+#else
+ return 0;
+#endif
+ case iparmrk:
+#if defined(PARMRK)
+ *b = ((t->c_iflag & PARMRK) == PARMRK);
+ return 1;
+#else
+ return 0;
+#endif
+ case inpck:
+#if defined(INPCK)
+ *b = ((t->c_iflag & INPCK) == INPCK);
+ return 1;
+#else
+ return 0;
+#endif
+ case istrip:
+#if defined(ISTRIP)
+ *b = ((t->c_iflag & ISTRIP) == ISTRIP);
+ return 1;
+#else
+ return 0;
+#endif
+ case inlcr:
+#if defined(INLCR)
+ *b = ((t->c_iflag & INLCR) == INLCR);
+ return 1;
+#else
+ return 0;
+#endif
+ case igncr:
+#if defined(IGNCR)
+ *b = ((t->c_iflag & IGNCR) == IGNCR);
+ return 1;
+#else
+ return 0;
+#endif
+ case icrnl:
+#if defined(ICRNL)
+ *b = ((t->c_iflag & ICRNL) == ICRNL);
+ return 1;
+#else
+ return 0;
+#endif
+ case iuclc:
+#if defined(IUCLC)
+ *b = ((t->c_iflag & IUCLC) == IUCLC);
+ return 1;
+#else
+ return 0;
+#endif
+ case ixon:
+#if defined(IXON)
+ *b = ((t->c_iflag & IXON) == IXON);
+ return 1;
+#else
+ return 0;
+#endif
+ case ixany:
+#if defined(IXANY)
+ *b = ((t->c_iflag & IXANY) == IXANY);
+ return 1;
+#else
+ return 0;
+#endif
+ case ixoff:
+#if defined(IXOFF)
+ *b = ((t->c_iflag & IXOFF) == IXOFF);
+ return 1;
+#else
+ return 0;
+#endif
+ case imaxbel:
+#if defined(IMAXBEL)
+ *b = ((t->c_iflag & IMAXBEL) == IMAXBEL);
+ return 1;
+#else
+ return 0;
+#endif
+ case opost:
+#if defined(OPOST)
+ *b = ((t->c_oflag & OPOST) == OPOST);
+ return 1;
+#else
+ return 0;
+#endif
+ case olcuc:
+#if defined(OLCUC)
+ *b = ((t->c_oflag & OLCUC) == OLCUC);
+ return 1;
+#else
+ return 0;
+#endif
+ case onlcr:
+#if defined(ONLCR)
+ *b = ((t->c_oflag & ONLCR) == ONLCR);
+ return 1;
+#else
+ return 0;
+#endif
+ case ocrnl:
+#if defined(OCRNL)
+ *b = ((t->c_oflag & OCRNL) == OCRNL);
+ return 1;
+#else
+ return 0;
+#endif
+ case onocr:
+#if defined(ONOCR)
+ *b = ((t->c_oflag & ONOCR) == ONOCR);
+ return 1;
+#else
+ return 0;
+#endif
+ case onlret:
+#if defined(ONLRET)
+ *b = ((t->c_oflag & ONLRET) == ONLRET);
+ return 1;
+#else
+ return 0;
+#endif
+ case ofill:
+#if defined(OFILL)
+ *b = ((t->c_oflag & OFILL) == OFILL);
+ return 1;
+#else
+ return 0;
+#endif
+ case ofdel:
+#if defined(OFDEL)
+ *b = ((t->c_oflag & OFDEL) == OFDEL);
+ return 1;
+#else
+ return 0;
+#endif
+ case onl0:
+#if defined(NL0)
+ *b = ((t->c_oflag & NL0) == NL0);
+ return 1;
+#else
+ return 0;
+#endif
+ case onl1:
+#if defined(NL1)
+ *b = ((t->c_oflag & NL1) == NL1);
+ return 1;
+#else
+ return 0;
+#endif
+ case ocr0:
+#if defined(CR0)
+ *b = ((t->c_oflag & CR0) == CR0);
+ return 1;
+#else
+ return 0;
+#endif
+ case ocr1:
+#if defined(CR1)
+ *b = ((t->c_oflag & CR1) == CR1);
+ return 1;
+#else
+ return 0;
+#endif
+ case ocr2:
+#if defined(CR2)
+ *b = ((t->c_oflag & CR2) == CR2);
+ return 1;
+#else
+ return 0;
+#endif
+ case ocr3:
+#if defined(CR3)
+ *b = ((t->c_oflag & CR3) == CR3);
+ return 1;
+#else
+ return 0;
+#endif
+ case otab0:
+#if defined(TAB0)
+ *b = ((t->c_oflag & TAB0) == TAB0);
+ return 1;
+#else
+ return 0;
+#endif
+ case otab1:
+#if defined(TAB1)
+ *b = ((t->c_oflag & TAB1) == TAB1);
+ return 1;
+#else
+ return 0;
+#endif
+ case otab2:
+#if defined(TAB2)
+ *b = ((t->c_oflag & TAB2) == TAB2);
+ return 1;
+#else
+ return 0;
+#endif
+ case otab3:
+#if defined(TAB3)
+ *b = ((t->c_oflag & TAB3) == TAB3);
+ return 1;
+#else
+ return 0;
+#endif
+ case obs0:
+#if defined(BS0)
+ *b = ((t->c_oflag & BS0) == BS0);
+ return 1;
+#else
+ return 0;
+#endif
+ case obs1:
+#if defined(BS1)
+ *b = ((t->c_oflag & BS1) == BS1);
+ return 1;
+#else
+ return 0;
+#endif
+ case off0:
+#if defined(FF0)
+ *b = ((t->c_oflag & FF0) == FF0);
+ return 1;
+#else
+ return 0;
+#endif
+ case off1:
+#if defined(FF1)
+ *b = ((t->c_oflag & FF1) == FF1);
+ return 1;
+#else
+ return 0;
+#endif
+ case ovt0:
+#if defined(VT0)
+ *b = ((t->c_oflag & VT0) == VT0);
+ return 1;
+#else
+ return 0;
+#endif
+ case ovt1:
+#if defined(VT1)
+ *b = ((t->c_oflag & VT1) == VT1);
+ return 1;
+#else
+ return 0;
+#endif
+ case b0:
+#if defined(B0)
+ *b = ((t->c_cflag & B0) == B0);
+ return 1;
+#else
+ return 0;
+#endif
+ case b50:
+#if defined(B50)
+ *b = ((t->c_cflag & B50) == B50);
+ return 1;
+#else
+ return 0;
+#endif
+ case b75:
+#if defined(B75)
+ *b = ((t->c_cflag & B75) == B75);
+ return 1;
+#else
+ return 0;
+#endif
+ case b110:
+#if defined(B110)
+ *b = ((t->c_cflag & B110) == B110);
+ return 1;
+#else
+ return 0;
+#endif
+ case b135:
+#if defined(B134)
+ *b = ((t->c_cflag & B134) == B134);
+ return 1;
+#else
+ return 0;
+#endif
+ case b150:
+#if defined(B150)
+ *b = ((t->c_cflag & B150) == B150);
+ return 1;
+#else
+ return 0;
+#endif
+ case b200:
+#if defined(B200)
+ *b = ((t->c_cflag & B200) == B200);
+ return 1;
+#else
+ return 0;
+#endif
+ case b300:
+#if defined(B300)
+ *b = ((t->c_cflag & B300) == B300);
+ return 1;
+#else
+ return 0;
+#endif
+ case b600:
+#if defined(B600)
+ *b = ((t->c_cflag & B600) == B600);
+ return 1;
+#else
+ return 0;
+#endif
+ case b1200:
+#if defined(B1200)
+ *b = ((t->c_cflag & B1200) == B1200);
+ return 1;
+#else
+ return 0;
+#endif
+ case b1800:
+#if defined(B1800)
+ *b = ((t->c_cflag & B1800) == B1800);
+ return 1;
+#else
+ return 0;
+#endif
+ case b2400:
+#if defined(B2400)
+ *b = ((t->c_cflag & B2400) == B2400);
+ return 1;
+#else
+ return 0;
+#endif
+ case b4800:
+#if defined(B4800)
+ *b = ((t->c_cflag & B4800) == B4800);
+ return 1;
+#else
+ return 0;
+#endif
+ case b9600:
+#if defined(B9600)
+ *b = ((t->c_cflag & B9600) == B9600);
+ return 1;
+#else
+ return 0;
+#endif
+ case b19200:
+#if defined(B19200)
+ *b = ((t->c_cflag & B19200) == B19200);
+ return 1;
+#else
+ return 0;
+#endif
+ case b38400:
+#if defined(B38400)
+ *b = ((t->c_cflag & B38400) == B38400);
+ return 1;
+#else
+ return 0;
+#endif
+ case b57600:
+#if defined(B57600)
+ *b = ((t->c_cflag & B57600) == B57600);
+ return 1;
+#else
+ return 0;
+#endif
+ case b115200:
+#if defined(B115200)
+ *b = ((t->c_cflag & B115200) == B115200);
+ return 1;
+#else
+ return 0;
+#endif
+ case b240400:
+#if defined(B230400)
+ *b = ((t->c_cflag & B230400) == B230400);
+ return 1;
+#else
+ return 0;
+#endif
+ case b460800:
+#if defined(B460800)
+ *b = ((t->c_cflag & B460800) == B460800);
+ return 1;
+#else
+ return 0;
+#endif
+ case b500000:
+#if defined(B500000)
+ *b = ((t->c_cflag & B500000) == B500000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b576000:
+#if defined(B576000)
+ *b = ((t->c_cflag & B576000) == B576000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b921600:
+#if defined(B921600)
+ *b = ((t->c_cflag & B921600) == B921600);
+ return 1;
+#else
+ return 0;
+#endif
+ case b1000000:
+#if defined(B1000000)
+ *b = ((t->c_cflag & B1000000) == B1000000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b1152000:
+#if defined(B1152000)
+ *b = ((t->c_cflag & B1152000) == B1152000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b1500000:
+#if defined(B1500000)
+ *b = ((t->c_cflag & B1500000) == B1500000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b2000000:
+#if defined(B2000000)
+ *b = ((t->c_cflag & B2000000) == B2000000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b2500000:
+#if defined(B2500000)
+ *b = ((t->c_cflag & B2500000) == B2500000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b3000000:
+#if defined(B3000000)
+ *b = ((t->c_cflag & B3000000) == B3000000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b3500000:
+#if defined(B3500000)
+ *b = ((t->c_cflag & B3500000) == B3500000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b4000000:
+#if defined(B4000000)
+ *b = ((t->c_cflag & B4000000) == B4000000);
+ return 1;
+#else
+ return 0;
+#endif
+ case maxbaud:
+#if defined(__MAX_BAUD)
+ *b = ((t->c_cflag & __MAX_BAUD) == __MAX_BAUD);
+ return 1;
+#else
+ return 0;
+#endif
+ case crtscts:
+#if defined(CRTSCTS)
+ *b = ((t->c_cflag & CRTSCTS) == CRTSCTS);
+ return 1;
+#else
+ return 0;
+#endif
+ case cs5:
+#if defined(CS5)
+ *b = ((t->c_cflag & CS5) == CS5);
+ return 1;
+#else
+ return 0;
+#endif
+ case cs6:
+#if defined(CS6)
+ *b = ((t->c_cflag & CS6) == CS6);
+ return 1;
+#else
+ return 0;
+#endif
+ case cs7:
+#if defined(CS7)
+ *b = ((t->c_cflag & CS7) == CS7);
+ return 1;
+#else
+ return 0;
+#endif
+ case cs8:
+#if defined(CS8)
+ *b = ((t->c_cflag & CS8) == CS8);
+ return 1;
+#else
+ return 0;
+#endif
+ case cstopb:
+#if defined(CSTOPB)
+ *b = ((t->c_cflag & CSTOPB) == CSTOPB);
+ return 1;
+#else
+ return 0;
+#endif
+ case cread:
+#if defined(CREAD)
+ *b = ((t->c_cflag & CREAD) == CREAD);
+ return 1;
+#else
+ return 0;
+#endif
+ case parenb:
+#if defined(PARENB)
+ *b = ((t->c_cflag & PARENB) == PARENB);
+ return 1;
+#else
+ return 0;
+#endif
+ case parodd:
+#if defined(PARODD)
+ *b = ((t->c_cflag & PARODD) == PARODD);
+ return 1;
+#else
+ return 0;
+#endif
+ case hupcl:
+#if defined(HUPCL)
+ *b = ((t->c_cflag & HUPCL) == HUPCL);
+ return 1;
+#else
+ return 0;
+#endif
+ case clocal:
+#if defined(CLOCAL)
+ *b = ((t->c_cflag & CLOCAL) == CLOCAL);
+ return 1;
+#else
+ return 0;
+#endif
+ case lisig:
+#if defined(ISIG)
+ *b = ((t->c_lflag & ISIG) == ISIG);
+ return 1;
+#else
+ return 0;
+#endif
+ case licanon:
+#if defined(ICANON)
+ *b = ((t->c_lflag & ICANON) == ICANON);
+ return 1;
+#else
+ return 0;
+#endif
+ case lxcase:
+#if defined(XCASE)
+ *b = ((t->c_lflag & XCASE) == XCASE);
+ return 1;
+#else
+ return 0;
+#endif
+ case lecho:
+#if defined(ECHO)
+ *b = ((t->c_lflag & ECHO) == ECHO);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechoe:
+#if defined(ECHOE)
+ *b = ((t->c_lflag & ECHOE) == ECHOE);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechok:
+#if defined(ECHOK)
+ *b = ((t->c_lflag & ECHOK) == ECHOK);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechonl:
+#if defined(ECHONL)
+ *b = ((t->c_lflag & ECHONL) == ECHONL);
+ return 1;
+#else
+ return 0;
+#endif
+ case lnoflsh:
+#if defined(NOFLSH)
+ *b = ((t->c_lflag & NOFLSH) == NOFLSH);
+ return 1;
+#else
+ return 0;
+#endif
+ case ltopstop:
+#if defined(TOSTOP)
+ *b = ((t->c_lflag & TOSTOP) == TOSTOP);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechoctl:
+#if defined(ECHOCTL)
+ *b = ((t->c_lflag & ECHOCTL) == ECHOCTL);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechoprt:
+#if defined(ECHOPRT)
+ *b = ((t->c_lflag & ECHOPRT) == ECHOPRT);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechoke:
+#if defined(ECHOKE)
+ *b = ((t->c_lflag & ECHOKE) == ECHOKE);
+ return 1;
+#else
+ return 0;
+#endif
+ case lflusho:
+#if defined(FLUSHO)
+ *b = ((t->c_lflag & FLUSHO) == FLUSHO);
+ return 1;
+#else
+ return 0;
+#endif
+ case lpendin:
+#if defined(PENDIN)
+ *b = ((t->c_lflag & PENDIN) == PENDIN);
+ return 1;
+#else
+ return 0;
+#endif
+ case liexten:
+#if defined(IEXTEN)
+ *b = ((t->c_lflag & IEXTEN) == IEXTEN);
+ return 1;
+#else
+ return 0;
+#endif
+ }
+ return 0;
+}
+
+/* SetFlag - sets a flag value in, t, to, b, and returns TRUE if this
+ flag value is supported. */
+
+int
+EXPORT (SetFlag) (struct termios *t, Flag f, int b)
+{
+ switch (f)
+ {
+ case ignbrk:
+#if defined(IGNBRK)
+ return doSetUnset (&t->c_iflag, IGNBRK, b);
+#else
+ return 0;
+#endif
+ case ibrkint:
+#if defined(BRKINT)
+ return doSetUnset (&t->c_iflag, BRKINT, b);
+#else
+ return 0;
+#endif
+ case ignpar:
+#if defined(IGNPAR)
+ return doSetUnset (&t->c_iflag, IGNPAR, b);
+#else
+ return 0;
+#endif
+ case iparmrk:
+#if defined(PARMRK)
+ return doSetUnset (&t->c_iflag, PARMRK, b);
+#else
+ return 0;
+#endif
+ case inpck:
+#if defined(INPCK)
+ return doSetUnset (&t->c_iflag, INPCK, b);
+#else
+ return 0;
+#endif
+ case istrip:
+#if defined(ISTRIP)
+ return doSetUnset (&t->c_iflag, ISTRIP, b);
+#else
+ return 0;
+#endif
+ case inlcr:
+#if defined(INLCR)
+ return doSetUnset (&t->c_iflag, INLCR, b);
+#else
+ return 0;
+#endif
+ case igncr:
+#if defined(IGNCR)
+ return doSetUnset (&t->c_iflag, IGNCR, b);
+#else
+ return 0;
+#endif
+ case icrnl:
+#if defined(ICRNL)
+ return doSetUnset (&t->c_iflag, ICRNL, b);
+#else
+ return 0;
+#endif
+ case iuclc:
+#if defined(IUCLC)
+ return doSetUnset (&t->c_iflag, IUCLC, b);
+#else
+ return 0;
+#endif
+ case ixon:
+#if defined(IXON)
+ return doSetUnset (&t->c_iflag, IXON, b);
+#else
+ return 0;
+#endif
+ case ixany:
+#if defined(IXANY)
+ return doSetUnset (&t->c_iflag, IXANY, b);
+#else
+ return 0;
+#endif
+ case ixoff:
+#if defined(IXOFF)
+ return doSetUnset (&t->c_iflag, IXOFF, b);
+#else
+ return 0;
+#endif
+ case imaxbel:
+#if defined(IMAXBEL)
+ return doSetUnset (&t->c_iflag, IMAXBEL, b);
+#else
+ return 0;
+#endif
+ case opost:
+#if defined(OPOST)
+ return doSetUnset (&t->c_oflag, OPOST, b);
+#else
+ return 0;
+#endif
+ case olcuc:
+#if defined(OLCUC)
+ return doSetUnset (&t->c_oflag, OLCUC, b);
+#else
+ return 0;
+#endif
+ case onlcr:
+#if defined(ONLCR)
+ return doSetUnset (&t->c_oflag, ONLCR, b);
+#else
+ return 0;
+#endif
+ case ocrnl:
+#if defined(OCRNL)
+ return doSetUnset (&t->c_oflag, OCRNL, b);
+#else
+ return 0;
+#endif
+ case onocr:
+#if defined(ONOCR)
+ return doSetUnset (&t->c_oflag, ONOCR, b);
+#else
+ return 0;
+#endif
+ case onlret:
+#if defined(ONLRET)
+ return doSetUnset (&t->c_oflag, ONLRET, b);
+#else
+ return 0;
+#endif
+ case ofill:
+#if defined(OFILL)
+ return doSetUnset (&t->c_oflag, OFILL, b);
+#else
+ return 0;
+#endif
+ case ofdel:
+#if defined(OFDEL)
+ return doSetUnset (&t->c_oflag, OFDEL, b);
+#else
+ return 0;
+#endif
+ case onl0:
+#if defined(NL0)
+ return doSetUnset (&t->c_oflag, NL0, b);
+#else
+ return 0;
+#endif
+ case onl1:
+#if defined(NL1)
+ return doSetUnset (&t->c_oflag, NL1, b);
+#else
+ return 0;
+#endif
+ case ocr0:
+#if defined(CR0)
+ return doSetUnset (&t->c_oflag, CR0, b);
+#else
+ return 0;
+#endif
+ case ocr1:
+#if defined(CR1)
+ return doSetUnset (&t->c_oflag, CR1, b);
+#else
+ return 0;
+#endif
+ case ocr2:
+#if defined(CR2)
+ return doSetUnset (&t->c_oflag, CR2, b);
+#else
+ return 0;
+#endif
+ case ocr3:
+#if defined(CR3)
+ return doSetUnset (&t->c_oflag, CR3, b);
+#else
+ return 0;
+#endif
+ case otab0:
+#if defined(TAB0)
+ return doSetUnset (&t->c_oflag, TAB0, b);
+#else
+ return 0;
+#endif
+ case otab1:
+#if defined(TAB1)
+ return doSetUnset (&t->c_oflag, TAB1, b);
+#else
+ return 0;
+#endif
+ case otab2:
+#if defined(TAB2)
+ return doSetUnset (&t->c_oflag, TAB2, b);
+#else
+ return 0;
+#endif
+ case otab3:
+#if defined(TAB3)
+ return doSetUnset (&t->c_oflag, TAB3, b);
+#else
+ return 0;
+#endif
+ case obs0:
+#if defined(BS0)
+ return doSetUnset (&t->c_oflag, BS0, b);
+#else
+ return 0;
+#endif
+ case obs1:
+#if defined(BS1)
+ return doSetUnset (&t->c_oflag, BS1, b);
+#else
+ return 0;
+#endif
+ case off0:
+#if defined(FF0)
+ return doSetUnset (&t->c_oflag, FF0, b);
+#else
+ return 0;
+#endif
+ case off1:
+#if defined(FF1)
+ return doSetUnset (&t->c_oflag, FF1, b);
+#else
+ return 0;
+#endif
+ case ovt0:
+#if defined(VT0)
+ return doSetUnset (&t->c_oflag, VT0, b);
+#else
+ return 0;
+#endif
+ case ovt1:
+#if defined(VT1)
+ return doSetUnset (&t->c_oflag, VT1, b);
+#else
+ return 0;
+#endif
+ case b0:
+#if defined(B0)
+ return doSetUnset (&t->c_cflag, B0, b);
+#else
+ return 0;
+#endif
+ case b50:
+#if defined(B50)
+ return doSetUnset (&t->c_cflag, B50, b);
+#else
+ return 0;
+#endif
+ case b75:
+#if defined(B75)
+ return doSetUnset (&t->c_cflag, B75, b);
+#else
+ return 0;
+#endif
+ case b110:
+#if defined(B110)
+ return doSetUnset (&t->c_cflag, B110, b);
+#else
+ return 0;
+#endif
+ case b135:
+#if defined(B134)
+ return doSetUnset (&t->c_cflag, B134, b);
+#else
+ return 0;
+#endif
+ case b150:
+#if defined(B150)
+ return doSetUnset (&t->c_cflag, B150, b);
+#else
+ return 0;
+#endif
+ case b200:
+#if defined(B200)
+ return doSetUnset (&t->c_cflag, B200, b);
+#else
+ return 0;
+#endif
+ case b300:
+#if defined(B300)
+ return doSetUnset (&t->c_cflag, B300, b);
+#else
+ return 0;
+#endif
+ case b600:
+#if defined(B600)
+ return doSetUnset (&t->c_cflag, B600, b);
+#else
+ return 0;
+#endif
+ case b1200:
+#if defined(B1200)
+ return doSetUnset (&t->c_cflag, B1200, b);
+#else
+ return 0;
+#endif
+ case b1800:
+#if defined(B1800)
+ return doSetUnset (&t->c_cflag, B1800, b);
+#else
+ return 0;
+#endif
+ case b2400:
+#if defined(B2400)
+ return doSetUnset (&t->c_cflag, B2400, b);
+#else
+ return 0;
+#endif
+ case b4800:
+#if defined(B4800)
+ return doSetUnset (&t->c_cflag, B4800, b);
+#else
+ return 0;
+#endif
+ case b9600:
+#if defined(B9600)
+ return doSetUnset (&t->c_cflag, B9600, b);
+#else
+ return 0;
+#endif
+ case b19200:
+#if defined(B19200)
+ return doSetUnset (&t->c_cflag, B19200, b);
+#else
+ return 0;
+#endif
+ case b38400:
+#if defined(B38400)
+ return doSetUnset (&t->c_cflag, B38400, b);
+#else
+ return 0;
+#endif
+ case b57600:
+#if defined(B57600)
+ return doSetUnset (&t->c_cflag, B57600, b);
+#else
+ return 0;
+#endif
+ case b115200:
+#if defined(B115200)
+ return doSetUnset (&t->c_cflag, B115200, b);
+#else
+ return 0;
+#endif
+ case b240400:
+#if defined(B230400)
+ return doSetUnset (&t->c_cflag, B230400, b);
+#else
+ return 0;
+#endif
+ case b460800:
+#if defined(B460800)
+ return doSetUnset (&t->c_cflag, B460800, b);
+#else
+ return 0;
+#endif
+ case b500000:
+#if defined(B500000)
+ return doSetUnset (&t->c_cflag, B500000, b);
+#else
+ return 0;
+#endif
+ case b576000:
+#if defined(B576000)
+ return doSetUnset (&t->c_cflag, B576000, b);
+#else
+ return 0;
+#endif
+ case b921600:
+#if defined(B921600)
+ return doSetUnset (&t->c_cflag, B921600, b);
+#else
+ return 0;
+#endif
+ case b1000000:
+#if defined(B1000000)
+ return doSetUnset (&t->c_cflag, B1000000, b);
+#else
+ return 0;
+#endif
+ case b1152000:
+#if defined(B1152000)
+ return doSetUnset (&t->c_cflag, B1152000, b);
+#else
+ return 0;
+#endif
+ case b1500000:
+#if defined(B1500000)
+ return doSetUnset (&t->c_cflag, B1500000, b);
+#else
+ return 0;
+#endif
+ case b2000000:
+#if defined(B2000000)
+ return doSetUnset (&t->c_cflag, B2000000, b);
+#else
+ return 0;
+#endif
+ case b2500000:
+#if defined(B2500000)
+ return doSetUnset (&t->c_cflag, B2500000, b);
+#else
+ return 0;
+#endif
+ case b3000000:
+#if defined(B3000000)
+ return doSetUnset (&t->c_cflag, B3000000, b);
+#else
+ return 0;
+#endif
+ case b3500000:
+#if defined(B3500000)
+ return doSetUnset (&t->c_cflag, B3500000, b);
+#else
+ return 0;
+#endif
+ case b4000000:
+#if defined(B4000000)
+ return doSetUnset (&t->c_cflag, B4000000, b);
+#else
+ return 0;
+#endif
+ case maxbaud:
+#if defined(__MAX_BAUD)
+ return doSetUnset (&t->c_cflag, __MAX_BAUD, b);
+#else
+ return 0;
+#endif
+ case crtscts:
+#if defined(CRTSCTS)
+ return doSetUnset (&t->c_cflag, CRTSCTS, b);
+#else
+ return 0;
+#endif
+ case cs5:
+#if defined(CS5)
+ return doSetUnset (&t->c_cflag, CS5, b);
+#else
+ return 0;
+#endif
+ case cs6:
+#if defined(CS6)
+ return doSetUnset (&t->c_cflag, CS6, b);
+#else
+ return 0;
+#endif
+ case cs7:
+#if defined(CS7)
+ return doSetUnset (&t->c_cflag, CS7, b);
+#else
+ return 0;
+#endif
+ case cs8:
+#if defined(CS8)
+ return doSetUnset (&t->c_cflag, CS8, b);
+#else
+ return 0;
+#endif
+ case cstopb:
+#if defined(CSTOPB)
+ return doSetUnset (&t->c_cflag, CSTOPB, b);
+#else
+ return 0;
+#endif
+ case cread:
+#if defined(CREAD)
+ return doSetUnset (&t->c_cflag, CREAD, b);
+#else
+ return 0;
+#endif
+ case parenb:
+#if defined(PARENB)
+ return doSetUnset (&t->c_cflag, PARENB, b);
+#else
+ return 0;
+#endif
+ case parodd:
+#if defined(PARODD)
+ return doSetUnset (&t->c_cflag, PARODD, b);
+#else
+ return 0;
+#endif
+ case hupcl:
+#if defined(HUPCL)
+ return doSetUnset (&t->c_cflag, HUPCL, b);
+#else
+ return 0;
+#endif
+ case clocal:
+#if defined(CLOCAL)
+ return doSetUnset (&t->c_cflag, CLOCAL, b);
+#else
+ return 0;
+#endif
+ case lisig:
+#if defined(ISIG)
+ return doSetUnset (&t->c_lflag, ISIG, b);
+#else
+ return 0;
+#endif
+ case licanon:
+#if defined(ICANON)
+ return doSetUnset (&t->c_lflag, ICANON, b);
+#else
+ return 0;
+#endif
+ case lxcase:
+#if defined(XCASE)
+ return doSetUnset (&t->c_lflag, XCASE, b);
+#else
+ return 0;
+#endif
+ case lecho:
+#if defined(ECHO)
+ return doSetUnset (&t->c_lflag, ECHO, b);
+#else
+ return 0;
+#endif
+ case lechoe:
+#if defined(ECHOE)
+ return doSetUnset (&t->c_lflag, ECHOE, b);
+#else
+ return 0;
+#endif
+ case lechok:
+#if defined(ECHOK)
+ return doSetUnset (&t->c_lflag, ECHOK, b);
+#else
+ return 0;
+#endif
+ case lechonl:
+#if defined(ECHONL)
+ return doSetUnset (&t->c_lflag, ECHONL, b);
+#else
+ return 0;
+#endif
+ case lnoflsh:
+#if defined(NOFLSH)
+ return doSetUnset (&t->c_lflag, NOFLSH, b);
+#else
+ return 0;
+#endif
+ case ltopstop:
+#if defined(TOSTOP)
+ return doSetUnset (&t->c_lflag, TOSTOP, b);
+#else
+ return 0;
+#endif
+ case lechoctl:
+#if defined(ECHOCTL)
+ return doSetUnset (&t->c_lflag, ECHOCTL, b);
+#else
+ return 0;
+#endif
+ case lechoprt:
+#if defined(ECHOPRT)
+ return doSetUnset (&t->c_lflag, ECHOPRT, b);
+#else
+ return 0;
+#endif
+ case lechoke:
+#if defined(ECHOKE)
+ return doSetUnset (&t->c_lflag, ECHOKE, b);
+#else
+ return 0;
+#endif
+ case lflusho:
+#if defined(FLUSHO)
+ return doSetUnset (&t->c_lflag, FLUSHO, b);
+#else
+ return 0;
+#endif
+ case lpendin:
+#if defined(PENDIN)
+ return doSetUnset (&t->c_lflag, PENDIN, b);
+#else
+ return 0;
+#endif
+ case liexten:
+#if defined(IEXTEN)
+ return doSetUnset (&t->c_lflag, IEXTEN, b);
+#else
+ return 0;
+#endif
+ }
+ return 0;
+}
+
+/* GetChar - sets a CHAR, ch, value from, t, and returns TRUE if this
+ value is supported. */
+
+int
+EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch)
+{
+ switch (c)
+ {
+
+ case vintr:
+#if defined(VINTR)
+ *ch = t->c_cc[VINTR];
+ return 1;
+#else
+ return 0;
+#endif
+ case vquit:
+#if defined(VQUIT)
+ *ch = t->c_cc[VQUIT];
+ return 1;
+#else
+ return 0;
+#endif
+ case verase:
+#if defined(VERASE)
+ *ch = t->c_cc[VERASE];
+ return 1;
+#else
+ return 0;
+#endif
+ case vkill:
+#if defined(VKILL)
+ *ch = t->c_cc[VKILL];
+ return 1;
+#else
+ return 0;
+#endif
+ case veof:
+#if defined(VEOF)
+ *ch = t->c_cc[VEOF];
+ return 1;
+#else
+ return 0;
+#endif
+ case vtime:
+#if defined(VTIME)
+ *ch = t->c_cc[VTIME];
+ return 1;
+#else
+ return 0;
+#endif
+ case vmin:
+#if defined(VMIN)
+ *ch = t->c_cc[VMIN];
+ return 1;
+#else
+ return 0;
+#endif
+ case vswtc:
+#if defined(VSWTC)
+ *ch = t->c_cc[VSWTC];
+ return 1;
+#else
+ return 0;
+#endif
+ case vstart:
+#if defined(VSTART)
+ *ch = t->c_cc[VSTART];
+ return 1;
+#else
+ return 0;
+#endif
+ case vstop:
+#if defined(VSTOP)
+ *ch = t->c_cc[VSTOP];
+ return 1;
+#else
+ return 0;
+#endif
+ case vsusp:
+#if defined(VSUSP)
+ *ch = t->c_cc[VSUSP];
+ return 1;
+#else
+ return 0;
+#endif
+ case veol:
+#if defined(VEOL)
+ *ch = t->c_cc[VEOL];
+ return 1;
+#else
+ return 0;
+#endif
+ case vreprint:
+#if defined(VREPRINT)
+ *ch = t->c_cc[VREPRINT];
+ return 1;
+#else
+ return 0;
+#endif
+ case vdiscard:
+#if defined(VDISCARD)
+ *ch = t->c_cc[VDISCARD];
+ return 1;
+#else
+ return 0;
+#endif
+ case vwerase:
+#if defined(VWERASE)
+ *ch = t->c_cc[VWERASE];
+ return 1;
+#else
+ return 0;
+#endif
+ case vlnext:
+#if defined(VLNEXT)
+ *ch = t->c_cc[VLNEXT];
+ return 1;
+#else
+ return 0;
+#endif
+ case veol2:
+#if defined(VEOL2)
+ *ch = t->c_cc[VEOL2];
+ return 1;
+#else
+ return 0;
+#endif
+ default:
+ return 0;
+ }
+}
+
+/* SetChar - sets a CHAR value in, t, and returns TRUE if, c, is
+ supported. */
+
+int
+EXPORT (SetChar) (struct termios *t, ControlChar c, char ch)
+{
+ switch (c)
+ {
+
+ case vintr:
+#if defined(VINTR)
+ t->c_cc[VINTR] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vquit:
+#if defined(VQUIT)
+ t->c_cc[VQUIT] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case verase:
+#if defined(VERASE)
+ t->c_cc[VERASE] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vkill:
+#if defined(VKILL)
+ t->c_cc[VKILL] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case veof:
+#if defined(VEOF)
+ t->c_cc[VEOF] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vtime:
+#if defined(VTIME)
+ t->c_cc[VTIME] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vmin:
+#if defined(VMIN)
+ t->c_cc[VMIN] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vswtc:
+#if defined(VSWTC)
+ t->c_cc[VSWTC] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vstart:
+#if defined(VSTART)
+ t->c_cc[VSTART] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vstop:
+#if defined(VSTOP)
+ t->c_cc[VSTOP] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vsusp:
+#if defined(VSUSP)
+ t->c_cc[VSUSP] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case veol:
+#if defined(VEOL)
+ t->c_cc[VEOL] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vreprint:
+#if defined(VREPRINT)
+ t->c_cc[VREPRINT] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vdiscard:
+#if defined(VDISCARD)
+ t->c_cc[VDISCARD] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vwerase:
+#if defined(VWERASE)
+ t->c_cc[VWERASE] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vlnext:
+#if defined(VLNEXT)
+ t->c_cc[VLNEXT] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case veol2:
+#if defined(VEOL2)
+ t->c_cc[VEOL2] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ default:
+ return 0;
+ }
+}
+
+void
+_M2_termios_init (void)
+{
+}
+
+void
+_M2_termios_finish (void)
+{
+}
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/mc-boot-ch/m2rts.h b/gcc/m2/mc-boot-ch/m2rts.h
new file mode 100644
index 00000000000..57e6e90d94d
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/m2rts.h
@@ -0,0 +1,41 @@
+/* m2rts.h provides a C interface to M2RTS.mod.
+
+Copyright (C) 2019-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+
+typedef void (*proc_con) (int, char **, char **);
+typedef void (*proc_dep) (void);
+
+extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy);
+extern "C" void M2RTS_RegisterModule (const char *modulename,
+ proc_con init, proc_con fini, proc_dep dependencies);
+extern "C" void _M2_M2RTS_init (void);
+
+extern "C" void M2RTS_ConstructModules (const char *,
+ int argc, char *argv[], char *envp[]);
+extern "C" void M2RTS_Terminate (void);
+extern "C" void M2RTS_DeconstructModules (void);
+
+extern "C" void M2RTS_Halt (const char *, int, const char *, const char *) __attribute__ ((noreturn));
diff --git a/gcc/m2/mc-boot/GM2Dependent.c b/gcc/m2/mc-boot/GM2Dependent.c
new file mode 100644
index 00000000000..d677798962e
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2Dependent.c
@@ -0,0 +1,1113 @@
+/* do not edit automatically generated by mc from M2Dependent. */
+/* M2Dependent.mod implements the run time module dependencies.
+
+Copyright (C) 2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _M2Dependent_H
+#define _M2Dependent_C
+
+# include "Glibc.h"
+# include "GM2LINK.h"
+# include "GASCII.h"
+# include "GSYSTEM.h"
+# include "GStorage.h"
+# include "GStrLib.h"
+# include "GM2RTS.h"
+
+typedef struct M2Dependent_ArgCVEnvP_p M2Dependent_ArgCVEnvP;
+
+typedef struct DependencyList_r DependencyList;
+
+typedef struct _T2_r _T2;
+
+typedef _T2 *ModuleChain;
+
+typedef struct _T3_a _T3;
+
+typedef enum {unregistered, unordered, started, ordered, user} DependencyState;
+
+typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *);
+struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; };
+
+struct DependencyList_r {
+ PROC proc;
+ unsigned int forced;
+ unsigned int forc;
+ unsigned int appl;
+ DependencyState state;
+ };
+
+struct _T3_a { ModuleChain array[user-unregistered+1]; };
+struct _T2_r {
+ void *name;
+ M2Dependent_ArgCVEnvP init;
+ M2Dependent_ArgCVEnvP fini;
+ DependencyList dependency;
+ ModuleChain prev;
+ ModuleChain next;
+ };
+
+static _T3 Modules;
+static unsigned int Initialized;
+static unsigned int ModuleTrace;
+static unsigned int DependencyTrace;
+static unsigned int PreTrace;
+static unsigned int PostTrace;
+static unsigned int ForceTrace;
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static ModuleChain CreateModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ AppendModule - append chain to end of the list.
+*/
+
+static void AppendModule (ModuleChain *head, ModuleChain chain);
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (ModuleChain *head, ModuleChain chain);
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (DependencyState state, ModuleChain mptr);
+
+/*
+ LookupModuleN - lookup module from the state list. The string is limited
+ to nchar.
+*/
+
+static ModuleChain LookupModuleN (DependencyState state, void * name, unsigned int nchar);
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static ModuleChain LookupModule (DependencyState state, void * name);
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high);
+
+/*
+ strcmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b);
+
+/*
+ strncmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n);
+
+/*
+ strlen - returns the length of string.
+*/
+
+static int strlen_ (M2LINK_PtrToChar string);
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high);
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg);
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (DependencyState newstate, ModuleChain mptr);
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (ModuleChain mptr, void * currentmodule);
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * dependantmodule);
+
+/*
+ ResolveDependencies - resolve dependencies for currentmodule.
+*/
+
+static void ResolveDependencies (void * currentmodule);
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (DependencyState state, const char *name_, unsigned int _name_high);
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag);
+
+/*
+ combine - dest := src + dest. Places src at the front of list dest.
+ Pre condition: src, dest are lists.
+ Post condition : dest := src + dest
+ src := NIL.
+*/
+
+static void combine (DependencyState src, DependencyState dest);
+
+/*
+ ForceDependencies - if the user has specified a forced order then we override
+ the dynamic ordering with the preference.
+*/
+
+static void ForceDependencies (void);
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high);
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved dynamically.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void);
+
+/*
+ Init - initialize the debug flags and set all lists to NIL.
+*/
+
+static void Init (void);
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void);
+
+
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static ModuleChain CreateModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+ ModuleChain mptr;
+
+ Storage_ALLOCATE ((void **) &mptr, sizeof (_T2));
+ mptr->name = name;
+ mptr->init = init;
+ mptr->fini = fini;
+ mptr->dependency.proc = dependencies;
+ mptr->dependency.state = unregistered;
+ mptr->prev = NULL;
+ mptr->next = NULL;
+ return mptr;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AppendModule - append chain to end of the list.
+*/
+
+static void AppendModule (ModuleChain *head, ModuleChain chain)
+{
+ if ((*head) == NULL)
+ {
+ (*head) = chain;
+ chain->prev = chain;
+ chain->next = chain;
+ }
+ else
+ {
+ chain->next = (*head); /* Add Item to the end of list. */
+ chain->prev = (*head)->prev; /* Add Item to the end of list. */
+ (*head)->prev->next = chain;
+ (*head)->prev = chain;
+ }
+}
+
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (ModuleChain *head, ModuleChain chain)
+{
+ if ((chain->next == (*head)) && (chain == (*head)))
+ {
+ (*head) = NULL;
+ }
+ else
+ {
+ if ((*head) == chain)
+ {
+ (*head) = (*head)->next;
+ }
+ chain->prev->next = chain->next;
+ chain->next->prev = chain->prev;
+ }
+}
+
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (DependencyState state, ModuleChain mptr)
+{
+ ModuleChain ptr;
+
+ if (Modules.array[state-unregistered] != NULL)
+ {
+ ptr = Modules.array[state-unregistered];
+ do {
+ if (ptr == mptr)
+ {
+ return TRUE;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-unregistered]));
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModuleN - lookup module from the state list. The string is limited
+ to nchar.
+*/
+
+static ModuleChain LookupModuleN (DependencyState state, void * name, unsigned int nchar)
+{
+ ModuleChain ptr;
+
+ if (Modules.array[state-unregistered] != NULL)
+ {
+ ptr = Modules.array[state-unregistered];
+ do {
+ if ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), nchar)) == 0)
+ {
+ return ptr;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-unregistered]));
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static ModuleChain LookupModule (DependencyState state, void * name)
+{
+ return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high)
+{
+ unsigned int high;
+ unsigned int i;
+ unsigned int j;
+
+ i = 0;
+ high = _str_high;
+ while (i < high)
+ {
+ if ((str[i] == '\\') && (i < high))
+ {
+ if (str[i+1] == 'n')
+ {
+ str[i] = ASCII_nl;
+ j = i+1;
+ while (j < high)
+ {
+ str[j] = str[j+1];
+ j += 1;
+ }
+ }
+ }
+ i += 1;
+ }
+}
+
+
+/*
+ strcmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b)
+{
+ if ((a != NULL) && (b != NULL))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a == b)
+ {
+ return 0;
+ }
+ else
+ {
+ while ((*a) == (*b))
+ {
+ if ((*a) == ASCII_nul)
+ {
+ return 0;
+ }
+ a += 1;
+ b += 1;
+ }
+ }
+ }
+ return 1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ strncmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n)
+{
+ if (((a != NULL) && (b != NULL)) && (n > 0))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a == b)
+ {
+ return 0;
+ }
+ else
+ {
+ while (((*a) == (*b)) && (n > 0))
+ {
+ if (((*a) == ASCII_nul) || (n == 1))
+ {
+ return 0;
+ }
+ a += 1;
+ b += 1;
+ n -= 1;
+ }
+ }
+ }
+ return 1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ strlen - returns the length of string.
+*/
+
+static int strlen_ (M2LINK_PtrToChar string)
+{
+ int count;
+
+ if (string == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ count = 0;
+ while ((*string) != ASCII_nul)
+ {
+ string += 1;
+ count += 1;
+ }
+ return count;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ libc_printf ((const char *) str, _str_high);
+ }
+}
+
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ libc_printf ((const char *) str, _str_high, arg);
+ }
+}
+
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (DependencyState newstate, ModuleChain mptr)
+{
+ if (onChain (mptr->dependency.state, mptr))
+ {
+ RemoveModule (&Modules.array[mptr->dependency.state-unregistered], mptr);
+ }
+ mptr->dependency.state = newstate;
+ AppendModule (&Modules.array[mptr->dependency.state-unregistered], mptr);
+}
+
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (ModuleChain mptr, void * currentmodule)
+{
+ if (mptr == NULL)
+ {
+ traceprintf (DependencyTrace, (const char *) " module has not been registered via a global constructor\\n", 60);
+ }
+ else
+ {
+ if (onChain (started, mptr))
+ {
+ traceprintf (DependencyTrace, (const char *) " processing...\\n", 18);
+ }
+ else
+ {
+ moveTo (started, mptr);
+ traceprintf2 (DependencyTrace, (const char *) " starting: %s\\n", 17, currentmodule);
+ (*mptr->dependency.proc.proc) (); /* Invoke and process the dependency graph. */
+ traceprintf2 (DependencyTrace, (const char *) " finished: %s\\n", 17, currentmodule); /* Invoke and process the dependency graph. */
+ moveTo (ordered, mptr);
+ }
+ }
+}
+
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * dependantmodule)
+{
+ ModuleChain mptr;
+
+ traceprintf2 (DependencyTrace, (const char *) " module %s", 11, modulename);
+ if (dependantmodule == NULL)
+ {
+ /* avoid dangling else. */
+ traceprintf2 (DependencyTrace, (const char *) " has finished its import graph\\n", 32, modulename);
+ mptr = LookupModule (unordered, modulename);
+ if (mptr != NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s is now ordered\\n", 28, modulename);
+ moveTo (ordered, mptr);
+ }
+ }
+ else
+ {
+ traceprintf2 (DependencyTrace, (const char *) " imports from %s\\n", 18, dependantmodule);
+ mptr = LookupModule (ordered, dependantmodule);
+ if (mptr == NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s is not ordered\\n", 28, dependantmodule);
+ mptr = LookupModule (unordered, dependantmodule);
+ if (mptr == NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s is not unordered\\n", 30, dependantmodule);
+ mptr = LookupModule (started, dependantmodule);
+ if (mptr == NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s has not started\\n", 29, dependantmodule);
+ traceprintf2 (DependencyTrace, (const char *) " module %s attempting to import from", 37, modulename);
+ traceprintf2 (DependencyTrace, (const char *) " %s which has not registered itself via a constructor\\n", 55, dependantmodule);
+ }
+ else
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s has registered itself and has started\\n", 51, dependantmodule);
+ }
+ }
+ else
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s resolving\\n", 23, dependantmodule);
+ ResolveDependant (mptr, dependantmodule);
+ }
+ }
+ else
+ {
+ traceprintf2 (DependencyTrace, (const char *) " module %s ", 12, modulename);
+ traceprintf2 (DependencyTrace, (const char *) " dependant %s is ordered\\n", 26, dependantmodule);
+ }
+ }
+}
+
+
+/*
+ ResolveDependencies - resolve dependencies for currentmodule.
+*/
+
+static void ResolveDependencies (void * currentmodule)
+{
+ ModuleChain mptr;
+
+ mptr = LookupModule (unordered, currentmodule);
+ while (mptr != NULL)
+ {
+ traceprintf2 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s\\n", 48, currentmodule);
+ ResolveDependant (mptr, currentmodule);
+ mptr = Modules.array[unordered-unregistered];
+ }
+}
+
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (DependencyState state, const char *name_, unsigned int _name_high)
+{
+ ModuleChain mptr;
+ char name[_name_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (name, name_, _name_high+1);
+
+ if (Modules.array[state-unregistered] != NULL)
+ {
+ libc_printf ((const char *) "%s modules\\n", 12, &name);
+ mptr = Modules.array[state-unregistered];
+ do {
+ libc_printf ((const char *) " %s", 4, mptr->name);
+ if (mptr->dependency.appl)
+ {
+ libc_printf ((const char *) " application", 12);
+ }
+ if (mptr->dependency.forc)
+ {
+ libc_printf ((const char *) " for C", 6);
+ }
+ if (mptr->dependency.forced)
+ {
+ libc_printf ((const char *) " forced ordering", 16);
+ }
+ libc_printf ((const char *) "\\n", 2);
+ mptr = mptr->next;
+ } while (! (mptr == Modules.array[state-unregistered]));
+ }
+}
+
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag)
+{
+ ModuleChain mptr;
+
+ if (flag)
+ {
+ DisplayModuleInfo (unregistered, (const char *) "unregistered", 12);
+ DisplayModuleInfo (unordered, (const char *) "unordered", 9);
+ DisplayModuleInfo (started, (const char *) "started", 7);
+ DisplayModuleInfo (ordered, (const char *) "ordered", 7);
+ }
+}
+
+
+/*
+ combine - dest := src + dest. Places src at the front of list dest.
+ Pre condition: src, dest are lists.
+ Post condition : dest := src + dest
+ src := NIL.
+*/
+
+static void combine (DependencyState src, DependencyState dest)
+{
+ ModuleChain last;
+
+ while (Modules.array[src-unregistered] != NULL)
+ {
+ last = Modules.array[src-unregistered]->prev;
+ moveTo (ordered, last);
+ Modules.array[dest-unregistered] = last; /* New item is at the head. */
+ }
+}
+
+
+/*
+ ForceDependencies - if the user has specified a forced order then we override
+ the dynamic ordering with the preference.
+*/
+
+static void ForceDependencies (void)
+{
+ ModuleChain mptr;
+ ModuleChain userChain;
+ unsigned int count;
+ M2LINK_PtrToChar pc;
+ M2LINK_PtrToChar start;
+
+ if (M2LINK_ForcedModuleInitOrder != NULL)
+ {
+ userChain = NULL;
+ pc = M2LINK_ForcedModuleInitOrder;
+ start = pc;
+ count = 0;
+ while ((*pc) != ASCII_nul)
+ {
+ if ((*pc) == ',')
+ {
+ mptr = LookupModuleN (ordered, reinterpret_cast<void *> (start), count);
+ if (mptr != NULL)
+ {
+ moveTo (user, mptr);
+ }
+ pc += 1;
+ start = pc;
+ count = 0;
+ }
+ else
+ {
+ pc += 1;
+ count += 1;
+ }
+ }
+ if (start != pc)
+ {
+ mptr = LookupModuleN (ordered, reinterpret_cast<void *> (start), count);
+ if (mptr != NULL)
+ {
+ moveTo (user, mptr);
+ }
+ }
+ combine (user, ordered);
+ }
+}
+
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ return (strncmp (reinterpret_cast<M2LINK_PtrToChar> (cstr), reinterpret_cast<M2LINK_PtrToChar> (&str), StrLib_StrLen ((const char *) str, _str_high))) == 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved dynamically.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void)
+{
+ typedef char *_T1;
+
+ _T1 pc;
+
+ ModuleTrace = FALSE;
+ DependencyTrace = FALSE;
+ PostTrace = FALSE;
+ PreTrace = FALSE;
+ pc = static_cast<_T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
+ while ((pc != NULL) && ((*pc) != ASCII_nul))
+ {
+ if (equal (reinterpret_cast<void *> (pc), (const char *) "all", 3))
+ {
+ ModuleTrace = TRUE;
+ DependencyTrace = TRUE;
+ PreTrace = TRUE;
+ PostTrace = TRUE;
+ ForceTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "module", 6))
+ {
+ /* avoid dangling else. */
+ ModuleTrace = TRUE;
+ pc += 6;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
+ {
+ /* avoid dangling else. */
+ DependencyTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "pre", 3))
+ {
+ /* avoid dangling else. */
+ PreTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "post", 4))
+ {
+ /* avoid dangling else. */
+ PostTrace = TRUE;
+ pc += 4;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "force", 5))
+ {
+ /* avoid dangling else. */
+ ForceTrace = TRUE;
+ pc += 5;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ pc += 1;
+ }
+ }
+}
+
+
+/*
+ Init - initialize the debug flags and set all lists to NIL.
+*/
+
+static void Init (void)
+{
+ DependencyState state;
+
+ SetupDebugFlags ();
+ for (state=unregistered; state<=user; state= static_cast<DependencyState>(static_cast<int>(state+1)))
+ {
+ Modules.array[state-unregistered] = NULL;
+ }
+}
+
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void)
+{
+ if (! Initialized)
+ {
+ Initialized = TRUE;
+ Init ();
+ }
+}
+
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+{
+ ModuleChain mptr;
+ M2Dependent_ArgCVEnvP nulp;
+
+ CheckInitialized ();
+ traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, applicationmodule);
+ mptr = LookupModule (unordered, applicationmodule);
+ if (mptr != NULL)
+ {
+ mptr->dependency.appl = TRUE;
+ }
+ traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26);
+ DumpModuleData (PreTrace);
+ ResolveDependencies (applicationmodule);
+ traceprintf (PreTrace, (const char *) "Post resolving dependents\\n", 27);
+ DumpModuleData (PostTrace);
+ ForceDependencies ();
+ traceprintf (ForceTrace, (const char *) "After user forcing ordering\\n", 29);
+ DumpModuleData (ForceTrace);
+ if (Modules.array[ordered-unregistered] == NULL)
+ {
+ traceprintf2 (ModuleTrace, (const char *) " module: %s has not registered itself using a global constructor\\n", 67, applicationmodule);
+ traceprintf2 (ModuleTrace, (const char *) " hint try compile and linking using: gm2 %s.mod\\n", 50, applicationmodule);
+ traceprintf2 (ModuleTrace, (const char *) " or try using: gm2 -fscaffold-static %s.mod\\n", 46, applicationmodule);
+ }
+ else
+ {
+ mptr = Modules.array[ordered-unregistered];
+ do {
+ if (mptr->dependency.forc)
+ {
+ traceprintf2 (ModuleTrace, (const char *) "initializing module: %s for C\\n", 31, mptr->name);
+ }
+ else
+ {
+ traceprintf2 (ModuleTrace, (const char *) "initializing module: %s\\n", 25, mptr->name);
+ }
+ if (mptr->dependency.appl)
+ {
+ traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, mptr->name);
+ traceprintf (ModuleTrace, (const char *) " calling M2RTS_ExecuteInitialProcedures\\n", 42);
+ M2RTS_ExecuteInitialProcedures ();
+ traceprintf (ModuleTrace, (const char *) " calling application module\\n", 30);
+ }
+ (*mptr->init.proc) (argc, argv, envp);
+ mptr = mptr->next;
+ } while (! (mptr == Modules.array[ordered-unregistered]));
+ }
+}
+
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+{
+ ModuleChain mptr;
+
+ traceprintf2 (ModuleTrace, (const char *) "application module finishing: %s\\n", 34, applicationmodule);
+ if (Modules.array[ordered-unregistered] == NULL)
+ {
+ traceprintf (ModuleTrace, (const char *) " no ordered modules found during finishing\\n", 45);
+ }
+ else
+ {
+ traceprintf (ModuleTrace, (const char *) "ExecuteTerminationProcedures\\n", 30);
+ M2RTS_ExecuteTerminationProcedures ();
+ traceprintf (ModuleTrace, (const char *) "terminating modules in sequence\\n", 33);
+ mptr = Modules.array[ordered-unregistered]->prev;
+ do {
+ if (mptr->dependency.forc)
+ {
+ traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s for C\\n", 29, mptr->name);
+ }
+ else
+ {
+ traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s\\n", 23, mptr->name);
+ }
+ (*mptr->fini.proc) (argc, argv, envp);
+ mptr = mptr->prev;
+ } while (! (mptr == Modules.array[ordered-unregistered]->prev));
+ }
+}
+
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+ CheckInitialized ();
+ if (! M2LINK_StaticInitialization)
+ {
+ traceprintf2 (ModuleTrace, (const char *) "module: %s registering\\n", 24, name);
+ moveTo (unordered, CreateModule (name, init, fini, dependencies));
+ }
+}
+
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * dependantmodule)
+{
+ CheckInitialized ();
+ if (! M2LINK_StaticInitialization)
+ {
+ PerformRequestDependant (modulename, dependantmodule);
+ }
+}
+
+extern "C" void _M2_M2Dependent_init (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[])
+{
+ CheckInitialized ();
+}
+
+extern "C" void _M2_M2Dependent_finish (__attribute__((unused)) int argc, __attribute__((unused)) char *argv[])
+{
+}
diff --git a/gcc/m2/mc-boot/GM2Dependent.h b/gcc/m2/mc-boot/GM2Dependent.h
new file mode 100644
index 00000000000..7cdbee63d26
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2Dependent.h
@@ -0,0 +1,78 @@
+/* do not edit automatically generated by mc from M2Dependent. */
+/* M2Dependent.def defines the run time module dependencies interface.
+
+Copyright (C) 2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+
+#if !defined (_M2Dependent_H)
+# define _M2Dependent_H
+
+#include "config.h"
+#include "system.h"
+# ifdef __cplusplus
+extern "C" {
+# endif
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# include "GSYSTEM.h"
+
+# if defined (_M2Dependent_C)
+# define EXTERN
+# else
+# define EXTERN extern
+# endif
+
+typedef struct M2Dependent_ArgCVEnvP_p M2Dependent_ArgCVEnvP;
+
+typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *);
+struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; };
+
+EXTERN void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+EXTERN void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*/
+
+EXTERN void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+# ifdef __cplusplus
+}
+# endif
+
+# undef EXTERN
+#endif
diff --git a/gcc/m2/mc-boot/GM2LINK.h b/gcc/m2/mc-boot/GM2LINK.h
new file mode 100644
index 00000000000..9807ab19d7e
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2LINK.h
@@ -0,0 +1,59 @@
+/* do not edit automatically generated by mc from M2LINK. */
+/* M2LINK.def defines the linking mode used in Modula-2.
+
+Copyright (C) 2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+
+#if !defined (_M2LINK_H)
+# define _M2LINK_H
+
+#include "config.h"
+#include "system.h"
+# ifdef __cplusplus
+extern "C" {
+# endif
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+
+# if defined (_M2LINK_C)
+# define EXTERN
+# else
+# define EXTERN extern
+# endif
+
+typedef char *M2LINK_PtrToChar;
+
+EXTERN M2LINK_PtrToChar M2LINK_ForcedModuleInitOrder;
+EXTERN unsigned int M2LINK_StaticInitialization;
+# ifdef __cplusplus
+}
+# endif
+
+# undef EXTERN
+#endif
diff --git a/gcc/testsuite/gm2/link/externalscaffold/pass/hello.mod b/gcc/testsuite/gm2/link/externalscaffold/pass/hello.mod
new file mode 100644
index 00000000000..75d0f651c39
--- /dev/null
+++ b/gcc/testsuite/gm2/link/externalscaffold/pass/hello.mod
@@ -0,0 +1,7 @@
+MODULE hello ;
+
+FROM libc IMPORT printf ;
+
+BEGIN
+ printf ("hello world\n")
+END hello.
diff --git a/gcc/testsuite/gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp b/gcc/testsuite/gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp
new file mode 100644
index 00000000000..7b221b4ac28
--- /dev/null
+++ b/gcc/testsuite/gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp
@@ -0,0 +1,39 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2022 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/pim/pass" -fscaffold-main -fno-scaffold-dynamic
+gm2_link_with scaffold.o
+set output [target_compile $srcdir/$subdir/scaffold.c scaffold.o object "-g"]
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c b/gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c
new file mode 100644
index 00000000000..52f4cd1460e
--- /dev/null
+++ b/gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c
@@ -0,0 +1,37 @@
+extern void exit (int);
+
+extern void _M2_SYSTEM_init (int argc, char *argv[]);
+extern void _M2_SYSTEM_fini (void);
+extern void _M2_M2RTS_init (int argc, char *argv[]);
+extern void _M2_M2RTS_fini (void);
+extern void _M2_RTExceptions_init (int argc, char *argv[]);
+extern void _M2_RTExceptions_fini (void);
+extern void _M2_hello_init (int argc, char *argv[]);
+extern void _M2_hello_fini (void);
+
+extern void M2RTS_Terminate (void);
+
+static void init (int argc, char *argv[])
+{
+ _M2_SYSTEM_init (argc, argv);
+ _M2_M2RTS_init (argc, argv);
+ _M2_RTExceptions_init (argc, argv);
+ _M2_hello_init (argc, argv);
+}
+
+static void finish (void)
+{
+ M2RTS_Terminate ();
+ _M2_hello_fini ();
+ _M2_RTExceptions_fini ();
+ _M2_M2RTS_fini ();
+ _M2_SYSTEM_fini ();
+ exit (0);
+}
+
+int main (int argc, char *argv[])
+{
+ init (argc, argv);
+ finish ();
+ return (0);
+}
diff --git a/libgm2/libm2iso/ErrnoCategory.cc b/libgm2/libm2iso/ErrnoCategory.cc
new file mode 100644
index 00000000000..70e840d352b
--- /dev/null
+++ b/libgm2/libm2iso/ErrnoCategory.cc
@@ -0,0 +1,180 @@
+/* ErrnoCatogory.cc categorizes values of errno maps onto ChanConsts.h.
+
+Copyright (C) 2008-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+
+#include "ChanConsts.h"
+
+#if defined(HAVE_ERRNO_H)
+#include "errno.h"
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include "sys/errno.h"
+#endif
+
+#include "m2rts.h"
+
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+
+/* IsErrnoHard - returns TRUE if the value of errno is associated
+ with a hard device error. */
+
+extern "C" int
+ErrnoCategory_IsErrnoHard (int e)
+{
+#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
+ return ((e == EPERM) || (e == ENOENT) || (e == EIO) || (e == ENXIO)
+ || (e == EACCES) || (e == ENOTBLK) || (e == ENODEV) || (e == EINVAL)
+ || (e == ENFILE) || (e == EROFS) || (e == EMLINK));
+#else
+ return FALSE;
+#endif
+}
+
+/* IsErrnoSoft - returns TRUE if the value of errno is associated
+ with a soft device error. */
+
+extern "C" int
+ErrnoCategory_IsErrnoSoft (int e)
+{
+#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
+ return ((e == ESRCH) || (e == EINTR) || (e == E2BIG) || (e == ENOEXEC)
+ || (e == EBADF) || (e == ECHILD) || (e == EAGAIN) || (e == ENOMEM)
+ || (e == EFAULT) || (e == EBUSY) || (e == EEXIST) || (e == EXDEV)
+ || (e == ENOTDIR) || (e == EISDIR) || (e == EMFILE) || (e == ENOTTY)
+ || (e == ETXTBSY) || (e == EFBIG) || (e == ENOSPC) || (e == EPIPE));
+#else
+ return FALSE;
+#endif
+}
+
+extern "C" int
+ErrnoCategory_UnAvailable (int e)
+{
+#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
+ return ((e == ENOENT) || (e == ESRCH) || (e == ENXIO) || (e == ECHILD)
+ || (e == ENOTBLK) || (e == ENODEV) || (e == ENOTDIR));
+#else
+ return FALSE;
+#endif
+}
+
+/* GetOpenResults - maps errno onto the ISO Modula-2 enumerated type,
+ OpenResults. */
+
+extern "C" openResults
+ErrnoCategory_GetOpenResults (int e)
+{
+ if (e == 0)
+ return opened;
+#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
+ switch (e)
+ {
+ case EPERM:
+ return wrongPermissions;
+ break;
+ case ENOENT:
+ return noSuchFile;
+ break;
+ case ENXIO:
+ return noSuchFile;
+ break;
+ case EACCES:
+ return wrongPermissions;
+ break;
+ case ENOTBLK:
+ return wrongFileType;
+ break;
+ case EEXIST:
+ return fileExists;
+ break;
+ case ENODEV:
+ return noSuchFile;
+ break;
+ case ENOTDIR:
+ return wrongFileType;
+ break;
+ case EISDIR:
+ return wrongFileType;
+ break;
+ case EINVAL:
+ return wrongFlags;
+ break;
+ case ENFILE:
+ return tooManyOpen;
+ break;
+ case EMFILE:
+ return tooManyOpen;
+ break;
+ case ENOTTY:
+ return wrongFileType;
+ break;
+ case ENOSPC:
+ return noRoomOnDevice;
+ break;
+ case EROFS:
+ return wrongPermissions;
+ break;
+
+ default:
+ return otherProblem;
+ }
+#else
+ return otherProblem;
+#endif
+}
+
+/* GNU Modula-2 linking fodder. */
+
+extern "C" void
+_M2_ErrnoCategory_init (int, char *argv[], char *env[])
+{
+}
+
+extern "C" void
+_M2_ErrnoCategory_fini (int, char *argv[], char *env[])
+{
+}
+
+extern "C" void
+_M2_ErrnoCategory_dep (void)
+{
+}
+
+struct _M2_ErrnoCategory_ctor { _M2_ErrnoCategory_ctor (); } _M2_ErrnoCategory_ctor;
+
+_M2_ErrnoCategory_ctor::_M2_ErrnoCategory_ctor (void)
+{
+ M2RTS_RegisterModule ("ErrnoCategory", _M2_ErrnoCategory_init, _M2_ErrnoCategory_fini,
+ _M2_ErrnoCategory_dep);
+}
diff --git a/libgm2/libm2iso/RTco.cc b/libgm2/libm2iso/RTco.cc
new file mode 100644
index 00000000000..9aad1561b0c
--- /dev/null
+++ b/libgm2/libm2iso/RTco.cc
@@ -0,0 +1,467 @@
+/* RTco.c provides minimal access to thread primitives.
+
+Copyright (C) 2019-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include <unistd.h>
+#include <pthread.h>
+#include <sys/select.h>
+#include <stdlib.h>
+#include <m2rts.h>
+
+// #define TRACEON
+
+#define POOL
+#define SEM_POOL 10000
+#define THREAD_POOL 10000
+
+#define _GTHREAD_USE_COND_INIT_FUNC
+#include "gthr.h"
+
+/* Ensure that ANSI conform stdio is used. This needs to be set
+ before any system header file is included. */
+#if defined __MINGW32__
+#define _POSIX 1
+#define gm2_printf gnu_printf
+#else
+#define gm2_printf __printf__
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#if defined(TRACEON)
+#define tprintf printf
+#else
+/* sizeof is not evaluated. */
+#define tprintf (void)sizeof
+#endif
+
+typedef struct threadCB_s
+{
+ void (*proc) (void);
+ int execution;
+ pthread_t p;
+ int tid;
+ unsigned int interruptLevel;
+} threadCB;
+
+
+typedef struct threadSem_s
+{
+ __gthread_mutex_t mutex;
+ __gthread_cond_t counter;
+ int waiting;
+ int sem_value;
+} threadSem;
+
+static unsigned int nThreads = 0;
+static threadCB *threadArray = NULL;
+static unsigned int nSemaphores = 0;
+static threadSem **semArray = NULL;
+
+/* These are used to lock the above module data structures. */
+static threadSem lock;
+static int initialized = FALSE;
+
+
+extern "C" int RTco_init (void);
+
+
+extern "C" void
+_M2_RTco_dep (void)
+{
+}
+
+extern "C" void
+_M2_RTco_init (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_RTco_fini (int argc, char *argv[], char *envp[])
+{
+}
+
+static void
+initSem (threadSem *sem, int value)
+{
+ __GTHREAD_COND_INIT_FUNCTION (&sem->counter);
+ __GTHREAD_MUTEX_INIT_FUNCTION (&sem->mutex);
+ sem->waiting = FALSE;
+ sem->sem_value = value;
+}
+
+static void
+waitSem (threadSem *sem)
+{
+ __gthread_mutex_lock (&sem->mutex);
+ if (sem->sem_value == 0)
+ {
+ sem->waiting = TRUE;
+ __gthread_cond_wait (&sem->counter, &sem->mutex);
+ sem->waiting = FALSE;
+ }
+ else
+ sem->sem_value--;
+ __gthread_mutex_unlock (&sem->mutex);
+}
+
+static void
+signalSem (threadSem *sem)
+{
+ __gthread_mutex_unlock (&sem->mutex);
+ if (sem->waiting)
+ __gthread_cond_signal (&sem->counter);
+ else
+ sem->sem_value++;
+ __gthread_mutex_unlock (&sem->mutex);
+}
+
+void stop (void) {}
+
+extern "C" void
+RTco_wait (int sid)
+{
+ RTco_init ();
+ tprintf ("wait %d\n", sid);
+ waitSem (semArray[sid]);
+}
+
+extern "C" void
+RTco_signal (int sid)
+{
+ RTco_init ();
+ tprintf ("signal %d\n", sid);
+ signalSem (semArray[sid]);
+}
+
+static int
+newSem (void)
+{
+#if defined(POOL)
+ semArray[nSemaphores]
+ = (threadSem *)malloc (sizeof (threadSem));
+ nSemaphores += 1;
+ if (nSemaphores == SEM_POOL)
+ M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+ "too many semaphores created");
+#else
+ threadSem *sem
+ = (threadSem *)malloc (sizeof (threadSem));
+
+ /* We need to be careful when using realloc as the lock (semaphore)
+ operators use the semaphore address. So we keep an array of pointer
+ to semaphores. */
+ if (nSemaphores == 0)
+ {
+ semArray = (threadSem **)malloc (sizeof (sem));
+ nSemaphores = 1;
+ }
+ else
+ {
+ nSemaphores += 1;
+ semArray = (threadSem **)realloc (semArray,
+ sizeof (sem) * nSemaphores);
+ }
+ semArray[nSemaphores - 1] = sem;
+#endif
+ return nSemaphores - 1;
+}
+
+static int
+initSemaphore (int value)
+{
+ int sid = newSem ();
+
+ initSem (semArray[sid], value);
+ tprintf ("%d = initSemaphore (%d)\n", sid, value);
+ return sid;
+}
+
+extern "C" int
+RTco_initSemaphore (int value)
+{
+ int sid;
+
+ RTco_init ();
+ waitSem (&lock);
+ sid = initSemaphore (value);
+ signalSem (&lock);
+ return sid;
+}
+
+/* signalThread signal the semaphore associated with thread tid. */
+
+extern "C" void
+RTco_signalThread (int tid)
+{
+ int sem;
+ RTco_init ();
+ tprintf ("signalThread %d\n", tid);
+ waitSem (&lock);
+ sem = threadArray[tid].execution;
+ signalSem (&lock);
+ RTco_signal (sem);
+}
+
+/* waitThread wait on the semaphore associated with thread tid. */
+
+extern "C" void
+RTco_waitThread (int tid)
+{
+ RTco_init ();
+ tprintf ("waitThread %d\n", tid);
+ RTco_wait (threadArray[tid].execution);
+}
+
+extern "C" int
+currentThread (void)
+{
+ int tid;
+
+ for (tid = 0; tid < nThreads; tid++)
+ if (pthread_self () == threadArray[tid].p)
+ return tid;
+ M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+ "failed to find currentThread");
+}
+
+extern "C" int
+RTco_currentThread (void)
+{
+ int tid;
+
+ RTco_init ();
+ waitSem (&lock);
+ tid = currentThread ();
+ tprintf ("currentThread %d\n", tid);
+ signalSem (&lock);
+ return tid;
+}
+
+/* currentInterruptLevel returns the interrupt level of the current thread. */
+
+extern "C" unsigned int
+RTco_currentInterruptLevel (void)
+{
+ RTco_init ();
+ tprintf ("currentInterruptLevel %d\n",
+ threadArray[RTco_currentThread ()].interruptLevel);
+ return threadArray[RTco_currentThread ()].interruptLevel;
+}
+
+/* turninterrupts returns the old interrupt level and assigns the
+ interrupt level to newLevel. */
+
+extern "C" unsigned int
+RTco_turnInterrupts (unsigned int newLevel)
+{
+ int tid = RTco_currentThread ();
+ unsigned int old = RTco_currentInterruptLevel ();
+
+ tprintf ("turnInterrupts from %d to %d\n", old, newLevel);
+ waitSem (&lock);
+ threadArray[tid].interruptLevel = newLevel;
+ signalSem (&lock);
+ return old;
+}
+
+static void
+never (void)
+{
+ M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+ "the main thread should never call here");
+}
+
+static void *
+execThread (void *t)
+{
+ threadCB *tp = (threadCB *)t;
+
+ tprintf ("exec thread tid = %d function = 0x%p arg = 0x%p\n", tp->tid,
+ tp->proc, t);
+ RTco_waitThread (
+ tp->tid); /* Forcing this thread to block, waiting to be scheduled. */
+ tprintf (" exec thread [%d] function = 0x%p arg = 0x%p\n", tp->tid,
+ tp->proc, t);
+ tp->proc (); /* Now execute user procedure. */
+#if 0
+ M2RTS_CoroutineException ( __FILE__, __LINE__, __COLUMN__, __FUNCTION__, "coroutine finishing");
+#endif
+ M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "execThread should never finish");
+ return NULL;
+}
+
+static int
+newThread (void)
+{
+#if defined(POOL)
+ nThreads += 1;
+ if (nThreads == THREAD_POOL)
+ M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "too many threads created");
+ return nThreads - 1;
+#else
+ if (nThreads == 0)
+ {
+ threadArray = (threadCB *)malloc (sizeof (threadCB));
+ nThreads = 1;
+ }
+ else
+ {
+ nThreads += 1;
+ threadArray
+ = (threadCB *)realloc (threadArray, sizeof (threadCB) * nThreads);
+ }
+ return nThreads - 1;
+#endif
+}
+
+static int
+initThread (void (*proc) (void), unsigned int stackSize,
+ unsigned int interrupt)
+{
+ int tid = newThread ();
+ pthread_attr_t attr;
+ int result;
+
+ threadArray[tid].proc = proc;
+ threadArray[tid].tid = tid;
+ threadArray[tid].execution = initSemaphore (0);
+ threadArray[tid].interruptLevel = interrupt;
+
+ /* set thread creation attributes. */
+ result = pthread_attr_init (&attr);
+ if (result != 0)
+ M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+ "failed to create thread attribute");
+
+ if (stackSize > 0)
+ {
+ result = pthread_attr_setstacksize (&attr, stackSize);
+ if (result != 0)
+ M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+ "failed to set stack size attribute");
+ }
+
+ tprintf ("initThread [%d] function = 0x%p (arg = 0x%p)\n", tid, proc,
+ (void *)&threadArray[tid]);
+ result = pthread_create (&threadArray[tid].p, &attr, execThread,
+ (void *)&threadArray[tid]);
+ if (result != 0)
+ M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "thread_create failed");
+ tprintf (" created thread [%d] function = 0x%p 0x%p\n", tid, proc,
+ (void *)&threadArray[tid]);
+ return tid;
+}
+
+extern "C" int
+RTco_initThread (void (*proc) (void), unsigned int stackSize,
+ unsigned int interrupt)
+{
+ int tid;
+
+ RTco_init ();
+ waitSem (&lock);
+ tid = initThread (proc, stackSize, interrupt);
+ signalSem (&lock);
+ return tid;
+}
+
+/* transfer unlocks thread p2 and locks the current thread. p1 is
+ updated with the current thread id. */
+
+extern "C" void
+RTco_transfer (int *p1, int p2)
+{
+ int tid = currentThread ();
+
+ if (!initialized)
+ M2RTS_Halt (
+ __FILE__, __LINE__, __FUNCTION__,
+ "cannot transfer to a process before the process has been created");
+ if (tid == p2)
+ {
+ /* error. */
+ M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+ "attempting to transfer to ourself");
+ }
+ else
+ {
+ *p1 = tid;
+ tprintf ("start, context switching from: %d to %d\n", tid, p2);
+ RTco_signalThread (p2);
+ RTco_waitThread (tid);
+ tprintf ("end, context back to %d\n", tid);
+ }
+}
+
+extern "C" int
+RTco_select (int p1, fd_set *p2, fd_set *p3, fd_set *p4, const timespec *p5)
+{
+ tprintf ("[%x] RTco.select (...)\n", pthread_self ());
+ return pselect (p1, p2, p3, p4, p5, NULL);
+}
+
+extern "C" int
+RTco_init (void)
+{
+ if (!initialized)
+ {
+ int tid;
+
+ tprintf ("RTco initialized\n");
+ initSem (&lock, 0);
+ /* Create initial thread container. */
+#if defined(POOL)
+ threadArray = (threadCB *)malloc (sizeof (threadCB) * THREAD_POOL);
+ semArray = (threadSem **)malloc (sizeof (threadSem *) * SEM_POOL);
+#endif
+ tid = newThread (); /* For the current initial thread. */
+ threadArray[tid].tid = tid;
+ threadArray[tid].execution = initSemaphore (0);
+ threadArray[tid].p = pthread_self ();
+ threadArray[tid].interruptLevel = 0;
+ threadArray[tid].proc
+ = never; /* This shouldn't happen as we are already running. */
+ initialized = TRUE;
+ tprintf ("RTco initialized completed\n");
+ signalSem (&lock);
+ }
+ return 0;
+}
+
+struct _M2_RTco_ctor { _M2_RTco_ctor (); } _M2_RTco_ctor;
+
+_M2_RTco_ctor::_M2_RTco_ctor (void)
+{
+ M2RTS_RegisterModule ("RTco", _M2_RTco_init, _M2_RTco_fini,
+ _M2_RTco_dep);
+}
diff --git a/libgm2/libm2iso/m2rts.h b/libgm2/libm2iso/m2rts.h
new file mode 100644
index 00000000000..57e6e90d94d
--- /dev/null
+++ b/libgm2/libm2iso/m2rts.h
@@ -0,0 +1,41 @@
+/* m2rts.h provides a C interface to M2RTS.mod.
+
+Copyright (C) 2019-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+
+typedef void (*proc_con) (int, char **, char **);
+typedef void (*proc_dep) (void);
+
+extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy);
+extern "C" void M2RTS_RegisterModule (const char *modulename,
+ proc_con init, proc_con fini, proc_dep dependencies);
+extern "C" void _M2_M2RTS_init (void);
+
+extern "C" void M2RTS_ConstructModules (const char *,
+ int argc, char *argv[], char *envp[]);
+extern "C" void M2RTS_Terminate (void);
+extern "C" void M2RTS_DeconstructModules (void);
+
+extern "C" void M2RTS_Halt (const char *, int, const char *, const char *) __attribute__ ((noreturn));
diff --git a/libgm2/libm2pim/Selective.cc b/libgm2/libm2pim/Selective.cc
new file mode 100644
index 00000000000..e168e3181a5
--- /dev/null
+++ b/libgm2/libm2pim/Selective.cc
@@ -0,0 +1,319 @@
+/* Selective.c provide access to timeval and select.
+
+Copyright (C) 2009-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+#include <m2rts.h>
+
+#if defined(HAVE_STDDEF_H)
+/* Obtain a definition for NULL. */
+#include <stddef.h>
+#endif
+
+#if defined(HAVE_STDIO_H)
+/* Obtain a definition for NULL. */
+#include <stdio.h>
+#endif
+
+#if defined(HAVE_SYS_TIME_H)
+#include <sys/time.h>
+#endif
+
+#if defined(HAVE_TIME_H)
+/* Obtain a definition for NULL. */
+#include <time.h>
+#endif
+
+#if defined(HAVE_STRING_H)
+/* Obtain a definition for NULL. */
+#include <string.h>
+#endif
+
+#if defined(HAVE_WCHAR_H)
+/* Obtain a definition for NULL. */
+#include <wchar.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+/* Obtain a prototype for free and malloc. */
+#include <stdlib.h>
+#endif
+
+#if defined(HAVE_SYS_TYPES_H)
+#include <sys/types.h>
+#endif
+
+#if defined(HAVE_UNISTD_H)
+#include <unistd.h>
+#endif
+
+#if !defined(NULL)
+#define NULL (void *)0
+#endif
+
+#if defined(HAVE_SELECT)
+#define FDSET_T fd_set
+#else
+#define FDSET_T void
+#endif
+
+/* Select wrap a call to the C select. */
+
+#if defined(HAVE_STRUCT_TIMEVAL)
+extern "C" int
+Selective_Select (int nooffds, fd_set *readfds, fd_set *writefds,
+ fd_set *exceptfds, struct timeval *timeout)
+{
+ return select (nooffds, readfds, writefds, exceptfds, timeout);
+}
+#else
+extern "C" int
+Selective_Select (int nooffds, void *readfds, void *writefds, void *exceptfds,
+ void *timeout)
+{
+ return 0;
+}
+#endif
+
+/* InitTime initializes a timeval structure and returns a pointer to it. */
+
+#if defined(HAVE_STRUCT_TIMEVAL)
+extern "C" struct timeval *
+Selective_InitTime (unsigned int sec, unsigned int usec)
+{
+ struct timeval *t = (struct timeval *)malloc (sizeof (struct timeval));
+
+ t->tv_sec = (long int)sec;
+ t->tv_usec = (long int)usec;
+ return t;
+}
+
+extern "C" void
+Selective_GetTime (struct timeval *t, unsigned int *sec, unsigned int *usec)
+{
+ *sec = (unsigned int)t->tv_sec;
+ *usec = (unsigned int)t->tv_usec;
+}
+
+extern "C" void
+Selective_SetTime (struct timeval *t, unsigned int sec, unsigned int usec)
+{
+ t->tv_sec = sec;
+ t->tv_usec = usec;
+}
+
+/* KillTime frees the timeval structure and returns NULL. */
+
+extern "C" struct timeval *
+Selective_KillTime (struct timeval *t)
+{
+#if defined(HAVE_STDLIB_H)
+ free (t);
+#endif
+ return NULL;
+}
+
+/* InitSet returns a pointer to a FD_SET. */
+
+extern "C" FDSET_T *
+Selective_InitSet (void)
+{
+#if defined(HAVE_STDLIB_H)
+ FDSET_T *s = (FDSET_T *)malloc (sizeof (FDSET_T));
+
+ return s;
+#else
+ return NULL
+#endif
+}
+
+/* KillSet frees the FD_SET and returns NULL. */
+
+extern "C" FDSET_T *
+Selective_KillSet (FDSET_T *s)
+{
+#if defined(HAVE_STDLIB_H)
+ free (s);
+#endif
+ return NULL;
+}
+
+/* FdZero generate an empty set. */
+
+extern "C" void
+Selective_FdZero (FDSET_T *s)
+{
+ FD_ZERO (s);
+}
+
+/* FS_Set include an element, fd, into set, s. */
+
+extern "C" void
+Selective_FdSet (int fd, FDSET_T *s)
+{
+ FD_SET (fd, s);
+}
+
+/* FdClr exclude an element, fd, from the set, s. */
+
+extern "C" void
+Selective_FdClr (int fd, FDSET_T *s)
+{
+ FD_CLR (fd, s);
+}
+
+/* FdIsSet return TRUE if, fd, is present in set, s. */
+
+extern "C" int
+Selective_FdIsSet (int fd, FDSET_T *s)
+{
+ return FD_ISSET (fd, s);
+}
+
+/* GetTimeOfDay fills in a record, Timeval, filled in with the
+ current system time in seconds and microseconds.
+ It returns zero (see man 3p gettimeofday). */
+
+extern "C" int
+Selective_GetTimeOfDay (struct timeval *t)
+{
+ return gettimeofday (t, NULL);
+}
+#else
+
+extern "C" void *
+Selective_InitTime (unsigned int sec, unsigned int usec)
+{
+ return NULL;
+}
+
+extern "C" void *
+Selective_KillTime (void *t)
+{
+ return NULL;
+}
+
+extern "C" void
+Selective_GetTime (void *t, unsigned int *sec, unsigned int *usec)
+{
+}
+
+extern "C" void
+Selective_SetTime (void *t, unsigned int sec, unsigned int usec)
+{
+}
+
+extern "C" FDSET_T *
+Selective_InitSet (void)
+{
+ return NULL;
+}
+
+extern "C" FDSET_T *
+Selective_KillSet (void)
+{
+ return NULL;
+}
+
+extern "C" void
+Selective_FdZero (void *s)
+{
+}
+
+extern "C" void
+Selective_FdSet (int fd, void *s)
+{
+}
+
+extern "C" void
+Selective_FdClr (int fd, void *s)
+{
+}
+
+extern "C" int
+Selective_FdIsSet (int fd, void *s)
+{
+ return 0;
+}
+
+extern "C" int
+Selective_GetTimeOfDay (void *t)
+{
+ return -1;
+}
+#endif
+
+/* MaxFdsPlusOne returns max (a + 1, b + 1). */
+
+extern "C" int
+Selective_MaxFdsPlusOne (int a, int b)
+{
+ if (a > b)
+ return a + 1;
+ else
+ return b + 1;
+}
+
+/* WriteCharRaw writes a single character to the file descriptor. */
+
+extern "C" void
+Selective_WriteCharRaw (int fd, char ch)
+{
+ write (fd, &ch, 1);
+}
+
+/* ReadCharRaw read and return a single char from file descriptor, fd. */
+
+extern "C" char
+Selective_ReadCharRaw (int fd)
+{
+ char ch;
+
+ read (fd, &ch, 1);
+ return ch;
+}
+
+extern "C" void
+_M2_Selective_init (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_Selective_finish (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_Selective_dep (void)
+{
+}
+
+struct _M2_Selective_ctor { _M2_Selective_ctor (); } _M2_Selective_ctor;
+
+_M2_Selective_ctor::_M2_Selective_ctor (void)
+{
+ M2RTS_RegisterModule ("Selective", _M2_Selective_init, _M2_Selective_finish,
+ _M2_Selective_dep);
+}
diff --git a/libgm2/libm2pim/SysExceptions.cc b/libgm2/libm2pim/SysExceptions.cc
new file mode 100644
index 00000000000..780b097aaa6
--- /dev/null
+++ b/libgm2/libm2pim/SysExceptions.cc
@@ -0,0 +1,259 @@
+/* SysExceptions.c configure the signals to create m2 exceptions.
+
+Copyright (C) 2009-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#if defined(HAVE_SIGNAL_H)
+#include <signal.h>
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#include <errno.h>
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include <sys/errno.h>
+#endif
+
+#if defined(HAVE_STDIO_H)
+#include <stdio.h>
+#endif
+
+#include "m2rts.h"
+
+#if 0
+/* Signals. */
+#define SIGHUP 1 /* Hangup (POSIX). */
+#define SIGINT 2 /* Interrupt (ANSI). */
+#define SIGQUIT 3 /* Quit (POSIX). */
+#define SIGILL 4 /* Illegal instruction (ANSI). */
+#define SIGTRAP 5 /* Trace trap (POSIX). */
+#define SIGABRT 6 /* Abort (ANSI). */
+#define SIGIOT 6 /* IOT trap (4.2 BSD). */
+#define SIGBUS 7 /* BUS error (4.2 BSD). */
+#define SIGFPE 8 /* Floating-point exception (ANSI). */
+#define SIGKILL 9 /* Kill, unblockable (POSIX). */
+#define SIGUSR1 10 /* User-defined signal 1 (POSIX). */
+#define SIGSEGV 11 /* Segmentation violation (ANSI). */
+#define SIGUSR2 12 /* User-defined signal 2 (POSIX). */
+#define SIGPIPE 13 /* Broken pipe (POSIX). */
+#define SIGALRM 14 /* Alarm clock (POSIX). */
+#define SIGTERM 15 /* Termination (ANSI). */
+#define SIGSTKFLT 16 /* Stack fault. */
+#define SIGCLD SIGCHLD /* Same as SIGCHLD (System V). */
+#define SIGCHLD 17 /* Child status has changed (POSIX). */
+#define SIGCONT 18 /* Continue (POSIX). */
+#define SIGSTOP 19 /* Stop, unblockable (POSIX). */
+#define SIGTSTP 20 /* Keyboard stop (POSIX). */
+#define SIGTTIN 21 /* Background read from tty (POSIX). */
+#define SIGTTOU 22 /* Background write to tty (POSIX). */
+#define SIGURG 23 /* Urgent condition on socket (4.2 BSD). */
+#define SIGXCPU 24 /* CPU limit exceeded (4.2 BSD). */
+#define SIGXFSZ 25 /* File size limit exceeded (4.2 BSD). */
+#define SIGVTALRM 26 /* Virtual alarm clock (4.2 BSD). */
+#define SIGPROF 27 /* Profiling alarm clock (4.2 BSD). */
+#define SIGWINCH 28 /* Window size change (4.3 BSD, Sun). */
+#define SIGPOLL SIGIO /* Pollable event occurred (System V). */
+#define SIGIO 29 /* I/O now possible (4.2 BSD). */
+#define SIGPWR 30 /* Power failure restart (System V). */
+#define SIGSYS 31 /* Bad system call. */
+#define SIGUNUSED 31
+
+/* The list of Modula-2 exceptions is shown below */
+
+ (indexException, rangeException, caseSelectException, invalidLocation,
+ functionException, wholeValueException, wholeDivException, realValueException,
+ realDivException, complexValueException, complexDivException, protException,
+ sysException, coException, exException
+ );
+
+#endif
+
+/* Note: wholeDivException and realDivException are caught by SIGFPE
+ and depatched to the appropriate Modula-2 runtime routine upon
+ testing FPE_INTDIV or FPE_FLTDIV. realValueException is also
+ caught by SIGFPE and dispatched by testing FFE_FLTOVF or FPE_FLTUND
+ or FPE_FLTRES or FPE_FLTINV. indexException is caught by SIGFPE
+ and dispatched by FPE_FLTSUB. */
+
+#if defined(HAVE_SIGNAL_H)
+static struct sigaction sigbus;
+static struct sigaction sigfpe;
+static struct sigaction sigsegv;
+
+static void (*indexProc) (void *);
+static void (*rangeProc) (void *);
+static void (*assignmentrangeProc) (void *);
+static void (*caseProc) (void *);
+static void (*invalidlocProc) (void *);
+static void (*functionProc) (void *);
+static void (*wholevalueProc) (void *);
+static void (*wholedivProc) (void *);
+static void (*realvalueProc) (void *);
+static void (*realdivProc) (void *);
+static void (*complexvalueProc) (void *);
+static void (*complexdivProc) (void *);
+static void (*protectionProc) (void *);
+static void (*systemProc) (void *);
+static void (*coroutineProc) (void *);
+static void (*exceptionProc) (void *);
+
+static void
+sigbusDespatcher (int signum, siginfo_t *info, void *ucontext)
+{
+ switch (signum)
+ {
+
+ case SIGSEGV:
+ case SIGBUS:
+ if (info)
+ (*invalidlocProc) (info->si_addr);
+ break;
+ default:
+ perror ("not expecting to arrive here with this signal");
+ }
+}
+
+static void
+sigfpeDespatcher (int signum, siginfo_t *info, void *ucontext)
+{
+ switch (signum)
+ {
+
+ case SIGFPE:
+ if (info)
+ {
+ if (info->si_code | FPE_INTDIV)
+ (*wholedivProc) (info->si_addr); /* Integer divide by zero. */
+ if (info->si_code | FPE_INTOVF)
+ (*wholevalueProc) (info->si_addr); /* Integer overflow. */
+ if (info->si_code | FPE_FLTDIV)
+ (*realdivProc) (info->si_addr); /* Floating-point divide by zero. */
+ if (info->si_code | FPE_FLTOVF)
+ (*realvalueProc) (info->si_addr); /* Floating-point overflow. */
+ if (info->si_code | FPE_FLTUND)
+ (*realvalueProc) (info->si_addr); /* Floating-point underflow. */
+ if (info->si_code | FPE_FLTRES)
+ (*realvalueProc) (
+ info->si_addr); /* Floating-point inexact result. */
+ if (info->si_code | FPE_FLTINV)
+ (*realvalueProc) (
+ info->si_addr); /* Floating-point invalid result. */
+ if (info->si_code | FPE_FLTSUB)
+ (*indexProc) (info->si_addr); /* Subscript out of range. */
+ }
+ break;
+ default:
+ perror ("not expecting to arrive here with this signal");
+ }
+}
+
+extern "C" void
+SysExceptions_InitExceptionHandlers (
+ void (*indexf) (void *), void (*range) (void *), void (*casef) (void *),
+ void (*invalidloc) (void *), void (*function) (void *),
+ void (*wholevalue) (void *), void (*wholediv) (void *),
+ void (*realvalue) (void *), void (*realdiv) (void *),
+ void (*complexvalue) (void *), void (*complexdiv) (void *),
+ void (*protection) (void *), void (*systemf) (void *),
+ void (*coroutine) (void *), void (*exception) (void *))
+{
+ struct sigaction old;
+
+ indexProc = indexf;
+ rangeProc = range;
+ caseProc = casef;
+ invalidlocProc = invalidloc;
+ functionProc = function;
+ wholevalueProc = wholevalue;
+ wholedivProc = wholediv;
+ realvalueProc = realvalue;
+ realdivProc = realdiv;
+ complexvalueProc = complexvalue;
+ complexdivProc = complexdiv;
+ protectionProc = protection;
+ systemProc = systemf;
+ coroutineProc = coroutine;
+ exceptionProc = exception;
+
+ sigbus.sa_sigaction = sigbusDespatcher;
+ sigbus.sa_flags = (SA_SIGINFO);
+ sigemptyset (&sigbus.sa_mask);
+
+ if (sigaction (SIGBUS, &sigbus, &old) != 0)
+ perror ("unable to install the sigbus signal handler");
+
+ sigsegv.sa_sigaction = sigbusDespatcher;
+ sigsegv.sa_flags = (SA_SIGINFO);
+ sigemptyset (&sigsegv.sa_mask);
+
+ if (sigaction (SIGSEGV, &sigsegv, &old) != 0)
+ perror ("unable to install the sigsegv signal handler");
+
+ sigfpe.sa_sigaction = sigfpeDespatcher;
+ sigfpe.sa_flags = (SA_SIGINFO);
+ sigemptyset (&sigfpe.sa_mask);
+
+ if (sigaction (SIGFPE, &sigfpe, &old) != 0)
+ perror ("unable to install the sigfpe signal handler");
+}
+
+#else
+extern "C" void
+SysExceptions_InitExceptionHandlers (void *indexf, void *range, void *casef,
+ void *invalidloc, void *function,
+ void *wholevalue, void *wholediv,
+ void *realvalue, void *realdiv,
+ void *complexvalue, void *complexdiv,
+ void *protection, void *systemf,
+ void *coroutine, void *exception)
+{
+}
+#endif
+
+
+extern "C" void
+_M2_SysExceptions_init (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_SysExceptions_fini (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_SysExceptions_dep (void)
+{
+}
+
+struct _M2_SysExceptions_ctor { _M2_SysExceptions_ctor (); } _M2_SysExceptions_ctor;
+
+_M2_SysExceptions_ctor::_M2_SysExceptions_ctor (void)
+{
+ M2RTS_RegisterModule ("SysExceptions", _M2_SysExceptions_init, _M2_SysExceptions_fini,
+ _M2_SysExceptions_dep);
+}
diff --git a/libgm2/libm2pim/UnixArgs.cc b/libgm2/libm2pim/UnixArgs.cc
new file mode 100644
index 00000000000..0d6c76e3bc5
--- /dev/null
+++ b/libgm2/libm2pim/UnixArgs.cc
@@ -0,0 +1,91 @@
+/* UnixArgs.cc record argc, argv as global variables.
+
+Copyright (C) 2009-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+#include <m2rts.h>
+
+
+extern "C" int UnixArgs_GetArgC (void);
+extern "C" char **UnixArgs_GetArgV (void);
+extern "C" char **UnixArgs_GetEnvV (void);
+
+static int UnixArgs_ArgC;
+static char **UnixArgs_ArgV;
+static char **UnixArgs_EnvV;
+
+
+/* GetArgC returns argc. */
+
+extern "C" int
+UnixArgs_GetArgC (void)
+{
+ return UnixArgs_ArgC;
+}
+
+
+/* GetArgV returns argv. */
+
+extern "C" char **
+UnixArgs_GetArgV (void)
+{
+ return UnixArgs_ArgV;
+}
+
+
+/* GetEnvV returns envv. */
+
+extern "C" char **
+UnixArgs_GetEnvV (void)
+{
+ return UnixArgs_EnvV;
+}
+
+
+extern "C" void
+_M2_UnixArgs_init (int argc, char *argv[], char *envp[])
+{
+ UnixArgs_ArgC = argc;
+ UnixArgs_ArgV = argv;
+ UnixArgs_EnvV = envp;
+}
+
+extern "C" void
+_M2_UnixArgs_finish (int argc, char *argv[], char *envp[])
+{
+}
+
+extern "C" void
+_M2_UnixArgs_dep (void)
+{
+}
+
+struct _M2_UnixArgs_ctor { _M2_UnixArgs_ctor (); } _M2_UnixArgs_ctor;
+
+_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
+{
+ M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_finish,
+ _M2_UnixArgs_dep);
+}
diff --git a/libgm2/libm2pim/dtoa.cc b/libgm2/libm2pim/dtoa.cc
new file mode 100644
index 00000000000..d0ca0b096e9
--- /dev/null
+++ b/libgm2/libm2pim/dtoa.cc
@@ -0,0 +1,265 @@
+/* dtoa.cc convert double to ascii and visa versa.
+
+Copyright (C) 2009-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#define GM2
+
+#include <config.h>
+#include <m2rts.h>
+
+#if defined(HAVE_STRINGS)
+#include <strings.h>
+#endif
+
+#if defined(HAVE_STRING)
+#include <string.h>
+#endif
+
+#if defined(HAVE_STDDEF_H)
+/* Obtain a definition for NULL. */
+#include <stddef.h>
+#endif
+
+#if defined(HAVE_STDIO_H)
+/* Obtain a definition for NULL. */
+#include <stdio.h>
+#endif
+
+#if defined(HAVE_TIME_H)
+/* Obtain a definition for NULL. */
+#include <time.h>
+#endif
+
+#if defined(HAVE_STRING_H)
+/* Obtain a definition for NULL. */
+#include <string.h>
+#endif
+
+#if defined(HAVE_WCHAR_H)
+/* Obtain a definition for NULL. */
+#include <wchar.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+/* Obtain a prototype for free and malloc. */
+#include <stdlib.h>
+#endif
+
+#if !defined(NULL)
+#define NULL (void *)0
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#if defined(HAVE_STDLIB_H)
+#if !defined(_ISOC99_SOURCE)
+#define _ISOC99_SOURCE
+#endif
+#include <stdlib.h>
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#include <errno.h>
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include <sys/errno.h>
+#endif
+
+#if defined(HAVE_STRING_H)
+
+#define MAX_FP_DIGITS 500
+
+typedef enum Mode { maxsignicant, decimaldigits } Mode;
+
+/* maxsignicant: return a string containing max(1,ndigits) significant
+ digits. The return string contains the string produced by ecvt.
+
+ decimaldigits: return a string produced by fcvt. The string will
+ contain ndigits past the decimal point (ndigits may be negative). */
+
+extern "C" double
+dtoa_strtod (const char *s, int *error)
+{
+ char *endp;
+ double d;
+
+#if defined(HAVE_ERRNO_H)
+ errno = 0;
+#endif
+ d = strtod (s, &endp);
+ if (endp != NULL && (*endp == '\0'))
+#if defined(HAVE_ERRNO_H)
+ *error = (errno != 0);
+#else
+ *error = FALSE;
+#endif
+ else
+ *error = TRUE;
+ return d;
+}
+
+/* dtoa_calcmaxsig calculates the position of the decimal point
+ it also removes the decimal point and exponent from string, p. */
+
+extern "C" int
+dtoa_calcmaxsig (char *p, int ndigits)
+{
+ char *e;
+ char *o;
+ int x;
+
+ e = index (p, 'E');
+ if (e == NULL)
+ x = 0;
+ else
+ {
+ *e = (char)0;
+ x = atoi (e + 1);
+ }
+
+ o = index (p, '.');
+ if (o == NULL)
+ return strlen (p) + x;
+ else
+ {
+ memmove (o, o + 1, ndigits - (o - p));
+ return o - p + x;
+ }
+}
+
+/* dtoa_calcdecimal calculates the position of the decimal point
+ it also removes the decimal point and exponent from string, p.
+ It truncates the digits in p accordingly to ndigits.
+ Ie ndigits is the number of digits after the '.'. */
+
+extern "C" int
+dtoa_calcdecimal (char *p, int str_size, int ndigits)
+{
+ char *e;
+ char *o;
+ int x;
+ int l;
+
+ e = index (p, 'E');
+ if (e == NULL)
+ x = 0;
+ else
+ {
+ *e = (char)0;
+ x = atoi (e + 1);
+ }
+
+ l = strlen (p);
+ o = index (p, '.');
+ if (o == NULL)
+ x += strlen (p);
+ else
+ {
+ int m = strlen (o);
+ memmove (o, o + 1, l - (o - p));
+ if (m > 0)
+ o[m - 1] = '0';
+ x += o - p;
+ }
+ if ((x + ndigits >= 0) && (x + ndigits < str_size))
+ p[x + ndigits] = (char)0;
+ return x;
+}
+
+extern "C" int
+dtoa_calcsign (char *p, int str_size)
+{
+ if (p[0] == '-')
+ {
+ memmove (p, p + 1, str_size - 1);
+ return TRUE;
+ }
+ else
+ return FALSE;
+}
+
+extern "C" char *
+dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign)
+{
+ char format[50];
+ char *p;
+ int r;
+ switch (mode)
+ {
+
+ case maxsignicant:
+ ndigits += 20; /* Enough for exponent. */
+ p = (char *) malloc (ndigits);
+ snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "E");
+ snprintf (p, ndigits, format, d);
+ *sign = dtoa_calcsign (p, ndigits);
+ *decpt = dtoa_calcmaxsig (p, ndigits);
+ return p;
+ case decimaldigits:
+ p = (char *) malloc (MAX_FP_DIGITS + 20);
+ snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "E");
+ snprintf (p, MAX_FP_DIGITS + 20, format, d);
+ *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
+ *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ return p;
+ default:
+ abort ();
+ }
+}
+
+#endif
+
+#if defined(GM2)
+/* GNU Modula-2 linking hooks. */
+
+extern "C" void
+_M2_dtoa_init (int, char **, char **)
+{
+}
+
+extern "C" void
+_M2_dtoa_finish (int, char **, char **)
+{
+}
+
+extern "C" void
+_M2_dtoa_dep (void)
+{
+}
+
+struct _M2_dtoa_ctor { _M2_dtoa_ctor (); } _M2_dtoa_ctor;
+
+_M2_dtoa_ctor::_M2_dtoa_ctor (void)
+{
+ M2RTS_RegisterModule ("dtoa", _M2_dtoa_init, _M2_dtoa_finish,
+ _M2_dtoa_dep);
+}
+#endif
diff --git a/libgm2/libm2pim/errno.cc b/libgm2/libm2pim/errno.cc
new file mode 100644
index 00000000000..d47b7b75253
--- /dev/null
+++ b/libgm2/libm2pim/errno.cc
@@ -0,0 +1,70 @@
+/* errno.c provide access to the errno value.
+
+Copyright (C) 2009-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include <sys/errno.h>
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#include <errno.h>
+#endif
+
+#include "m2rts.h"
+
+extern "C" int
+errno_geterrno (void)
+{
+#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
+ return errno;
+#else
+ return -1;
+#endif
+}
+
+extern "C" void
+_M2_errno_init (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_errno_fini (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_errno_dep (void)
+{
+}
+
+struct _M2_errno_ctor { _M2_errno_ctor (); } _M2_errno_ctor;
+
+_M2_errno_ctor::_M2_errno_ctor (void)
+{
+ M2RTS_RegisterModule ("errno", _M2_errno_init, _M2_errno_fini,
+ _M2_errno_dep);
+}
diff --git a/libgm2/libm2pim/ldtoa.cc b/libgm2/libm2pim/ldtoa.cc
new file mode 100644
index 00000000000..311126c0146
--- /dev/null
+++ b/libgm2/libm2pim/ldtoa.cc
@@ -0,0 +1,190 @@
+/* ldtoa.c convert long double to ascii and visa versa.
+
+Copyright (C) 2009-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#define GM2
+
+#include <config.h>
+#include <m2rts.h>
+
+#if defined(HAVE_STRINGS)
+#include <strings.h>
+#endif
+
+#if defined(HAVE_STRING)
+#include <string.h>
+#endif
+
+#if defined(HAVE_STDDEF_H)
+/* Obtain a definition for NULL. */
+#include <stddef.h>
+#endif
+
+#if defined(HAVE_STDIO_H)
+/* Obtain a definition for NULL. */
+#include <stdio.h>
+#endif
+
+#if defined(HAVE_TIME_H)
+/* Obtain a definition for NULL. */
+#include <time.h>
+#endif
+
+#if defined(HAVE_STRING_H)
+/* Obtain a definition for NULL. */
+#include <string.h>
+#endif
+
+#if defined(HAVE_WCHAR_H)
+/* Obtain a definition for NULL. */
+#include <wchar.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+#if !defined(_ISOC99_SOURCE)
+#define _ISOC99_SOURCE
+#endif
+#include <stdlib.h>
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#include <errno.h>
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include <sys/errno.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+/* Obtain a prototype for free and malloc. */
+#include <stdlib.h>
+#endif
+
+#if !defined(NULL)
+#define NULL (void *)0
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#define MAX_FP_DIGITS 500
+
+typedef enum Mode { maxsignicant, decimaldigits } Mode;
+
+extern "C" int dtoa_calcmaxsig (char *p, int ndigits);
+extern "C" int dtoa_calcdecimal (char *p, int str_size, int ndigits);
+extern "C" int dtoa_calcsign (char *p, int str_size);
+
+/* maxsignicant return a string containing max(1,ndigits) significant
+ digits. The return string contains the string produced by snprintf.
+
+ decimaldigits: return a string produced by fcvt. The string will
+ contain ndigits past the decimal point (ndigits may be negative). */
+
+extern "C" long double
+ldtoa_strtold (const char *s, int *error)
+{
+ char *endp;
+ long double d;
+
+#if defined(HAVE_ERRNO_H)
+ errno = 0;
+#endif
+#if defined(HAVE_STRTOLD)
+ d = strtold (s, &endp);
+#else
+ /* Fall back to using strtod. */
+ d = (long double)strtod (s, &endp);
+#endif
+ if (endp != NULL && (*endp == '\0'))
+#if defined(HAVE_ERRNO_H)
+ *error = (errno != 0);
+#else
+ *error = FALSE;
+#endif
+ else
+ *error = TRUE;
+ return d;
+}
+
+extern "C" char *
+ldtoa_ldtoa (long double d, int mode, int ndigits, int *decpt, int *sign)
+{
+ char format[50];
+ char *p;
+ int r;
+ switch (mode)
+ {
+
+ case maxsignicant:
+ ndigits += 20; /* Enough for exponent. */
+ p = (char *) malloc (ndigits);
+ snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "LE");
+ snprintf (p, ndigits, format, d);
+ *sign = dtoa_calcsign (p, ndigits);
+ *decpt = dtoa_calcmaxsig (p, ndigits);
+ return p;
+ case decimaldigits:
+ p = (char *) malloc (MAX_FP_DIGITS + 20);
+ snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "LE");
+ snprintf (p, MAX_FP_DIGITS + 20, format, d);
+ *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
+ *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ return p;
+ default:
+ abort ();
+ }
+}
+
+#if defined(GM2)
+/* GNU Modula-2 linking hooks. */
+
+extern "C" void
+_M2_ldtoa_init (int, char **, char **)
+{
+}
+
+extern "C" void
+_M2_ldtoa_finish (int, char **, char **)
+{
+}
+
+extern "C" void
+_M2_ldtoa_dep (void)
+{
+}
+
+struct _M2_ldtoa_ctor { _M2_ldtoa_ctor (); } _M2_ldtoa_ctor;
+
+_M2_ldtoa_ctor::_M2_ldtoa_ctor (void)
+{
+ M2RTS_RegisterModule ("ldtoa", _M2_ldtoa_init, _M2_ldtoa_finish,
+ _M2_ldtoa_dep);
+}
+#endif
diff --git a/libgm2/libm2pim/sckt.cc b/libgm2/libm2pim/sckt.cc
new file mode 100644
index 00000000000..6c68525acb0
--- /dev/null
+++ b/libgm2/libm2pim/sckt.cc
@@ -0,0 +1,430 @@
+/* sckt.c provide access to the socket layer.
+
+Copyright (C) 2005-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+#include <m2rts.h>
+
+#if defined(HAVE_SYS_TYPES_H)
+#include <sys/types.h>
+#endif
+
+#if defined(HAVE_SYS_SOCKET_H)
+#include <sys/socket.h>
+#endif
+
+#if defined(HAVE_NETINET_IN_H)
+#include <netinet/in.h>
+#endif
+
+#if defined(HAVE_NETDB_H)
+#include <netdb.h>
+#endif
+
+#if defined(HAVE_UNISTD_H)
+#include <unistd.h>
+#endif
+
+#if defined(HAVE_SIGNAL_H)
+#include <signal.h>
+#endif
+
+#if defined(HAVE_SYS_ERRNO_H)
+#include <sys/errno.h>
+#endif
+
+#if defined(HAVE_ERRNO_H)
+#include <errno.h>
+#endif
+
+#if defined(HAVE_MALLOC_H)
+#include <malloc.h>
+#endif
+
+#if defined(HAVE_STRING_H)
+#include <string.h>
+#endif
+
+#if defined(HAVE_STDLIB_H)
+#include <stdlib.h>
+#endif
+
+#if defined(HAVE_STDIO_H)
+#include <stdio.h>
+#endif
+
+#define PORTSTART 7000
+#define NOOFTRIES 100
+#define MAXHOSTNAME 256
+
+#undef DEBUGGING
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#if defined(HAVE_SYS_SOCKET_H)
+
+#define ERROR(X) \
+ { \
+ printf ("%s:%d:%s\n", __FILE__, __LINE__, X); \
+ localExit (1); \
+ }
+
+#define ASSERT(X) \
+ { \
+ if (!(X)) \
+ { \
+ printf ("%s:%d: assert(%s) failed\n", __FILE__, __LINE__, #X); \
+ exit (1); \
+ } \
+ }
+
+typedef struct
+{
+ char hostname[MAXHOSTNAME];
+ struct hostent *hp;
+ struct sockaddr_in sa, isa;
+ int sockFd;
+ int portNo;
+} tcpServerState;
+
+int
+localExit (int i)
+{
+ exit (1);
+}
+
+/* tcpServerEstablishPort returns a tcpState containing the relevant
+ information about a socket declared to receive tcp connections.
+ This method attempts to use the port specified by the parameter. */
+
+extern "C" tcpServerState *
+tcpServerEstablishPort (int portNo)
+{
+ tcpServerState *s = (tcpServerState *)malloc (sizeof (tcpServerState));
+ int b, p, n;
+
+ if (s == NULL)
+ ERROR ("no more memory");
+
+ /* Remove SIGPIPE which is raised on the server if the client is killed. */
+ signal (SIGPIPE, SIG_IGN);
+
+ if (gethostname (s->hostname, MAXHOSTNAME) < 0)
+ ERROR ("cannot find our hostname");
+
+ s->hp = gethostbyname (s->hostname);
+ if (s->hp == NULL)
+ ERROR ("cannot get host name");
+
+ p = -1;
+ n = 0;
+ do
+ {
+ p++;
+ /* Open a TCP socket (an Internet stream socket). */
+
+ s->sockFd = socket (s->hp->h_addrtype, SOCK_STREAM, 0);
+ if (s->sockFd < 0)
+ ERROR ("socket");
+
+ memset ((void *)&s->sa, 0, sizeof (s->sa));
+ ASSERT ((s->hp->h_addrtype == AF_INET));
+ s->sa.sin_family = s->hp->h_addrtype;
+ s->sa.sin_addr.s_addr = htonl (INADDR_ANY);
+ s->sa.sin_port = htons (portNo + p);
+
+ b = bind (s->sockFd, (struct sockaddr *)&s->sa, sizeof (s->sa));
+ }
+ while ((b < 0) && (n < NOOFTRIES));
+
+ if (b < 0)
+ ERROR ("bind");
+
+ s->portNo = portNo + p;
+#if defined(DEBUGGING)
+ printf ("the receiving host is: %s, the port is %d\n", s->hostname,
+ s->portNo);
+#endif
+ listen (s->sockFd, 1);
+ return s;
+}
+
+/* tcpServerEstablish returns a tcpServerState containing the relevant
+ information about a socket declared to receive tcp connections. */
+
+extern "C" tcpServerState *
+tcpServerEstablish (void)
+{
+ return tcpServerEstablishPort (PORTSTART);
+}
+
+/* tcpServerAccept returns a file descriptor once a client has connected and
+ been accepted. */
+
+extern "C" int
+tcpServerAccept (tcpServerState *s)
+{
+ socklen_t i = sizeof (s->isa);
+ int t;
+
+#if defined(DEBUGGING)
+ printf ("before accept %d\n", s->sockFd);
+#endif
+ t = accept (s->sockFd, (struct sockaddr *)&s->isa, &i);
+ return t;
+}
+
+/* tcpServerPortNo returns the portNo from structure, s. */
+
+extern "C" int
+tcpServerPortNo (tcpServerState *s)
+{
+ return s->portNo;
+}
+
+/* tcpServerSocketFd returns the sockFd from structure, s. */
+
+extern "C" int
+tcpServerSocketFd (tcpServerState *s)
+{
+ return s->sockFd;
+}
+
+/* getLocalIP returns the IP address of this machine. */
+
+extern "C" unsigned int
+getLocalIP (tcpServerState *s)
+{
+ char hostname[1024];
+ struct hostent *hp;
+ struct sockaddr_in sa;
+ unsigned int ip;
+ int ret = gethostname (hostname, sizeof (hostname));
+
+ if (ret == -1)
+ {
+ ERROR ("gethostname");
+ return 0;
+ }
+
+ hp = gethostbyname (hostname);
+ if (hp == NULL)
+ {
+ ERROR ("gethostbyname");
+ return 0;
+ }
+
+ if (sizeof (unsigned int) != sizeof (in_addr_t))
+ {
+ ERROR ("bad ip length");
+ return 0;
+ }
+
+ memset (&sa, sizeof (struct sockaddr_in), 0);
+ sa.sin_family = AF_INET;
+ sa.sin_port = htons (80);
+ if (hp->h_length == sizeof (unsigned int))
+ {
+ memcpy (&ip, hp->h_addr_list[0], hp->h_length);
+ return ip;
+ }
+
+ return 0;
+}
+
+/* tcpServerIP returns the IP address from structure s. */
+
+extern "C" int
+tcpServerIP (tcpServerState *s)
+{
+ return *((int *)s->hp->h_addr_list[0]);
+}
+
+/* tcpServerClientIP returns the IP address of the client who
+ has connected to server s. */
+
+extern "C" unsigned int
+tcpServerClientIP (tcpServerState *s)
+{
+ unsigned int ip;
+
+ ASSERT (s->isa.sin_family == AF_INET);
+ ASSERT (sizeof (ip) == 4);
+ memcpy (&ip, &s->isa.sin_addr, sizeof (ip));
+ return ip;
+}
+
+/* tcpServerClientPortNo returns the port number of the client who
+ has connected to server s. */
+
+extern "C" unsigned int
+tcpServerClientPortNo (tcpServerState *s)
+{
+ return s->isa.sin_port;
+}
+
+/*
+****************************************************************
+*** C L I E N T R O U T I N E S
+****************************************************************
+ */
+
+typedef struct
+{
+ char hostname[MAXHOSTNAME];
+ struct hostent *hp;
+ struct sockaddr_in sa;
+ int sockFd;
+ int portNo;
+} tcpClientState;
+
+/* tcpClientSocket returns a file descriptor (socket) which has
+ connected to, serverName:portNo. */
+
+extern "C" tcpClientState *
+tcpClientSocket (char *serverName, int portNo)
+{
+ tcpClientState *s = (tcpClientState *)malloc (sizeof (tcpClientState));
+
+ if (s == NULL)
+ ERROR ("no more memory");
+
+ /* Remove SIGPIPE which is raised on the server if the client is killed. */
+ signal (SIGPIPE, SIG_IGN);
+
+ s->hp = gethostbyname (serverName);
+ if (s->hp == NULL)
+ {
+ fprintf (stderr, "cannot find host: %s\n", serverName);
+ exit (1);
+ }
+
+ memset ((void *)&s->sa, 0, sizeof (s->sa));
+ s->sa.sin_family = AF_INET;
+ memcpy ((void *)&s->sa.sin_addr, (void *)s->hp->h_addr, s->hp->h_length);
+ s->portNo = portNo;
+ s->sa.sin_port = htons (portNo);
+
+ /* Open a TCP socket (an Internet stream socket). */
+
+ s->sockFd = socket (s->hp->h_addrtype, SOCK_STREAM, 0);
+ return s;
+}
+
+/* tcpClientSocketIP returns a file descriptor (socket) which has
+ connected to, ip:portNo. */
+
+extern "C" tcpClientState *
+tcpClientSocketIP (unsigned int ip, int portNo)
+{
+ tcpClientState *s = (tcpClientState *)malloc (sizeof (tcpClientState));
+
+ if (s == NULL)
+ ERROR ("no more memory");
+
+ /* Remove SIGPIPE which is raised on the server if the client is killed. */
+ signal (SIGPIPE, SIG_IGN);
+
+ memset ((void *)&s->sa, 0, sizeof (s->sa));
+ s->sa.sin_family = AF_INET;
+ memcpy ((void *)&s->sa.sin_addr, (void *)&ip, sizeof (ip));
+ s->portNo = portNo;
+ s->sa.sin_port = htons (portNo);
+
+ /* Open a TCP socket (an Internet stream socket). */
+
+ s->sockFd = socket (PF_INET, SOCK_STREAM, 0);
+ return s;
+}
+
+/* tcpClientConnect returns the file descriptor associated with s,
+ once a connect has been performed. */
+
+extern "C" int
+tcpClientConnect (tcpClientState *s)
+{
+ if (connect (s->sockFd, (struct sockaddr *)&s->sa, sizeof (s->sa)) < 0)
+ ERROR ("failed to connect to the TCP server");
+
+ return s->sockFd;
+}
+
+/* tcpClientPortNo returns the portNo from structure s. */
+
+extern "C" int
+tcpClientPortNo (tcpClientState *s)
+{
+ return s->portNo;
+}
+
+/* tcpClientSocketFd returns the sockFd from structure s. */
+
+extern "C" int
+tcpClientSocketFd (tcpClientState *s)
+{
+ return s->sockFd;
+}
+
+/* tcpClientIP returns the sockFd from structure s. */
+
+extern "C" int
+tcpClientIP (tcpClientState *s)
+{
+#if defined(DEBUGGING)
+ printf ("client ip = %s\n", inet_ntoa (s->sa.sin_addr.s_addr));
+#endif
+ return s->sa.sin_addr.s_addr;
+}
+#endif
+
+/* GNU Modula-2 link fodder. */
+
+extern "C" void
+_M2_sckt_init (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_sckt_finish (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_sckt_dep (void)
+{
+}
+
+struct _M2_sckt_ctor { _M2_sckt_ctor (); } _M2_sckt_ctor;
+
+_M2_sckt_ctor::_M2_sckt_ctor (void)
+{
+ M2RTS_RegisterModule ("sckt", _M2_sckt_init, _M2_sckt_finish,
+ _M2_sckt_dep);
+}
diff --git a/libgm2/libm2pim/termios.cc b/libgm2/libm2pim/termios.cc
new file mode 100644
index 00000000000..3015ee1380d
--- /dev/null
+++ b/libgm2/libm2pim/termios.cc
@@ -0,0 +1,1987 @@
+/* termios.cc provide access to the terminal.
+
+Copyright (C) 2010-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+#include <m2rts.h>
+
+#if defined(HAVE_STDIO_H)
+#include <stdio.h>
+#endif
+#if defined(HAVE_STDARG_H)
+#include <stdarg.h>
+#endif
+#if defined(HAVE_STDLIB_H)
+#include <stdlib.h>
+#endif
+#if defined(HAVE_STRING_H)
+#include <string.h>
+#endif
+#if defined(HAVE_STRINGS_H)
+#include <strings.h>
+#endif
+
+#ifdef TERMIOS_NEEDS_XOPEN_SOURCE
+#define _XOPEN_SOURCE
+#endif
+
+#if defined(HAVE_SYS_TYPES_H)
+#include <sys/types.h>
+#endif
+
+#if defined(HAVE_TERMIOS_H)
+#include <termios.h>
+#endif
+
+void _M2_termios_init (void);
+void _M2_termios_finish (void);
+
+#if defined(HAVE_TERMIOS_H)
+
+#define EXPORT(X) termios##_##X
+
+typedef enum {
+ vintr,
+ vquit,
+ verase,
+ vkill,
+ veof,
+ vtime,
+ vmin,
+ vswtc,
+ vstart,
+ vstop,
+ vsusp,
+ veol,
+ vreprint,
+ vdiscard,
+ vwerase,
+ vlnext,
+ veol2
+} ControlChar;
+
+typedef enum {
+ /* Input flag bits. */
+ ignbrk,
+ ibrkint,
+ ignpar,
+ iparmrk,
+ inpck,
+ istrip,
+ inlcr,
+ igncr,
+ icrnl,
+ iuclc,
+ ixon,
+ ixany,
+ ixoff,
+ imaxbel,
+ /* Output flag bits. */
+ opost,
+ olcuc,
+ onlcr,
+ ocrnl,
+ onocr,
+ onlret,
+ ofill,
+ ofdel,
+ onl0,
+ onl1,
+ ocr0,
+ ocr1,
+ ocr2,
+ ocr3,
+ otab0,
+ otab1,
+ otab2,
+ otab3,
+ obs0,
+ obs1,
+ off0,
+ off1,
+ ovt0,
+ ovt1,
+ /* Baud rate. */
+ b0,
+ b50,
+ b75,
+ b110,
+ b135,
+ b150,
+ b200,
+ b300,
+ b600,
+ b1200,
+ b1800,
+ b2400,
+ b4800,
+ b9600,
+ b19200,
+ b38400,
+ b57600,
+ b115200,
+ b240400,
+ b460800,
+ b500000,
+ b576000,
+ b921600,
+ b1000000,
+ b1152000,
+ b1500000,
+ b2000000,
+ b2500000,
+ b3000000,
+ b3500000,
+ b4000000,
+ maxbaud,
+ crtscts,
+ /* Character size. */
+ cs5,
+ cs6,
+ cs7,
+ cs8,
+ cstopb,
+ cread,
+ parenb,
+ parodd,
+ hupcl,
+ clocal,
+ /* Local flags. */
+ lisig,
+ licanon,
+ lxcase,
+ lecho,
+ lechoe,
+ lechok,
+ lechonl,
+ lnoflsh,
+ ltopstop,
+ lechoctl,
+ lechoprt,
+ lechoke,
+ lflusho,
+ lpendin,
+ liexten
+} Flag;
+
+/* Prototypes. */
+extern "C" void *EXPORT (InitTermios) (void);
+extern "C" void *EXPORT (KillTermios) (struct termios *p);
+extern "C" int EXPORT (cfgetospeed) (struct termios *t);
+extern "C" int EXPORT (cfgetispeed) (struct termios *t);
+extern "C" int EXPORT (cfsetospeed) (struct termios *t, unsigned int b);
+extern "C" int EXPORT (cfsetispeed) (struct termios *t, unsigned int b);
+extern "C" int EXPORT (cfsetspeed) (struct termios *t, unsigned int b);
+extern "C" int EXPORT (tcgetattr) (int fd, struct termios *t);
+extern "C" int EXPORT (tcsetattr) (int fd, int option, struct termios *t);
+extern "C" void EXPORT (cfmakeraw) (struct termios *t);
+extern "C" int EXPORT (tcsendbreak) (int fd, int duration);
+extern "C" int EXPORT (tcdrain) (int fd);
+extern "C" int EXPORT (tcflushi) (int fd);
+extern "C" int EXPORT (tcflusho) (int fd);
+extern "C" int EXPORT (tcflushio) (int fd);
+extern "C" int EXPORT (tcflowoni) (int fd);
+extern "C" int EXPORT (tcflowoffi) (int fd);
+extern "C" int EXPORT (tcflowono) (int fd);
+extern "C" int EXPORT (tcflowoffo) (int fd);
+extern "C" int EXPORT (GetFlag) (struct termios *t, Flag f, int *b);
+extern "C" int EXPORT (SetFlag) (struct termios *t, Flag f, int b);
+extern "C" int EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch);
+extern "C" int EXPORT (SetChar) (struct termios *t, ControlChar c, char ch);
+extern "C" int EXPORT (tcsnow) (void);
+extern "C" int EXPORT (tcsflush) (void);
+extern "C" int EXPORT (tcsdrain) (void);
+extern "C" int doSetUnset (unsigned int *bitset, unsigned int mask, int value);
+
+/* InitTermios new data structure. */
+
+extern "C" void
+*EXPORT (InitTermios) (void)
+{
+ struct termios *p = (struct termios *)malloc (sizeof (struct termios));
+
+ memset (p, 0, sizeof (struct termios));
+ return p;
+}
+
+/* KillTermios delete data structure. */
+
+extern "C" void*
+EXPORT (KillTermios) (struct termios *p)
+{
+ free (p);
+ return NULL;
+}
+
+/* tcsnow return the value of TCSANOW. */
+
+extern "C" int
+EXPORT (tcsnow) (void) { return TCSANOW; }
+
+/* tcsdrain return the value of TCSADRAIN. */
+
+extern "C" int
+EXPORT (tcsdrain) (void) { return TCSADRAIN; }
+
+/* tcsflush return the value of TCSAFLUSH. */
+
+extern "C" int
+EXPORT (tcsflush) (void) { return TCSAFLUSH; }
+
+/* cfgetospeed return output baud rate. */
+
+extern "C" int
+EXPORT (cfgetospeed) (struct termios *t) { return cfgetospeed (t); }
+
+/* cfgetispeed return input baud rate. */
+
+extern "C" int
+EXPORT (cfgetispeed) (struct termios *t) { return cfgetispeed (t); }
+
+/* cfsetospeed set output baud rate. */
+
+extern "C" int
+EXPORT (cfsetospeed) (struct termios *t, unsigned int b)
+{
+ return cfsetospeed (t, b);
+}
+
+/* cfsetispeed set input baud rate. */
+
+extern "C" int
+EXPORT (cfsetispeed) (struct termios *t, unsigned int b)
+{
+ return cfsetispeed (t, b);
+}
+
+/* cfsetspeed set input and output baud rate. */
+
+extern "C" int
+EXPORT (cfsetspeed) (struct termios *t, unsigned int b)
+{
+ int val = cfsetispeed (t, b);
+ if (val == 0)
+ return cfsetospeed (t, b);
+ cfsetospeed (t, b);
+ return val;
+}
+
+/* tcgetattr get state of, fd, into, t. */
+
+extern "C" int
+EXPORT (tcgetattr) (int fd, struct termios *t)
+{
+ return tcgetattr (fd, t);
+}
+
+/* tcsetattr set state of, fd, to, t, using option. */
+
+int EXPORT (tcsetattr) (int fd, int option, struct termios *t)
+{
+ return tcsetattr (fd, option, t);
+}
+
+/* cfmakeraw sets the terminal to raw mode. */
+
+extern "C" void
+EXPORT (cfmakeraw) (struct termios *t)
+{
+#if defined(HAVE_CFMAKERAW)
+ return cfmakeraw (t);
+#endif
+}
+
+/* tcsendbreak send zero bits for duration. */
+
+extern "C" int
+EXPORT (tcsendbreak) (int fd, int duration)
+{
+ return tcsendbreak (fd, duration);
+}
+
+/* tcdrain waits for pending output to be written on, fd. */
+
+extern "C" int
+EXPORT (tcdrain) (int fd) { return tcdrain (fd); }
+
+/* tcflushi flush input. */
+
+extern "C" int
+EXPORT (tcflushi) (int fd)
+{
+#if defined(TCIFLUSH)
+ return tcflush (fd, TCIFLUSH);
+#else
+ return 1;
+#endif
+}
+
+/* tcflusho flush output. */
+
+extern "C" int
+EXPORT (tcflusho) (int fd)
+{
+#if defined(TCOFLUSH)
+ return tcflush (fd, TCOFLUSH);
+#else
+ return 1;
+#endif
+}
+
+/* tcflushio flush input and output. */
+
+extern "C" int
+EXPORT (tcflushio) (int fd)
+{
+#if defined(TCIOFLUSH)
+ return tcflush (fd, TCIOFLUSH);
+#else
+ return 1;
+#endif
+}
+
+/* tcflowoni restart input on, fd. */
+
+extern "C" int
+EXPORT (tcflowoni) (int fd)
+{
+#if defined(TCION)
+ return tcflow (fd, TCION);
+#else
+ return 1;
+#endif
+}
+
+/* tcflowoffi stop input on, fd. */
+
+extern "C" int
+EXPORT (tcflowoffi) (int fd)
+{
+#if defined(TCIOFF)
+ return tcflow (fd, TCIOFF);
+#else
+ return 1;
+#endif
+}
+
+/* tcflowono restart output on, fd. */
+
+extern "C" int
+EXPORT (tcflowono) (int fd)
+{
+#if defined(TCOON)
+ return tcflow (fd, TCOON);
+#else
+ return 1;
+#endif
+}
+
+/* tcflowoffo stop output on, fd. */
+
+extern "C" int
+EXPORT (tcflowoffo) (int fd)
+{
+#if defined(TCOOFF)
+ return tcflow (fd, TCOOFF);
+#else
+ return 1;
+#endif
+}
+
+/* doSetUnset applies mask or undoes mask depending upon value. */
+
+extern "C" int
+doSetUnset (unsigned int *bitset, unsigned int mask, int value)
+{
+ if (value)
+ (*bitset) |= mask;
+ else
+ (*bitset) &= (~mask);
+ return 1;
+}
+
+/* GetFlag sets a flag value from, t, in, b, and returns TRUE
+ if, t, supports, f. */
+
+extern "C" int
+EXPORT (GetFlag) (struct termios *t, Flag f, int *b)
+{
+ switch (f)
+ {
+
+ case ignbrk:
+#if defined(IGNBRK)
+ *b = ((t->c_iflag & IGNBRK) == IGNBRK);
+ return 1;
+#else
+ return 0;
+#endif
+ case ibrkint:
+#if defined(BRKINT)
+ *b = ((t->c_iflag & BRKINT) == BRKINT);
+ return 1;
+#else
+ return 0;
+#endif
+ case ignpar:
+#if defined(IGNPAR)
+ *b = ((t->c_iflag & IGNPAR) == IGNPAR);
+ return 1;
+#else
+ return 0;
+#endif
+ case iparmrk:
+#if defined(PARMRK)
+ *b = ((t->c_iflag & PARMRK) == PARMRK);
+ return 1;
+#else
+ return 0;
+#endif
+ case inpck:
+#if defined(INPCK)
+ *b = ((t->c_iflag & INPCK) == INPCK);
+ return 1;
+#else
+ return 0;
+#endif
+ case istrip:
+#if defined(ISTRIP)
+ *b = ((t->c_iflag & ISTRIP) == ISTRIP);
+ return 1;
+#else
+ return 0;
+#endif
+ case inlcr:
+#if defined(INLCR)
+ *b = ((t->c_iflag & INLCR) == INLCR);
+ return 1;
+#else
+ return 0;
+#endif
+ case igncr:
+#if defined(IGNCR)
+ *b = ((t->c_iflag & IGNCR) == IGNCR);
+ return 1;
+#else
+ return 0;
+#endif
+ case icrnl:
+#if defined(ICRNL)
+ *b = ((t->c_iflag & ICRNL) == ICRNL);
+ return 1;
+#else
+ return 0;
+#endif
+ case iuclc:
+#if defined(IUCLC)
+ *b = ((t->c_iflag & IUCLC) == IUCLC);
+ return 1;
+#else
+ return 0;
+#endif
+ case ixon:
+#if defined(IXON)
+ *b = ((t->c_iflag & IXON) == IXON);
+ return 1;
+#else
+ return 0;
+#endif
+ case ixany:
+#if defined(IXANY)
+ *b = ((t->c_iflag & IXANY) == IXANY);
+ return 1;
+#else
+ return 0;
+#endif
+ case ixoff:
+#if defined(IXOFF)
+ *b = ((t->c_iflag & IXOFF) == IXOFF);
+ return 1;
+#else
+ return 0;
+#endif
+ case imaxbel:
+#if defined(IMAXBEL)
+ *b = ((t->c_iflag & IMAXBEL) == IMAXBEL);
+ return 1;
+#else
+ return 0;
+#endif
+ case opost:
+#if defined(OPOST)
+ *b = ((t->c_oflag & OPOST) == OPOST);
+ return 1;
+#else
+ return 0;
+#endif
+ case olcuc:
+#if defined(OLCUC)
+ *b = ((t->c_oflag & OLCUC) == OLCUC);
+ return 1;
+#else
+ return 0;
+#endif
+ case onlcr:
+#if defined(ONLCR)
+ *b = ((t->c_oflag & ONLCR) == ONLCR);
+ return 1;
+#else
+ return 0;
+#endif
+ case ocrnl:
+#if defined(OCRNL)
+ *b = ((t->c_oflag & OCRNL) == OCRNL);
+ return 1;
+#else
+ return 0;
+#endif
+ case onocr:
+#if defined(ONOCR)
+ *b = ((t->c_oflag & ONOCR) == ONOCR);
+ return 1;
+#else
+ return 0;
+#endif
+ case onlret:
+#if defined(ONLRET)
+ *b = ((t->c_oflag & ONLRET) == ONLRET);
+ return 1;
+#else
+ return 0;
+#endif
+ case ofill:
+#if defined(OFILL)
+ *b = ((t->c_oflag & OFILL) == OFILL);
+ return 1;
+#else
+ return 0;
+#endif
+ case ofdel:
+#if defined(OFDEL)
+ *b = ((t->c_oflag & OFDEL) == OFDEL);
+ return 1;
+#else
+ return 0;
+#endif
+ case onl0:
+#if defined(NL0)
+ *b = ((t->c_oflag & NL0) == NL0);
+ return 1;
+#else
+ return 0;
+#endif
+ case onl1:
+#if defined(NL1)
+ *b = ((t->c_oflag & NL1) == NL1);
+ return 1;
+#else
+ return 0;
+#endif
+ case ocr0:
+#if defined(CR0)
+ *b = ((t->c_oflag & CR0) == CR0);
+ return 1;
+#else
+ return 0;
+#endif
+ case ocr1:
+#if defined(CR1)
+ *b = ((t->c_oflag & CR1) == CR1);
+ return 1;
+#else
+ return 0;
+#endif
+ case ocr2:
+#if defined(CR2)
+ *b = ((t->c_oflag & CR2) == CR2);
+ return 1;
+#else
+ return 0;
+#endif
+ case ocr3:
+#if defined(CR3)
+ *b = ((t->c_oflag & CR3) == CR3);
+ return 1;
+#else
+ return 0;
+#endif
+ case otab0:
+#if defined(TAB0)
+ *b = ((t->c_oflag & TAB0) == TAB0);
+ return 1;
+#else
+ return 0;
+#endif
+ case otab1:
+#if defined(TAB1)
+ *b = ((t->c_oflag & TAB1) == TAB1);
+ return 1;
+#else
+ return 0;
+#endif
+ case otab2:
+#if defined(TAB2)
+ *b = ((t->c_oflag & TAB2) == TAB2);
+ return 1;
+#else
+ return 0;
+#endif
+ case otab3:
+#if defined(TAB3)
+ *b = ((t->c_oflag & TAB3) == TAB3);
+ return 1;
+#else
+ return 0;
+#endif
+ case obs0:
+#if defined(BS0)
+ *b = ((t->c_oflag & BS0) == BS0);
+ return 1;
+#else
+ return 0;
+#endif
+ case obs1:
+#if defined(BS1)
+ *b = ((t->c_oflag & BS1) == BS1);
+ return 1;
+#else
+ return 0;
+#endif
+ case off0:
+#if defined(FF0)
+ *b = ((t->c_oflag & FF0) == FF0);
+ return 1;
+#else
+ return 0;
+#endif
+ case off1:
+#if defined(FF1)
+ *b = ((t->c_oflag & FF1) == FF1);
+ return 1;
+#else
+ return 0;
+#endif
+ case ovt0:
+#if defined(VT0)
+ *b = ((t->c_oflag & VT0) == VT0);
+ return 1;
+#else
+ return 0;
+#endif
+ case ovt1:
+#if defined(VT1)
+ *b = ((t->c_oflag & VT1) == VT1);
+ return 1;
+#else
+ return 0;
+#endif
+ case b0:
+#if defined(B0)
+ *b = ((t->c_cflag & B0) == B0);
+ return 1;
+#else
+ return 0;
+#endif
+ case b50:
+#if defined(B50)
+ *b = ((t->c_cflag & B50) == B50);
+ return 1;
+#else
+ return 0;
+#endif
+ case b75:
+#if defined(B75)
+ *b = ((t->c_cflag & B75) == B75);
+ return 1;
+#else
+ return 0;
+#endif
+ case b110:
+#if defined(B110)
+ *b = ((t->c_cflag & B110) == B110);
+ return 1;
+#else
+ return 0;
+#endif
+ case b135:
+#if defined(B134)
+ *b = ((t->c_cflag & B134) == B134);
+ return 1;
+#else
+ return 0;
+#endif
+ case b150:
+#if defined(B150)
+ *b = ((t->c_cflag & B150) == B150);
+ return 1;
+#else
+ return 0;
+#endif
+ case b200:
+#if defined(B200)
+ *b = ((t->c_cflag & B200) == B200);
+ return 1;
+#else
+ return 0;
+#endif
+ case b300:
+#if defined(B300)
+ *b = ((t->c_cflag & B300) == B300);
+ return 1;
+#else
+ return 0;
+#endif
+ case b600:
+#if defined(B600)
+ *b = ((t->c_cflag & B600) == B600);
+ return 1;
+#else
+ return 0;
+#endif
+ case b1200:
+#if defined(B1200)
+ *b = ((t->c_cflag & B1200) == B1200);
+ return 1;
+#else
+ return 0;
+#endif
+ case b1800:
+#if defined(B1800)
+ *b = ((t->c_cflag & B1800) == B1800);
+ return 1;
+#else
+ return 0;
+#endif
+ case b2400:
+#if defined(B2400)
+ *b = ((t->c_cflag & B2400) == B2400);
+ return 1;
+#else
+ return 0;
+#endif
+ case b4800:
+#if defined(B4800)
+ *b = ((t->c_cflag & B4800) == B4800);
+ return 1;
+#else
+ return 0;
+#endif
+ case b9600:
+#if defined(B9600)
+ *b = ((t->c_cflag & B9600) == B9600);
+ return 1;
+#else
+ return 0;
+#endif
+ case b19200:
+#if defined(B19200)
+ *b = ((t->c_cflag & B19200) == B19200);
+ return 1;
+#else
+ return 0;
+#endif
+ case b38400:
+#if defined(B38400)
+ *b = ((t->c_cflag & B38400) == B38400);
+ return 1;
+#else
+ return 0;
+#endif
+ case b57600:
+#if defined(B57600)
+ *b = ((t->c_cflag & B57600) == B57600);
+ return 1;
+#else
+ return 0;
+#endif
+ case b115200:
+#if defined(B115200)
+ *b = ((t->c_cflag & B115200) == B115200);
+ return 1;
+#else
+ return 0;
+#endif
+ case b240400:
+#if defined(B230400)
+ *b = ((t->c_cflag & B230400) == B230400);
+ return 1;
+#else
+ return 0;
+#endif
+ case b460800:
+#if defined(B460800)
+ *b = ((t->c_cflag & B460800) == B460800);
+ return 1;
+#else
+ return 0;
+#endif
+ case b500000:
+#if defined(B500000)
+ *b = ((t->c_cflag & B500000) == B500000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b576000:
+#if defined(B576000)
+ *b = ((t->c_cflag & B576000) == B576000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b921600:
+#if defined(B921600)
+ *b = ((t->c_cflag & B921600) == B921600);
+ return 1;
+#else
+ return 0;
+#endif
+ case b1000000:
+#if defined(B1000000)
+ *b = ((t->c_cflag & B1000000) == B1000000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b1152000:
+#if defined(B1152000)
+ *b = ((t->c_cflag & B1152000) == B1152000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b1500000:
+#if defined(B1500000)
+ *b = ((t->c_cflag & B1500000) == B1500000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b2000000:
+#if defined(B2000000)
+ *b = ((t->c_cflag & B2000000) == B2000000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b2500000:
+#if defined(B2500000)
+ *b = ((t->c_cflag & B2500000) == B2500000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b3000000:
+#if defined(B3000000)
+ *b = ((t->c_cflag & B3000000) == B3000000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b3500000:
+#if defined(B3500000)
+ *b = ((t->c_cflag & B3500000) == B3500000);
+ return 1;
+#else
+ return 0;
+#endif
+ case b4000000:
+#if defined(B4000000)
+ *b = ((t->c_cflag & B4000000) == B4000000);
+ return 1;
+#else
+ return 0;
+#endif
+ case maxbaud:
+#if defined(MAX)
+ *b = ((t->c_cflag & __MAX_BAUD) == __MAX_BAUD);
+ return 1;
+#else
+ return 0;
+#endif
+ case crtscts:
+#if defined(CRTSCTS)
+ *b = ((t->c_cflag & CRTSCTS) == CRTSCTS);
+ return 1;
+#else
+ return 0;
+#endif
+ case cs5:
+#if defined(CS5)
+ *b = ((t->c_cflag & CS5) == CS5);
+ return 1;
+#else
+ return 0;
+#endif
+ case cs6:
+#if defined(CS6)
+ *b = ((t->c_cflag & CS6) == CS6);
+ return 1;
+#else
+ return 0;
+#endif
+ case cs7:
+#if defined(CS7)
+ *b = ((t->c_cflag & CS7) == CS7);
+ return 1;
+#else
+ return 0;
+#endif
+ case cs8:
+#if defined(CS8)
+ *b = ((t->c_cflag & CS8) == CS8);
+ return 1;
+#else
+ return 0;
+#endif
+ case cstopb:
+#if defined(CSTOPB)
+ *b = ((t->c_cflag & CSTOPB) == CSTOPB);
+ return 1;
+#else
+ return 0;
+#endif
+ case cread:
+#if defined(CREAD)
+ *b = ((t->c_cflag & CREAD) == CREAD);
+ return 1;
+#else
+ return 0;
+#endif
+ case parenb:
+#if defined(PARENB)
+ *b = ((t->c_cflag & PARENB) == PARENB);
+ return 1;
+#else
+ return 0;
+#endif
+ case parodd:
+#if defined(PARODD)
+ *b = ((t->c_cflag & PARODD) == PARODD);
+ return 1;
+#else
+ return 0;
+#endif
+ case hupcl:
+#if defined(HUPCL)
+ *b = ((t->c_cflag & HUPCL) == HUPCL);
+ return 1;
+#else
+ return 0;
+#endif
+ case clocal:
+#if defined(CLOCAL)
+ *b = ((t->c_cflag & CLOCAL) == CLOCAL);
+ return 1;
+#else
+ return 0;
+#endif
+ case lisig:
+#if defined(ISIG)
+ *b = ((t->c_lflag & ISIG) == ISIG);
+ return 1;
+#else
+ return 0;
+#endif
+ case licanon:
+#if defined(ICANON)
+ *b = ((t->c_lflag & ICANON) == ICANON);
+ return 1;
+#else
+ return 0;
+#endif
+ case lxcase:
+#if defined(XCASE)
+ *b = ((t->c_lflag & XCASE) == XCASE);
+ return 1;
+#else
+ return 0;
+#endif
+ case lecho:
+#if defined(ECHO)
+ *b = ((t->c_lflag & ECHO) == ECHO);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechoe:
+#if defined(ECHOE)
+ *b = ((t->c_lflag & ECHOE) == ECHOE);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechok:
+#if defined(ECHOK)
+ *b = ((t->c_lflag & ECHOK) == ECHOK);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechonl:
+#if defined(ECHONL)
+ *b = ((t->c_lflag & ECHONL) == ECHONL);
+ return 1;
+#else
+ return 0;
+#endif
+ case lnoflsh:
+#if defined(NOFLSH)
+ *b = ((t->c_lflag & NOFLSH) == NOFLSH);
+ return 1;
+#else
+ return 0;
+#endif
+ case ltopstop:
+#if defined(TOSTOP)
+ *b = ((t->c_lflag & TOSTOP) == TOSTOP);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechoctl:
+#if defined(ECHOCTL)
+ *b = ((t->c_lflag & ECHOCTL) == ECHOCTL);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechoprt:
+#if defined(ECHOPRT)
+ *b = ((t->c_lflag & ECHOPRT) == ECHOPRT);
+ return 1;
+#else
+ return 0;
+#endif
+ case lechoke:
+#if defined(ECHOKE)
+ *b = ((t->c_lflag & ECHOKE) == ECHOKE);
+ return 1;
+#else
+ return 0;
+#endif
+ case lflusho:
+#if defined(FLUSHO)
+ *b = ((t->c_lflag & FLUSHO) == FLUSHO);
+ return 1;
+#else
+ return 0;
+#endif
+ case lpendin:
+#if defined(PENDIN)
+ *b = ((t->c_lflag & PENDIN) == PENDIN);
+ return 1;
+#else
+ return 0;
+#endif
+ case liexten:
+#if defined(IEXTEN)
+ *b = ((t->c_lflag & IEXTEN) == IEXTEN);
+ return 1;
+#else
+ return 0;
+#endif
+ }
+ return 0;
+}
+
+/* SetFlag sets a flag value in, t, to, b, and returns TRUE if
+ this flag value is supported. */
+
+extern "C" int
+EXPORT (SetFlag) (struct termios *t, Flag f, int b)
+{
+ switch (f)
+ {
+
+ case ignbrk:
+#if defined(IGNBRK)
+ return doSetUnset (&t->c_iflag, IGNBRK, b);
+#else
+ return 0;
+#endif
+ case ibrkint:
+#if defined(BRKINT)
+ return doSetUnset (&t->c_iflag, BRKINT, b);
+#else
+ return 0;
+#endif
+ case ignpar:
+#if defined(IGNPAR)
+ return doSetUnset (&t->c_iflag, IGNPAR, b);
+#else
+ return 0;
+#endif
+ case iparmrk:
+#if defined(PARMRK)
+ return doSetUnset (&t->c_iflag, PARMRK, b);
+#else
+ return 0;
+#endif
+ case inpck:
+#if defined(INPCK)
+ return doSetUnset (&t->c_iflag, INPCK, b);
+#else
+ return 0;
+#endif
+ case istrip:
+#if defined(ISTRIP)
+ return doSetUnset (&t->c_iflag, ISTRIP, b);
+#else
+ return 0;
+#endif
+ case inlcr:
+#if defined(INLCR)
+ return doSetUnset (&t->c_iflag, INLCR, b);
+#else
+ return 0;
+#endif
+ case igncr:
+#if defined(IGNCR)
+ return doSetUnset (&t->c_iflag, IGNCR, b);
+#else
+ return 0;
+#endif
+ case icrnl:
+#if defined(ICRNL)
+ return doSetUnset (&t->c_iflag, ICRNL, b);
+#else
+ return 0;
+#endif
+ case iuclc:
+#if defined(IUCLC)
+ return doSetUnset (&t->c_iflag, IUCLC, b);
+#else
+ return 0;
+#endif
+ case ixon:
+#if defined(IXON)
+ return doSetUnset (&t->c_iflag, IXON, b);
+#else
+ return 0;
+#endif
+ case ixany:
+#if defined(IXANY)
+ return doSetUnset (&t->c_iflag, IXANY, b);
+#else
+ return 0;
+#endif
+ case ixoff:
+#if defined(IXOFF)
+ return doSetUnset (&t->c_iflag, IXOFF, b);
+#else
+ return 0;
+#endif
+ case imaxbel:
+#if defined(IMAXBEL)
+ return doSetUnset (&t->c_iflag, IMAXBEL, b);
+#else
+ return 0;
+#endif
+ case opost:
+#if defined(OPOST)
+ return doSetUnset (&t->c_oflag, OPOST, b);
+#else
+ return 0;
+#endif
+ case olcuc:
+#if defined(OLCUC)
+ return doSetUnset (&t->c_oflag, OLCUC, b);
+#else
+ return 0;
+#endif
+ case onlcr:
+#if defined(ONLCR)
+ return doSetUnset (&t->c_oflag, ONLCR, b);
+#else
+ return 0;
+#endif
+ case ocrnl:
+#if defined(OCRNL)
+ return doSetUnset (&t->c_oflag, OCRNL, b);
+#else
+ return 0;
+#endif
+ case onocr:
+#if defined(ONOCR)
+ return doSetUnset (&t->c_oflag, ONOCR, b);
+#else
+ return 0;
+#endif
+ case onlret:
+#if defined(ONLRET)
+ return doSetUnset (&t->c_oflag, ONLRET, b);
+#else
+ return 0;
+#endif
+ case ofill:
+#if defined(OFILL)
+ return doSetUnset (&t->c_oflag, OFILL, b);
+#else
+ return 0;
+#endif
+ case ofdel:
+#if defined(OFDEL)
+ return doSetUnset (&t->c_oflag, OFDEL, b);
+#else
+ return 0;
+#endif
+ case onl0:
+#if defined(NL0)
+ return doSetUnset (&t->c_oflag, NL0, b);
+#else
+ return 0;
+#endif
+ case onl1:
+#if defined(NL1)
+ return doSetUnset (&t->c_oflag, NL1, b);
+#else
+ return 0;
+#endif
+ case ocr0:
+#if defined(CR0)
+ return doSetUnset (&t->c_oflag, CR0, b);
+#else
+ return 0;
+#endif
+ case ocr1:
+#if defined(CR1)
+ return doSetUnset (&t->c_oflag, CR1, b);
+#else
+ return 0;
+#endif
+ case ocr2:
+#if defined(CR2)
+ return doSetUnset (&t->c_oflag, CR2, b);
+#else
+ return 0;
+#endif
+ case ocr3:
+#if defined(CR3)
+ return doSetUnset (&t->c_oflag, CR3, b);
+#else
+ return 0;
+#endif
+ case otab0:
+#if defined(TAB0)
+ return doSetUnset (&t->c_oflag, TAB0, b);
+#else
+ return 0;
+#endif
+ case otab1:
+#if defined(TAB1)
+ return doSetUnset (&t->c_oflag, TAB1, b);
+#else
+ return 0;
+#endif
+ case otab2:
+#if defined(TAB2)
+ return doSetUnset (&t->c_oflag, TAB2, b);
+#else
+ return 0;
+#endif
+ case otab3:
+#if defined(TAB3)
+ return doSetUnset (&t->c_oflag, TAB3, b);
+#else
+ return 0;
+#endif
+ case obs0:
+#if defined(BS0)
+ return doSetUnset (&t->c_oflag, BS0, b);
+#else
+ return 0;
+#endif
+ case obs1:
+#if defined(BS1)
+ return doSetUnset (&t->c_oflag, BS1, b);
+#else
+ return 0;
+#endif
+ case off0:
+#if defined(FF0)
+ return doSetUnset (&t->c_oflag, FF0, b);
+#else
+ return 0;
+#endif
+ case off1:
+#if defined(FF1)
+ return doSetUnset (&t->c_oflag, FF1, b);
+#else
+ return 0;
+#endif
+ case ovt0:
+#if defined(VT0)
+ return doSetUnset (&t->c_oflag, VT0, b);
+#else
+ return 0;
+#endif
+ case ovt1:
+#if defined(VT1)
+ return doSetUnset (&t->c_oflag, VT1, b);
+#else
+ return 0;
+#endif
+ case b0:
+#if defined(B0)
+ return doSetUnset (&t->c_cflag, B0, b);
+#else
+ return 0;
+#endif
+ case b50:
+#if defined(B50)
+ return doSetUnset (&t->c_cflag, B50, b);
+#else
+ return 0;
+#endif
+ case b75:
+#if defined(B75)
+ return doSetUnset (&t->c_cflag, B75, b);
+#else
+ return 0;
+#endif
+ case b110:
+#if defined(B110)
+ return doSetUnset (&t->c_cflag, B110, b);
+#else
+ return 0;
+#endif
+ case b135:
+#if defined(B134)
+ return doSetUnset (&t->c_cflag, B134, b);
+#else
+ return 0;
+#endif
+ case b150:
+#if defined(B150)
+ return doSetUnset (&t->c_cflag, B150, b);
+#else
+ return 0;
+#endif
+ case b200:
+#if defined(B200)
+ return doSetUnset (&t->c_cflag, B200, b);
+#else
+ return 0;
+#endif
+ case b300:
+#if defined(B300)
+ return doSetUnset (&t->c_cflag, B300, b);
+#else
+ return 0;
+#endif
+ case b600:
+#if defined(B600)
+ return doSetUnset (&t->c_cflag, B600, b);
+#else
+ return 0;
+#endif
+ case b1200:
+#if defined(B1200)
+ return doSetUnset (&t->c_cflag, B1200, b);
+#else
+ return 0;
+#endif
+ case b1800:
+#if defined(B1800)
+ return doSetUnset (&t->c_cflag, B1800, b);
+#else
+ return 0;
+#endif
+ case b2400:
+#if defined(B2400)
+ return doSetUnset (&t->c_cflag, B2400, b);
+#else
+ return 0;
+#endif
+ case b4800:
+#if defined(B4800)
+ return doSetUnset (&t->c_cflag, B4800, b);
+#else
+ return 0;
+#endif
+ case b9600:
+#if defined(B9600)
+ return doSetUnset (&t->c_cflag, B9600, b);
+#else
+ return 0;
+#endif
+ case b19200:
+#if defined(B19200)
+ return doSetUnset (&t->c_cflag, B19200, b);
+#else
+ return 0;
+#endif
+ case b38400:
+#if defined(B38400)
+ return doSetUnset (&t->c_cflag, B38400, b);
+#else
+ return 0;
+#endif
+ case b57600:
+#if defined(B57600)
+ return doSetUnset (&t->c_cflag, B57600, b);
+#else
+ return 0;
+#endif
+ case b115200:
+#if defined(B115200)
+ return doSetUnset (&t->c_cflag, B115200, b);
+#else
+ return 0;
+#endif
+ case b240400:
+#if defined(B230400)
+ return doSetUnset (&t->c_cflag, B230400, b);
+#else
+ return 0;
+#endif
+ case b460800:
+#if defined(B460800)
+ return doSetUnset (&t->c_cflag, B460800, b);
+#else
+ return 0;
+#endif
+ case b500000:
+#if defined(B500000)
+ return doSetUnset (&t->c_cflag, B500000, b);
+#else
+ return 0;
+#endif
+ case b576000:
+#if defined(B576000)
+ return doSetUnset (&t->c_cflag, B576000, b);
+#else
+ return 0;
+#endif
+ case b921600:
+#if defined(B921600)
+ return doSetUnset (&t->c_cflag, B921600, b);
+#else
+ return 0;
+#endif
+ case b1000000:
+#if defined(B1000000)
+ return doSetUnset (&t->c_cflag, B1000000, b);
+#else
+ return 0;
+#endif
+ case b1152000:
+#if defined(B1152000)
+ return doSetUnset (&t->c_cflag, B1152000, b);
+#else
+ return 0;
+#endif
+ case b1500000:
+#if defined(B1500000)
+ return doSetUnset (&t->c_cflag, B1500000, b);
+#else
+ return 0;
+#endif
+ case b2000000:
+#if defined(B2000000)
+ return doSetUnset (&t->c_cflag, B2000000, b);
+#else
+ return 0;
+#endif
+ case b2500000:
+#if defined(B2500000)
+ return doSetUnset (&t->c_cflag, B2500000, b);
+#else
+ return 0;
+#endif
+ case b3000000:
+#if defined(B3000000)
+ return doSetUnset (&t->c_cflag, B3000000, b);
+#else
+ return 0;
+#endif
+ case b3500000:
+#if defined(B3500000)
+ return doSetUnset (&t->c_cflag, B3500000, b);
+#else
+ return 0;
+#endif
+ case b4000000:
+#if defined(B4000000)
+ return doSetUnset (&t->c_cflag, B4000000, b);
+#else
+ return 0;
+#endif
+ case maxbaud:
+#if defined(__MAX_BAUD)
+ return doSetUnset (&t->c_cflag, __MAX_BAUD, b);
+#else
+ return 0;
+#endif
+ case crtscts:
+#if defined(CRTSCTS)
+ return doSetUnset (&t->c_cflag, CRTSCTS, b);
+#else
+ return 0;
+#endif
+ case cs5:
+#if defined(CS5)
+ return doSetUnset (&t->c_cflag, CS5, b);
+#else
+ return 0;
+#endif
+ case cs6:
+#if defined(CS6)
+ return doSetUnset (&t->c_cflag, CS6, b);
+#else
+ return 0;
+#endif
+ case cs7:
+#if defined(CS7)
+ return doSetUnset (&t->c_cflag, CS7, b);
+#else
+ return 0;
+#endif
+ case cs8:
+#if defined(CS8)
+ return doSetUnset (&t->c_cflag, CS8, b);
+#else
+ return 0;
+#endif
+ case cstopb:
+#if defined(CSTOPB)
+ return doSetUnset (&t->c_cflag, CSTOPB, b);
+#else
+ return 0;
+#endif
+ case cread:
+#if defined(CREAD)
+ return doSetUnset (&t->c_cflag, CREAD, b);
+#else
+ return 0;
+#endif
+ case parenb:
+#if defined(PARENB)
+ return doSetUnset (&t->c_cflag, PARENB, b);
+#else
+ return 0;
+#endif
+ case parodd:
+#if defined(PARODD)
+ return doSetUnset (&t->c_cflag, PARODD, b);
+#else
+ return 0;
+#endif
+ case hupcl:
+#if defined(HUPCL)
+ return doSetUnset (&t->c_cflag, HUPCL, b);
+#else
+ return 0;
+#endif
+ case clocal:
+#if defined(CLOCAL)
+ return doSetUnset (&t->c_cflag, CLOCAL, b);
+#else
+ return 0;
+#endif
+ case lisig:
+#if defined(ISIG)
+ return doSetUnset (&t->c_lflag, ISIG, b);
+#else
+ return 0;
+#endif
+ case licanon:
+#if defined(ICANON)
+ return doSetUnset (&t->c_lflag, ICANON, b);
+#else
+ return 0;
+#endif
+ case lxcase:
+#if defined(XCASE)
+ return doSetUnset (&t->c_lflag, XCASE, b);
+#else
+ return 0;
+#endif
+ case lecho:
+#if defined(ECHO)
+ return doSetUnset (&t->c_lflag, ECHO, b);
+#else
+ return 0;
+#endif
+ case lechoe:
+#if defined(ECHOE)
+ return doSetUnset (&t->c_lflag, ECHOE, b);
+#else
+ return 0;
+#endif
+ case lechok:
+#if defined(ECHOK)
+ return doSetUnset (&t->c_lflag, ECHOK, b);
+#else
+ return 0;
+#endif
+ case lechonl:
+#if defined(ECHONL)
+ return doSetUnset (&t->c_lflag, ECHONL, b);
+#else
+ return 0;
+#endif
+ case lnoflsh:
+#if defined(NOFLSH)
+ return doSetUnset (&t->c_lflag, NOFLSH, b);
+#else
+ return 0;
+#endif
+ case ltopstop:
+#if defined(TOSTOP)
+ return doSetUnset (&t->c_lflag, TOSTOP, b);
+#else
+ return 0;
+#endif
+ case lechoctl:
+#if defined(ECHOCTL)
+ return doSetUnset (&t->c_lflag, ECHOCTL, b);
+#else
+ return 0;
+#endif
+ case lechoprt:
+#if defined(ECHOPRT)
+ return doSetUnset (&t->c_lflag, ECHOPRT, b);
+#else
+ return 0;
+#endif
+ case lechoke:
+#if defined(ECHOKE)
+ return doSetUnset (&t->c_lflag, ECHOKE, b);
+#else
+ return 0;
+#endif
+ case lflusho:
+#if defined(FLUSHO)
+ return doSetUnset (&t->c_lflag, FLUSHO, b);
+#else
+ return 0;
+#endif
+ case lpendin:
+#if defined(PENDIN)
+ return doSetUnset (&t->c_lflag, PENDIN, b);
+#else
+ return 0;
+#endif
+ case liexten:
+#if defined(IEXTEN)
+ return doSetUnset (&t->c_lflag, IEXTEN, b);
+#else
+ return 0;
+#endif
+ }
+ return 0;
+}
+
+/* GetChar sets a CHAR, ch, value from, t, and returns TRUE if
+ this value is supported. */
+
+extern "C" int
+EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch)
+{
+ switch (c)
+ {
+
+ case vintr:
+#if defined(VINTR)
+ *ch = t->c_cc[VINTR];
+ return 1;
+#else
+ return 0;
+#endif
+ case vquit:
+#if defined(VQUIT)
+ *ch = t->c_cc[VQUIT];
+ return 1;
+#else
+ return 0;
+#endif
+ case verase:
+#if defined(VERASE)
+ *ch = t->c_cc[VERASE];
+ return 1;
+#else
+ return 0;
+#endif
+ case vkill:
+#if defined(VKILL)
+ *ch = t->c_cc[VKILL];
+ return 1;
+#else
+ return 0;
+#endif
+ case veof:
+#if defined(VEOF)
+ *ch = t->c_cc[VEOF];
+ return 1;
+#else
+ return 0;
+#endif
+ case vtime:
+#if defined(VTIME)
+ *ch = t->c_cc[VTIME];
+ return 1;
+#else
+ return 0;
+#endif
+ case vmin:
+#if defined(VMIN)
+ *ch = t->c_cc[VMIN];
+ return 1;
+#else
+ return 0;
+#endif
+ case vswtc:
+#if defined(VSWTC)
+ *ch = t->c_cc[VSWTC];
+ return 1;
+#else
+ return 0;
+#endif
+ case vstart:
+#if defined(VSTART)
+ *ch = t->c_cc[VSTART];
+ return 1;
+#else
+ return 0;
+#endif
+ case vstop:
+#if defined(VSTOP)
+ *ch = t->c_cc[VSTOP];
+ return 1;
+#else
+ return 0;
+#endif
+ case vsusp:
+#if defined(VSUSP)
+ *ch = t->c_cc[VSUSP];
+ return 1;
+#else
+ return 0;
+#endif
+ case veol:
+#if defined(VEOL)
+ *ch = t->c_cc[VEOL];
+ return 1;
+#else
+ return 0;
+#endif
+ case vreprint:
+#if defined(VREPRINT)
+ *ch = t->c_cc[VREPRINT];
+ return 1;
+#else
+ return 0;
+#endif
+ case vdiscard:
+#if defined(VDISCARD)
+ *ch = t->c_cc[VDISCARD];
+ return 1;
+#else
+ return 0;
+#endif
+ case vwerase:
+#if defined(VWERASE)
+ *ch = t->c_cc[VWERASE];
+ return 1;
+#else
+ return 0;
+#endif
+ case vlnext:
+#if defined(VLNEXT)
+ *ch = t->c_cc[VLNEXT];
+ return 1;
+#else
+ return 0;
+#endif
+ case veol2:
+#if defined(VEOL2)
+ *ch = t->c_cc[VEOL2];
+ return 1;
+#else
+ return 0;
+#endif
+ default:
+ return 0;
+ }
+}
+
+/* SetChar sets a CHAR value in, t, and returns TRUE if, c,
+ is supported. */
+
+extern "C" int
+EXPORT (SetChar) (struct termios *t, ControlChar c, char ch)
+{
+ switch (c)
+ {
+
+ case vintr:
+#if defined(VINTR)
+ t->c_cc[VINTR] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vquit:
+#if defined(VQUIT)
+ t->c_cc[VQUIT] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case verase:
+#if defined(VERASE)
+ t->c_cc[VERASE] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vkill:
+#if defined(VKILL)
+ t->c_cc[VKILL] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case veof:
+#if defined(VEOF)
+ t->c_cc[VEOF] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vtime:
+#if defined(VTIME)
+ t->c_cc[VTIME] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vmin:
+#if defined(VMIN)
+ t->c_cc[VMIN] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vswtc:
+#if defined(VSWTC)
+ t->c_cc[VSWTC] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vstart:
+#if defined(VSTART)
+ t->c_cc[VSTART] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vstop:
+#if defined(VSTOP)
+ t->c_cc[VSTOP] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vsusp:
+#if defined(VSUSP)
+ t->c_cc[VSUSP] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case veol:
+#if defined(VEOL)
+ t->c_cc[VEOL] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vreprint:
+#if defined(VREPRINT)
+ t->c_cc[VREPRINT] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vdiscard:
+#if defined(VDISCARD)
+ t->c_cc[VDISCARD] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vwerase:
+#if defined(VWERASE)
+ t->c_cc[VWERASE] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case vlnext:
+#if defined(VLNEXT)
+ t->c_cc[VLNEXT] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ case veol2:
+#if defined(VEOL2)
+ t->c_cc[VEOL2] = ch;
+ return 1;
+#else
+ return 0;
+#endif
+ default:
+ return 0;
+ }
+}
+#endif
+
+extern "C" void
+_M2_termios_init (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_termios_fini (int, char *[], char *[])
+{
+}
+
+extern "C" void
+_M2_termios_dep (void)
+{
+}
+
+struct _M2_termios_ctor { _M2_termios_ctor (); } _M2_termios_ctor;
+
+_M2_termios_ctor::_M2_termios_ctor (void)
+{
+ M2RTS_RegisterModule ("termios", _M2_termios_init, _M2_termios_fini,
+ _M2_termios_dep);
+}
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-07-07 16:03 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-07 16:03 [gcc/devel/modula-2] New files for new scaffold linking mechanism Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).