public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH] 5/19 modula2 front end: libgm2/libm2iso contents
@ 2022-10-10 15:31 Gaius Mulley
  0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2022-10-10 15:31 UTC (permalink / raw)
  To: gcc-patches

 

This patch set consists of the makefiles, autoconf sources necessary
to build the various libgm2/libm2iso libraries.  The c/c++/h files
are also included in the patch set.  The modula-2 sources are found
in gcc/m2.

 
------8<----------8<----------8<----------8<----------8<----------8<---- 
diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/wrapsock.c
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/libgm2/libm2iso/wrapsock.c	2022-10-07 20:21:18.738098020 +0100
@@ -0,0 +1,250 @@
+/* wrapsock.c provides access to socket related system calls.
+
+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"
+
+#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_MALLOC_H)
+#include "signal.h"
+#endif
+
+#if defined(HAVE_STRING_H)
+#include "string.h"
+#endif
+
+#if defined(HAVE_STDLIB_H)
+#include "stdlib.h"
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#include "ChanConsts.h"
+
+#define MAXHOSTNAME 1024
+#define MAXPBBUF 1024
+
+#if defined(HAVE_NETINET_IN_H)
+
+typedef struct
+{
+  char hostname[MAXHOSTNAME];
+  struct hostent *hp;
+  struct sockaddr_in sa;
+  int sockFd;
+  int portNo;
+  int hasChar;
+  char pbChar[MAXPBBUF];
+} clientInfo;
+
+static openResults clientConnect (clientInfo *c);
+
+/* clientOpen - returns an ISO Modula-2 OpenResult.  It attempts to
+   connect to: hostname:portNo.  If successful then the data
+   structure, c, will have its fields initialized.  */
+
+openResults
+wrapsock_clientOpen (clientInfo *c, char *hostname, unsigned int length,
+                     int portNo)
+{
+  /* remove SIGPIPE which is raised on the server if the client is killed.  */
+  signal (SIGPIPE, SIG_IGN);
+
+  c->hp = gethostbyname (hostname);
+  if (c->hp == NULL)
+    return noSuchFile;
+
+  memset ((void *)&c->sa, 0, sizeof (c->sa));
+  c->sa.sin_family = AF_INET;
+  memcpy ((void *)&c->sa.sin_addr, (void *)c->hp->h_addr, c->hp->h_length);
+  c->portNo = portNo;
+  c->sa.sin_port = htons (portNo);
+  c->hasChar = 0;
+  /* Open a TCP socket (an Internet stream socket) */
+
+  c->sockFd = socket (c->hp->h_addrtype, SOCK_STREAM, 0);
+  return clientConnect (c);
+}
+
+/* clientOpenIP - returns an ISO Modula-2 OpenResult.  It attempts to
+   connect to: ipaddress:portNo.  If successful then the data
+   structure, c, will have its fields initialized.  */
+
+openResults
+wrapsock_clientOpenIP (clientInfo *c, unsigned int ip, int portNo)
+{
+  /* remove SIGPIPE which is raised on the server if the client is killed.  */
+  signal (SIGPIPE, SIG_IGN);
+
+  memset ((void *)&c->sa, 0, sizeof (c->sa));
+  c->sa.sin_family = AF_INET;
+  memcpy ((void *)&c->sa.sin_addr, (void *)&ip, sizeof (ip));
+  c->portNo = portNo;
+  c->sa.sin_port = htons (portNo);
+
+  /* Open a TCP socket (an Internet stream socket) */
+
+  c->sockFd = socket (PF_INET, SOCK_STREAM, 0);
+  return clientConnect (c);
+}
+
+/* clientConnect - returns an ISO Modula-2 OpenResult once a connect
+   has been performed.  If successful the clientInfo will include the
+   file descriptor ready for read/write operations.  */
+
+static openResults
+clientConnect (clientInfo *c)
+{
+  if (connect (c->sockFd, (struct sockaddr *)&c->sa, sizeof (c->sa)) < 0)
+    return noSuchFile;
+
+  return opened;
+}
+
+/* getClientPortNo - returns the portNo from structure, c.  */
+
+int
+wrapsock_getClientPortNo (clientInfo *c)
+{
+  return c->portNo;
+}
+
+/* getClientHostname - fills in the hostname of the server the to
+   which the client is connecting.  */
+
+void
+wrapsock_getClientHostname (clientInfo *c, char *hostname, unsigned int high)
+{
+  strncpy (hostname, c->hostname, high + 1);
+}
+
+/* getClientSocketFd - returns the sockFd from structure, c.  */
+
+int
+wrapsock_getClientSocketFd (clientInfo *c)
+{
+  return c->sockFd;
+}
+
+/* getClientIP - returns the sockFd from structure, s.  */
+
+unsigned int
+wrapsock_getClientIP (clientInfo *c)
+{
+#if 0
+  printf("client ip = %s\n", inet_ntoa (c->sa.sin_addr.s_addr));
+#endif
+  return c->sa.sin_addr.s_addr;
+}
+
+/* getPushBackChar - returns TRUE if a pushed back character is
+   available.  */
+
+unsigned int
+wrapsock_getPushBackChar (clientInfo *c, char *ch)
+{
+  if (c->hasChar > 0)
+    {
+      c->hasChar--;
+      *ch = c->pbChar[c->hasChar];
+      return TRUE;
+    }
+  return FALSE;
+}
+
+/* setPushBackChar - returns TRUE if it is able to push back a
+   character.  */
+
+unsigned int
+wrapsock_setPushBackChar (clientInfo *c, char ch)
+{
+  if (c->hasChar == MAXPBBUF)
+    return FALSE;
+  c->pbChar[c->hasChar] = ch;
+  c->hasChar++;
+  return TRUE;
+}
+
+/* getSizeOfClientInfo - returns the sizeof (opaque data type).  */
+
+unsigned int
+wrapsock_getSizeOfClientInfo (void)
+{
+  return sizeof (clientInfo);
+}
+
+#endif
+
+/* GNU Modula-2 link fodder.  */
+
+void
+_M2_wrapsock_init (void)
+{
+}
+
+void
+_M2_wrapsock_fini (void)
+{
+}
diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/m2rts.h
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/libgm2/libm2iso/m2rts.h	2022-10-07 20:21:18.738098020 +0100
@@ -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 -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/ChanConsts.h
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/libgm2/libm2iso/ChanConsts.h	2022-10-07 20:21:18.738098020 +0100
@@ -0,0 +1,57 @@
+/* ChanConsts.h provides a C header file for ISO ChanConst.def.
+
+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/>.  */
+
+/* taken from ChanConsts.def */
+
+typedef enum openResults {
+  opened,          /* the open succeeded as requested.  */
+  wrongNameFormat, /* given name is in the wrong format for the implementation.
+                      */
+  wrongFlags, /* given flags include a value that does not apply to the device.
+                 */
+  tooManyOpen,      /* this device cannot support any more open channels.  */
+  outOfChans,       /* no more channels can be allocated.  */
+  wrongPermissions, /* file or directory permissions do not allow request.  */
+  noRoomOnDevice,   /* storage limits on the device prevent the open.  */
+  noSuchFile,       /* a needed file does not exist.  */
+  fileExists,    /* a file of the given name already exists when a new one is
+                    required.  */
+  wrongFileType, /* the file is of the wrong type to support the required
+                    operations.  */
+  noTextOperations, /* text operations have been requested, but are not
+                       supported.  */
+  noRawOperations,  /* raw operations have been requested, but are not
+                       supported.  */
+  noMixedOperations,
+
+  /* text and raw operations have been requested, but they are not
+  supported in combination */
+  alreadyOpen,
+
+  /* the source/destination is already open for operations not
+  supported in combination with the requested operations */
+  otherProblem /* open failed for some other reason.  */
+} openResults;
diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/ErrnoCategory.cc
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/libgm2/libm2iso/ErrnoCategory.cc	2022-10-07 20:21:18.738098020 +0100
@@ -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 -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/Makefile.am
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/libgm2/libm2iso/Makefile.am	2022-10-07 20:21:18.738098020 +0100
@@ -0,0 +1,244 @@
+# Makefile for libm2iso.
+#   Copyright 2013-2022  Free Software Foundation, Inc.
+#
+# This file is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+SUFFIXES = .c .mod .def .o .obj .lo .a .la
+
+ACLOCAL_AMFLAGS = -I . -I .. -I ../config
+
+VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs-iso
+
+# Multilib support.
+MAKEOVERRIDES=
+
+version := $(shell $(CC) -dumpversion)
+
+# Directory in which the compiler finds libraries etc.
+libsubdir = $(libdir)/gcc/$(target_alias)/$(version)
+# Used to install the shared libgcc.
+# was slibdir = @slibdir@
+slibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR)
+
+toolexeclibdir=@toolexeclibdir@
+toolexecdir=@toolexecdir@
+GM2_FOR_TARGET=@GM2_FOR_TARGET@
+
+MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory)
+MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory)
+
+MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi)
+inst_libdir = $(libsubdir)$(MULTISUBDIR)
+inst_slibdir = $(slibdir)$(MULTIOSSUBDIR)
+
+# Work around what appears to be a GNU make bug handling MAKEFLAGS
+# values defined in terms of make variables, as is the case for CC and
+# friends when we are called from the top level Makefile.
+AM_MAKEFLAGS = \
+        "GCC_DIR=$(GCC_DIR)" \
+        "GM2_SRC=$(GM2_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+	"INSTALL=$(INSTALL)" \
+	"INSTALL_DATA=$(INSTALL_DATA)" \
+	"INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+	"INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+	"LDFLAGS=$(LDFLAGS)" \
+	"LIBCFLAGS=$(LIBCFLAGS)" \
+	"LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+	"MAKE=$(MAKE)" \
+	"MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+        "MULTISUBDIR=$(MULTISUBDIR)" \
+        "MULTIOSDIR=$(MULTIOSDIR)" \
+        "MULTIBUILDTOP=$(MULTIBUILDTOP)" \
+        "MULTIFLAGS=$(MULTIFLAGS)" \
+	"PICFLAG=$(PICFLAG)" \
+	"PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+	"SHELL=$(SHELL)" \
+	"RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+	"exec_prefix=$(exec_prefix)" \
+	"infodir=$(infodir)" \
+	"libdir=$(libdir)" \
+	"includedir=$(includedir)" \
+	"prefix=$(prefix)" \
+	"tooldir=$(tooldir)" \
+	"gxx_include_dir=$(gxx_include_dir)" \
+	"AR=$(AR)" \
+	"AS=$(AS)" \
+	"LD=$(LD)" \
+	"RANLIB=$(RANLIB)" \
+	"NM=$(NM)" \
+	"NM_FOR_BUILD=$(NM_FOR_BUILD)" \
+	"NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+	"DESTDIR=$(DESTDIR)" \
+	"WERROR=$(WERROR)" \
+        "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)"
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+
+
+if BUILD_ISOLIB
+M2DEFS = ChanConsts.def  CharClass.def \
+         ClientSocket.def  ComplexMath.def \
+         ConvStringLong.def  ConvStringReal.def \
+         ConvTypes.def  COROUTINES.def \
+         ErrnoCategory.def  EXCEPTIONS.def \
+         GeneralUserExceptions.def  IOChan.def \
+         IOConsts.def  IOLink.def \
+         IOResult.def  LongComplexMath.def \
+         LongConv.def  LongIO.def \
+         LongMath.def  LongStr.def \
+         LongWholeIO.def  LowLong.def \
+         LowReal.def  LowShort.def \
+         M2EXCEPTION.def  M2RTS.def \
+         MemStream.def \
+         Preemptive.def \
+         Processes.def  ProgramArgs.def \
+         RandomNumber.def \
+         RawIO.def  RealConv.def \
+         RealIO.def  RealMath.def \
+         RealStr.def  RndFile.def \
+         RTco.def \
+         RTdata.def  RTentity.def \
+         RTfio.def  RTgen.def \
+         RTgenif.def  RTio.def \
+         Semaphores.def  SeqFile.def \
+         ServerSocket.def  ShortComplexMath.def \
+         ShortIO.def  ShortWholeIO.def \
+         SimpleCipher.def  SIOResult.def \
+         SLongIO.def  SLongWholeIO.def \
+         SRawIO.def  SRealIO.def \
+         SShortIO.def  SShortWholeIO.def \
+         StdChans.def  STextIO.def \
+         Storage.def  StreamFile.def \
+         StringChan.def  Strings.def \
+         SWholeIO.def  SysClock.def \
+         SYSTEM.def  TermFile.def \
+         TERMINATION.def  TextIO.def \
+         WholeConv.def  WholeIO.def \
+         WholeStr.def  wrapsock.def \
+         wraptime.def
+
+M2MODS = ChanConsts.mod  CharClass.mod \
+         ClientSocket.mod  ComplexMath.mod \
+         ConvStringLong.mod  ConvStringReal.mod \
+         ConvTypes.mod  COROUTINES.mod \
+         EXCEPTIONS.mod  GeneralUserExceptions.mod \
+         IOChan.mod  IOConsts.mod \
+         IOLink.mod  IOResult.mod \
+         LongComplexMath.mod  LongConv.mod \
+         LongIO.mod  LongMath.mod \
+         LongStr.mod  LongWholeIO.mod \
+         LowLong.mod  LowReal.mod \
+         LowShort.mod  M2EXCEPTION.mod \
+         M2RTS.mod  MemStream.mod \
+         Preemptive.mod \
+         Processes.mod \
+         ProgramArgs.mod  RandomNumber.mod \
+         RawIO.mod  RealConv.mod \
+         RealIO.mod  RealMath.mod \
+         RealStr.mod  RndFile.mod \
+         RTdata.mod  RTentity.mod \
+         RTfio.mod  RTgenif.mod \
+         RTgen.mod  RTio.mod \
+         Semaphores.mod  SeqFile.mod \
+         ServerSocket.mod  ShortComplexMath.mod \
+         ShortIO.mod  ShortWholeIO.mod \
+         SimpleCipher.mod  SIOResult.mod \
+         SLongIO.mod  SLongWholeIO.mod \
+         SRawIO.mod  SRealIO.mod \
+         SShortIO.mod  SShortWholeIO.mod \
+         StdChans.mod  STextIO.mod \
+         Storage.mod  StreamFile.mod \
+         StringChan.mod  Strings.mod \
+         SWholeIO.mod  SysClock.mod \
+         SYSTEM.mod  TermFile.mod \
+         TERMINATION.mod  TextIO.mod \
+         WholeConv.mod  WholeIO.mod \
+         WholeStr.mod
+
+toolexeclib_LTLIBRARIES = libm2iso.la
+libm2iso_la_SOURCES =  $(M2MODS) \
+                     ErrnoCategory.cc  wrapsock.c \
+                     wraptime.c RTco.cc
+
+C_INCLUDES = -I.. -I$(toplevel_srcdir)/libiberty -I$(toplevel_srcdir)/include
+
+libm2isodir = libm2iso
+libm2iso_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2iso_la_SOURCES)))
+libm2iso_la_CFLAGS = $(C_INCLUDES) -I. -I.. -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -DBUILD_GM2_LIBS -I@srcdir@/../ -I../../../gcc -I$(GCC_DIR) -I$(GCC_DIR)/../include -I../../libgcc -I$(GCC_DIR)/../libgcc -I$(MULTIBUILDTOP)../../gcc/include
+libm2iso_la_M2FLAGS = -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -fiso -fextended-opaque -fm2-g -g
+libm2iso_la_LINK = $(LINK) -version-info $(libtool_VERSION)
+CLEANFILES = SYSTEM.def
+BUILT_SOURCES = SYSTEM.def
+
+M2LIBDIR = /m2/m2iso/
+
+M2HEADER_FILES = m2rts.h
+
+SYSTEM.def: Makefile
+	bash $(GM2_SRC)/tools-src/makeSystem -fiso \
+             $(GM2_SRC)/gm2-libs-iso/SYSTEM.def \
+             $(GM2_SRC)/gm2-libs-iso/SYSTEM.mod \
+             -I$(GM2_SRC)/gm2-libs-iso:$(GM2_SRC)/gm2-libs \
+             "$(GM2_FOR_TARGET)" $@
+
+## add these to the .mod.o rule when optimization is fixed $(CFLAGS_FOR_TARGET) $(LIBCFLAGS)
+
+.mod.lo:
+	$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2iso_la_M2FLAGS) $< -o $@
+
+.c.lo:
+	$(LIBTOOL) --tag=CC --mode=compile $(CC) -c $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+
+.cc.lo:
+	$(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+
+install-data-local: force
+	mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	$(INSTALL_DATA) .libs/libm2iso.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2iso.la
+	$(INSTALL_DATA) .libs/libm2iso.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)
+	chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)/libm2iso.a
+	$(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)/libm2iso.a
+	for i in $(M2DEFS) $(M2MODS) ; do \
+           if [ -f $$i ] ; then \
+              $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           elif [ -f @srcdir@/../../gcc/m2/gm2-libs-iso/$$i ] ; then \
+              $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-iso/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           else \
+              echo "cannot find $$i" ; exit 1 ; \
+           fi ; \
+           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+	done
+	for i in $(M2HEADER_FILES) ; do \
+           if [ -f @srcdir@/$$i ] ; then \
+              $(INSTALL_DATA) @srcdir@/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \
+           else \
+              echo "cannot find $$i" ; exit 1 ; \
+           fi ; \
+           chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \
+	done
+
+force:
+
+endif
diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/wraptime.c
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/libgm2/libm2iso/wraptime.c	2022-10-07 20:21:18.738098020 +0100
@@ -0,0 +1,408 @@
+/* wraptime.c provides access to time related system calls.
+
+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_TYPES_H)
+#include "sys/types.h"
+#endif
+
+#if defined(HAVE_SYS_TIME_H)
+#include "sys/time.h"
+#endif
+
+#if defined(HAVE_TIME_H)
+#include "time.h"
+#endif
+
+#if defined(HAVE_MALLOC_H)
+#include "malloc.h"
+#endif
+
+#if defined(HAVE_LIMITS_H)
+#include "limits.h"
+#endif
+
+#if !defined(TRUE)
+#define TRUE (1 == 1)
+#endif
+
+#if !defined(FALSE)
+#define FALSE (1 == 0)
+#endif
+
+#if !defined(NULL)
+#define NULL (void *)0
+#endif
+
+/* InitTimeval returns a newly created opaque type.  */
+
+#if defined(HAVE_TIMEVAL) && defined(HAVE_MALLOC_H)
+struct timeval *
+wraptime_InitTimeval (void)
+{
+  return (struct timeval *)malloc (sizeof (struct timeval));
+}
+#else
+void *
+wraptime_InitTimeval (void)
+{
+  return NULL;
+}
+#endif
+
+/* KillTimeval deallocates the memory associated with an opaque type.  */
+
+struct timeval *
+wraptime_KillTimeval (void *tv)
+{
+#if defined(HAVE_MALLOC_H)
+  free (tv);
+#endif
+  return NULL;
+}
+
+/* InitTimezone returns a newly created opaque type.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_MALLOC_H)
+struct timezone *
+wraptime_InitTimezone (void)
+{
+  return (struct timezone *)malloc (sizeof (struct timezone));
+}
+#else
+void *
+wraptime_InitTimezone (void)
+{
+  return NULL;
+}
+#endif
+
+/* KillTimezone - deallocates the memory associated with an opaque
+   type.  */
+
+struct timezone *
+wraptime_KillTimezone (struct timezone *tv)
+{
+#if defined(HAVE_MALLOC_H)
+  free (tv);
+#endif
+  return NULL;
+}
+
+/* InitTM - returns a newly created opaque type.  */
+
+#if defined(HAVE_STRUCT_TM) && defined(HAVE_MALLOC_H)
+struct tm *
+wraptime_InitTM (void)
+{
+  return (struct tm *)malloc (sizeof (struct tm));
+}
+#else
+void *
+wraptime_InitTM (void)
+{
+  return NULL;
+}
+#endif
+
+/* KillTM - deallocates the memory associated with an opaque type.  */
+
+struct tm *
+wraptime_KillTM (struct tm *tv)
+{
+#if defined(HAVE_MALLOC_H)
+  free (tv);
+#endif
+  return NULL;
+}
+
+/* gettimeofday - calls gettimeofday(2) with the same parameters, tv,
+   and, tz.  It returns 0 on success.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_GETTIMEOFDAY)
+int
+wraptime_gettimeofday (void *tv, struct timezone *tz)
+{
+  return gettimeofday (tv, tz);
+}
+#else
+int
+wraptime_gettimeofday (void *tv, void *tz)
+{
+  return -1;
+}
+#endif
+
+/* settimeofday - calls settimeofday(2) with the same parameters, tv,
+   and, tz.  It returns 0 on success.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_SETTIMEOFDAY)
+int
+wraptime_settimeofday (void *tv, struct timezone *tz)
+{
+  return settimeofday (tv, tz);
+}
+#else
+int
+wraptime_settimeofday (void *tv, void *tz)
+{
+  return -1;
+}
+#endif
+
+/* wraptime_GetFractions - returns the tv_usec field inside the
+   timeval structure.  */
+
+#if defined(HAVE_TIMEVAL)
+unsigned int
+wraptime_GetFractions (struct timeval *tv)
+{
+  return (unsigned int)tv->tv_usec;
+}
+#else
+unsigned int
+wraptime_GetFractions (void *tv)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* localtime_r - returns the tm parameter, m, after it has been
+   assigned with appropriate contents determined by, tv.  Notice that
+   this procedure function expects, timeval, as its first parameter
+   and not a time_t (as expected by the posix equivalent).  */
+
+#if defined(HAVE_TIMEVAL)
+struct tm *
+wraptime_localtime_r (struct timeval *tv, struct tm *m)
+{
+  return localtime_r (&tv->tv_sec, m);
+}
+#else
+struct tm *
+wraptime_localtime_r (void *tv, struct tm *m)
+{
+  return m;
+}
+#endif
+
+/* wraptime_GetYear - returns the year from the structure, m.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetYear (struct tm *m)
+{
+  return m->tm_year;
+}
+#else
+unsigned int
+wraptime_GetYear (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetMonth - returns the month from the structure, m.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetMonth (struct tm *m)
+{
+  return m->tm_mon;
+}
+#else
+unsigned int
+wraptime_GetMonth (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetDay - returns the day of the month from the structure,
+   m.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetDay (struct tm *m)
+{
+  return m->tm_mday;
+}
+#else
+unsigned int
+wraptime_GetDay (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetHour - returns the hour of the day from the structure,
+   m.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetHour (struct tm *m)
+{
+  return m->tm_hour;
+}
+#else
+unsigned int
+wraptime_GetHour (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetMinute - returns the minute within the hour from the
+   structure, m.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetMinute (struct tm *m)
+{
+  return m->tm_min;
+}
+#else
+unsigned int
+wraptime_GetMinute (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetSecond - returns the seconds in the minute from the
+   structure, m.  The return value will always be in the range 0..59.
+   A leap minute of value 60 will be truncated to 59.  */
+
+#if defined(HAVE_STRUCT_TM)
+unsigned int
+wraptime_GetSecond (struct tm *m)
+{
+  if (m->tm_sec == 60)
+    return 59;
+  else
+    return m->tm_sec;
+}
+#else
+unsigned int
+wraptime_GetSecond (void *m)
+{
+  return (unsigned int)-1;
+}
+#endif
+
+/* wraptime_GetSummerTime - returns true if summer time is in effect.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE)
+unsigned int
+wraptime_GetSummerTime (struct timezone *tz)
+{
+  return tz->tz_dsttime != 0;
+}
+#else
+unsigned int
+wraptime_GetSummerTime (void *tz)
+{
+  return FALSE;
+}
+#endif
+
+/* wraptime_GetDST - returns the number of minutes west of GMT.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE)
+int
+wraptime_GetDST (struct timezone *tz)
+{
+  return tz->tz_minuteswest;
+}
+#else
+int
+wraptime_GetDST (void *tz)
+{
+#if defined(INT_MIN)
+  return INT_MIN;
+#else
+  return (int)((unsigned int)-1);
+#endif
+}
+#endif
+
+/* SetTimezone - set the timezone field inside timeval, tv.  */
+
+#if defined(HAVE_STRUCT_TIMEZONE)
+void
+wraptime_SetTimezone (struct timezone *tz, int zone, int minuteswest)
+{
+  tz->tz_dsttime = zone;
+  tz->tz_minuteswest = minuteswest;
+}
+#else
+void
+wraptime_SetTimezone (void *tz, int zone, int minuteswest)
+{
+}
+#endif
+
+/* SetTimeval - sets the fields in tm, t, with: second, minute, hour,
+   day, month, year, fractions.  */
+
+#if defined(HAVE_TIMEVAL)
+void
+wraptime_SetTimeval (struct tm *t, unsigned int second, unsigned int minute,
+                     unsigned int hour, unsigned int day, unsigned int month,
+                     unsigned int year, unsigned int yday, unsigned int wday,
+                     unsigned int isdst)
+{
+  t->tm_sec = second;
+  t->tm_min = minute;
+  t->tm_hour = hour;
+  t->tm_mday = day;
+  t->tm_mon = month;
+  t->tm_year = year;
+  t->tm_yday = yday;
+  t->tm_wday = wday;
+  t->tm_isdst = isdst;
+}
+#else
+void
+wraptime_SetTimeval (void *t, unsigned int second, unsigned int minute,
+                     unsigned int hour, unsigned int day, unsigned int month,
+                     unsigned int year, unsigned int yday, unsigned int wday,
+                     unsigned int isdst)
+{
+}
+#endif
+
+/* init - init/finish functions for the module */
+
+void
+_M2_wraptime_init ()
+{
+}
+void
+_M2_wraptime_fini ()
+{
+}
diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/RTco.cc
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/libgm2/libm2iso/RTco.cc	2022-10-07 20:21:18.738098020 +0100
@@ -0,0 +1,468 @@
+/* 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)
+{
+  RTco_init ();
+  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);
+}

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2022-10-10 15:31 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-10-10 15:31 [PATCH] 5/19 modula2 front end: libgm2/libm2iso contents 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).