@@ -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)
+{
+}
@@ -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));
@@ -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;
@@ -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);
+}
@@ -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
@@ -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 ()
+{
+}
@@ -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);
+}