PR-108404 M2RTS_Halt fails with a segv

PR-108404 occurs because the C prototype does not match the Modula-2
procedure M2RTS_Halt.  This patch provides a new procedure M2RTS_HaltC
which avoids the C/C++ code from having to fabricate a Modula-2 string.

gcc/m2/ChangeLog:

	* gm2-libs-iso/M2RTS.def (Halt): Parameter file renamed to filename.
	(HaltC): New procedure declaration.
	(ErrorMessage): Parameter file renamed to filename.
	* gm2-libs-iso/M2RTS.mod (Halt): Parameter file renamed to
	filename.
	(HaltC): New procedure implementation.
	(ErrorStringC): New procedure implementation.
	(ErrorMessageC): New procedure implementation.
	* gm2-libs/M2RTS.def (Halt): Parameter file renamed to filename.
	(HaltC): New procedure declaration.
	(ErrorMessage): Parameter file renamed to filename.
	* gm2-libs/M2RTS.mod (Halt): Parameter file renamed to filename.
	(HaltC): New procedure implementation.
	(ErrorStringC): New procedure implementation.
	(ErrorMessageC): New procedure implementation.

libgm2/ChangeLog:

	* libm2iso/RTco.cc (_M2_RTco_fini): Call M2RTS_HaltC.
	(newSem): Call M2RTS_HaltC.
	(currentThread): Call M2RTS_HaltC.
	(never): Call M2RTS_HaltC.
	(defined): Call M2RTS_HaltC.
	(initThread): Call M2RTS_HaltC.
	(RTco_transfer): Call M2RTS_HaltC.
	* libm2iso/m2rts.h (M2RTS_Halt): Provide parameter names.
	(M2RTS_HaltC): New procedure declaration.

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

diff --git a/gcc/m2/gm2-libs-iso/M2RTS.def b/gcc/m2/gm2-libs-iso/M2RTS.def
index ce9c6ab9bc5b004fb07ddf74f90d501f184089a9..6958fd416675553a858bab5905e8f519cf39be98 100644 (file)
--- a/gcc/m2/gm2-libs-iso/M2RTS.def
+++ b/gcc/m2/gm2-libs-iso/M2RTS.def
@@ -111,13 +111,24 @@ PROCEDURE HALT ([exitcode: INTEGER = -1]) ;
 
 (*
    Halt - provides a more user friendly version of HALT, which takes
-          four parameters to aid debugging.
+           four parameters to aid debugging.  It writes an error message
+           to stderr and calls exit (1).
 *)
 
-PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+PROCEDURE Halt (filename: ARRAY OF CHAR; line: CARDINAL;
                 function: ARRAY OF CHAR; description: ARRAY OF CHAR) ;
 
 
+(*
+   HaltC - provides a more user friendly version of HALT, which takes
+           four parameters to aid debugging.  It writes an error message
+           to stderr and calls exit (1).
+*)
+
+PROCEDURE HaltC (filename: ADDRESS; line: CARDINAL;
+                 function, description: ADDRESS) ;
+
+
 (*
    ExitOnHalt - if HALT is executed then call exit with the exit code, e.
 *)
@@ -130,7 +141,7 @@ PROCEDURE ExitOnHalt (e: INTEGER) ;
 *)
 
 PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
-                        file: ARRAY OF CHAR;
+                        filename: ARRAY OF CHAR;
                         line: CARDINAL;
                         function: ARRAY OF CHAR) ;
 

diff --git a/gcc/m2/gm2-libs-iso/M2RTS.mod b/gcc/m2/gm2-libs-iso/M2RTS.mod
index 2448c265ccfa045e4a62dae8b24c7e4d4b7fe88e..cbe70a958d17bef0856cd0e3b6277ee59740e788 100644 (file)
--- a/gcc/m2/gm2-libs-iso/M2RTS.mod
+++ b/gcc/m2/gm2-libs-iso/M2RTS.mod
@@ -27,7 +27,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 IMPLEMENTATION MODULE M2RTS ;
 
 
-FROM libc IMPORT abort, exit, write, getenv, printf ;
+FROM libc IMPORT abort, exit, write, getenv, printf, strlen ;
 (* FROM Builtins IMPORT strncmp, strcmp ;  not available during bootstrap.  *)
 FROM NumberIO IMPORT CardToStr ;
 FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
@@ -39,6 +39,9 @@ IMPORT RTExceptions ;
 IMPORT M2EXCEPTION ;
 IMPORT M2Dependent ;
 
+CONST
+   stderrFd = 2 ;
+
 TYPE
    PtrToChar = POINTER TO CHAR ;
 
@@ -255,24 +258,36 @@ PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
 VAR
    n: INTEGER ;
 BEGIN
