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>

4 files changed, 163 insertions, 33 deletions

diff --git a/gcc/m2/gm2-libs-iso/M2RTS.def b/gcc/m2/gm2-libs-iso/M2RTS.def
index ce9c6ab..6958fd4 100644
--- a/gcc/m2/gm2-libs-iso/M2RTS.def
+++ b/gcc/m2/gm2-libs-iso/M2RTS.def
@@ -111,14 +111,25 @@ 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 2448c26..cbe70a9 100644
--- 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 94ed2d0..b551725 100644
--- 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 0534c5d..4280fec 100644
--- 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 ;