-   n := write (2, ADR (a), StrLen (a))
+   n := write (stderrFd, ADR (a), StrLen (a))
 END ErrorString ;
 
 
+(*
+   ErrorStringC - writes a string to stderr.
+*)
+
+PROCEDURE ErrorStringC (str: ADDRESS) ;
+VAR
+   len: INTEGER ;
+BEGIN
+   len := write (stderrFd, str, strlen (str))
+END ErrorStringC ;
+
+
 (*
    ErrorMessage - emits an error message to stderr and then calls exit (1).
 *)
 
 PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
-                        file: ARRAY OF CHAR;
+                        filename: ARRAY OF CHAR;
                         line: CARDINAL;
                         function: ARRAY OF CHAR) <* noreturn *> ;
 VAR
-   LineNo: ARRAY [0..10] OF CHAR ;
+   buffer: ARRAY [0..10] OF CHAR ;
 BEGIN
-   ErrorString (file) ; ErrorString(':') ;
-   CardToStr (line, 0, LineNo) ;
-   ErrorString (LineNo) ; ErrorString(':') ;
+   ErrorString (filename) ; ErrorString(':') ;
+   CardToStr (line, 0, buffer) ;
+   ErrorString (buffer) ; ErrorString(':') ;
    IF NOT StrEqual (function, '')
    THEN
       ErrorString ('in ') ;
@@ -280,22 +295,61 @@ BEGIN
       ErrorString (' has caused ') ;
    END ;
    ErrorString (message) ;
-   LineNo[0] := nl ; LineNo[1] := nul ;
-   ErrorString (LineNo) ;
+   buffer[0] := nl ; buffer[1] := nul ;
+   ErrorString (buffer) ;
    exit (1)
 END ErrorMessage ;
 
 
+(*
+   ErrorMessageC - emits an error message to stderr and then calls exit (1).
+*)
+
+PROCEDURE ErrorMessageC (message, filename: ADDRESS;
+                         line: CARDINAL;
+                         function: ADDRESS) <* noreturn *> ;
+VAR
+   buffer: ARRAY [0..10] OF CHAR ;
+BEGIN
+   ErrorStringC (filename) ; ErrorString (':') ;
+   CardToStr (line, 0, buffer) ;
+   ErrorString (buffer) ; ErrorString(':') ;
+   IF strlen (function) > 0
+   THEN
+      ErrorString ('in ') ;
+      ErrorStringC (function) ;
+      ErrorString (' has caused ') ;
+   END ;
+   ErrorStringC (message) ;
+   buffer[0] := nl ; buffer[1] := nul ;
+   ErrorString (buffer) ;
+   exit (1)
+END ErrorMessageC ;
+
+
+(*
+   HaltC - provides a more user friendly version of HALT, which takes
+           four parameters to aid debugging.  It writes an error message
+           to stderr and calls exit (1).
+*)
+
+PROCEDURE HaltC (filename: ADDRESS; line: CARDINAL;
+                 function, description: ADDRESS) ;
+BEGIN
+   ErrorMessageC (description, filename, line, function)
+END HaltC ;
+
+
 (*
    Halt - provides a more user friendly version of HALT, which takes
-          four parameters to aid debugging.
+          four parameters to aid debugging.  It writes an error message
+          to stderr and calls exit (1).
 *)
 
-PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+PROCEDURE Halt (filename: ARRAY OF CHAR; line: CARDINAL;
                 function: ARRAY OF CHAR; description: ARRAY OF CHAR) ;
 BEGIN
-   ErrorMessage (description, file, line, function) ;
-   HALT
+   ErrorMessage (description, filename, line, function)
 END Halt ;
 
 

diff --git a/gcc/m2/gm2-libs/M2RTS.def b/gcc/m2/gm2-libs/M2RTS.def
index 94ed2d09d57e555fb14c443eec0f0d468725c345..b551725126e005682c876237b96fb47936b2496e 100644 (file)
--- a/gcc/m2/gm2-libs/M2RTS.def
+++ b/gcc/m2/gm2-libs/M2RTS.def
@@ -120,12 +120,23 @@ PROCEDURE HALT ([exitcode: INTEGER = -1]) <* noreturn *> ;
 
 (*
    Halt - provides a more user friendly version of HALT, which takes
-          four parameters to aid debugging.
+           four parameters to aid debugging.  It writes an error message
+           to stderr and calls exit (1).
 *)
 
-PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+PROCEDURE Halt (filename: ARRAY OF CHAR; line: CARDINAL;
                 function: ARRAY OF CHAR; description: ARRAY OF CHAR)
-               <* noreturn *> ;
+               <* noreturn *> ;
+
+
+(*
+   HaltC - provides a more user friendly version of HALT, which takes
+           four parameters to aid debugging.  It writes an error message
+           to stderr and calls exit (1).
+*)
+
+PROCEDURE HaltC (filename: ADDRESS; line: CARDINAL;
+                 function, description: ADDRESS) ;
 
 
 (*
@@ -140,7 +151,7 @@ PROCEDURE ExitOnHalt (e: INTEGER) ;
 *)
 
 PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
-                        file: ARRAY OF CHAR;
+                        filename: ARRAY OF CHAR;
                         line: CARDINAL;
                         function: ARRAY OF CHAR) <* noreturn *> ;
 

diff --git a/gcc/m2/gm2-libs/M2RTS.mod b/gcc/m2/gm2-libs/M2RTS.mod
index 0534c5dbb832f510d7e7929c33c366487250c0bf..4280fec7dc7912a6f8dad64df2e0895ad8572b01 100644 (file)
--- a/gcc/m2/gm2-libs/M2RTS.mod
+++ b/gcc/m2/gm2-libs/M2RTS.mod
@@ -27,7 +27,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 IMPLEMENTATION MODULE M2RTS ;
 
 
-FROM libc IMPORT abort, exit, write, getenv, printf ;
+FROM libc IMPORT abort, exit, write, getenv, printf, strlen ;
 (* FROM Builtins IMPORT strncmp, strcmp ;  not available during bootstrap.  *)
 FROM NumberIO IMPORT CardToStr ;
 FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
@@ -39,6 +39,9 @@ IMPORT RTExceptions ;
 IMPORT M2EXCEPTION ;
 IMPORT M2Dependent ;
 
+CONST
+   stderrFd = 2 ;
+
 TYPE
    PtrToChar = POINTER TO CHAR ;
 
@@ -254,24 +257,36 @@ PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
 VAR
    n: INTEGER ;
 BEGIN
-   n := write (2, ADR (a), StrLen (a))
+   n := write (stderrFd, ADR (a), StrLen (a))
 END ErrorString ;
 
 
+(*
+   ErrorStringC - writes a string to stderr.
+*)
+
+PROCEDURE ErrorStringC (str: ADDRESS) ;
+VAR
+   len: INTEGER ;
+BEGIN
+   len := write (stderrFd, str, strlen (str))
+END ErrorStringC ;
+
+
 (*
    ErrorMessage - emits an error message to stderr and then calls exit (1).
 *)
 
 PROCEDURE ErrorMessage (message: ARRAY OF CHAR;
-                        file: ARRAY OF CHAR;
+                        filename: ARRAY OF CHAR;
                         line: CARDINAL;
                         function: ARRAY OF CHAR) <* noreturn *> ;
 VAR
-   LineNo: ARRAY [0..10] OF CHAR ;
+   buffer: ARRAY [0..10] OF CHAR ;
 BEGIN
-   ErrorString (file) ; ErrorString(':') ;
-   CardToStr (line, 0, LineNo) ;
-   ErrorString (LineNo) ; ErrorString(':') ;
+   ErrorString (filename) ; ErrorString(':') ;
+   CardToStr (line, 0, buffer) ;
+   ErrorString (buffer) ; ErrorString(':') ;
    IF NOT StrEqual (function, '')
    THEN
       ErrorString ('in ') ;
@@ -279,22 +294,61 @@ BEGIN
       ErrorString (' has caused ') ;
    END ;
    ErrorString (message) ;
-   LineNo[0] := nl ; LineNo[1] := nul ;
-   ErrorString (LineNo) ;
+   buffer[0] := nl ; buffer[1] := nul ;
+   ErrorString (buffer) ;
    exit (1)
 END ErrorMessage ;
 
 
+(*
+   ErrorMessageC - emits an error message to stderr and then calls exit (1).
+*)
+
+PROCEDURE ErrorMessageC (message, filename: ADDRESS;
+                         line: CARDINAL;
+                         function: ADDRESS) <* noreturn *> ;
+VAR
+   buffer: ARRAY [0..10] OF CHAR ;
+BEGIN
+   ErrorStringC (filename) ; ErrorString (':') ;
+   CardToStr (line, 0, buffer) ;
+   ErrorString (buffer) ; ErrorString(':') ;
+   IF strlen (function) > 0
+   THEN
+      ErrorString ('in ') ;
+      ErrorStringC (function) ;
+      ErrorString (' has caused ') ;
+   END ;
+   ErrorStringC (message) ;
+   buffer[0] := nl ; buffer[1] := nul ;
+   ErrorString (buffer) ;
+   exit (1)
+END ErrorMessageC ;
+
+
+(*
+   HaltC - provides a more user friendly version of HALT, which takes
+           four parameters to aid debugging.  It writes an error message
+           to stderr and calls exit (1).
+*)
+
+PROCEDURE HaltC (filename: ADDRESS; line: CARDINAL;
+                 function, description: ADDRESS) ;
+BEGIN
+   ErrorMessageC (description, filename, line, function)
+END HaltC ;
+
+
 (*
    Halt - provides a more user friendly version of HALT, which takes
-          four parameters to aid debugging.
+          four parameters to aid debugging.  It writes an error message
+          to stderr and calls exit (1).
 *)
 
-PROCEDURE Halt (file: ARRAY OF CHAR; line: CARDINAL;
+PROCEDURE Halt (filename: ARRAY OF CHAR; line: CARDINAL;
                 function: ARRAY OF CHAR; description: ARRAY OF CHAR) ;
 BEGIN
-   ErrorMessage (description, file, line, function) ;
-   HALT
+   ErrorMessage (description, filename, line, function)
 END Halt ;
 
 

diff --git a/libgm2/libm2iso/RTco.cc b/libgm2/libm2iso/RTco.cc
index b6e46653530f3a216ad1ab580a7ba73a3553139b..eeb38106f12a7f04b3a1a90d17c93a62a6af19a6 100644 (file)
--- a/libgm2/libm2iso/RTco.cc
+++ b/libgm2/libm2iso/RTco.cc
@@ -110,6 +110,7 @@ _M2_RTco_fini (int argc, char *argv[], char *envp[])
 {
 }
 
+
 static void
 initSem (threadSem *sem, int value)
 {
@@ -171,8 +172,8 @@ newSem (void)
       = (threadSem *)malloc (sizeof (threadSem));
   nSemaphores += 1;
   if (nSemaphores == SEM_POOL)
-    M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
-                "too many semaphores created");
+    M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+                "too many semaphores created");
 #else
   threadSem *sem
       = (threadSem *)malloc (sizeof (threadSem));
@@ -250,8 +251,8 @@ currentThread (void)
   for (tid = 0; tid < nThreads; tid++)
     if (pthread_self () == threadArray[tid].p)
       return tid;
-  M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
-              "failed to find currentThread");
+  M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+              "failed to find currentThread");
 }
 
 extern "C" int
@@ -297,8 +298,8 @@ RTco_turnInterrupts (unsigned int newLevel)
 static void
 never (void)
 {
-  M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
-              "the main thread should never call here");
+  M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+              "the main thread should never call here");
 }
 
 static void *
@@ -316,7 +317,8 @@ execThread (void *t)
 #if 0
   M2RTS_CoroutineException ( __FILE__, __LINE__, __COLUMN__, __FUNCTION__, "coroutine finishing");
 #endif
-  M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "execThread should never finish");
+  M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+              "execThread should never finish");
   return NULL;
 }
 
@@ -326,7 +328,8 @@ newThread (void)
 #if defined(POOL)
   nThreads += 1;
   if (nThreads == THREAD_POOL)
-    M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "too many threads created");
+    M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+                "too many threads created");
   return nThreads - 1;
 #else
   if (nThreads == 0)
@@ -360,14 +363,14 @@ initThread (void (*proc) (void), unsigned int stackSize,
   /* set thread creation attributes.  */
   result = pthread_attr_init (&attr);
   if (result != 0)
-    M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__,
+    M2RTS_HaltC (__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__,
+        M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
                     "failed to set stack size attribute");
     }
 
@@ -376,7 +379,7 @@ initThread (void (*proc) (void), unsigned int stackSize,
   result = pthread_create (&threadArray[tid].p, &attr, execThread,
                            (void *)&threadArray[tid]);
   if (result != 0)
-    M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "thread_create failed");
+    M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__, "thread_create failed");
   tprintf ("  created thread [%d]  function = 0x%p  0x%p\n", tid, proc,
            (void *)&threadArray[tid]);
   return tid;
@@ -404,14 +407,14 @@ RTco_transfer (int *p1, int p2)
   int tid = currentThread ();
 
   if (!initialized)
-    M2RTS_Halt (
+    M2RTS_HaltC (
         __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");
+      M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+                  "attempting to transfer to ourself");
     }
   else
     {

diff --git a/libgm2/libm2iso/m2rts.h b/libgm2/libm2iso/m2rts.h
index 57e6e90d94db07db499477117e7aecfc8a07f446..1f3bc2db7c40cb221f6a388cb1d2ccc0379b9973 100644 (file)
--- a/libgm2/libm2iso/m2rts.h
+++ b/libgm2/libm2iso/m2rts.h
@@ -38,4 +38,6 @@ extern "C" void M2RTS_ConstructModules (const char *,
 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));
+extern "C" void M2RTS_HaltC (const char *filename, int line,
+                            const char *functionname, const char *desc)
+                             __attribute__ ((noreturn));