public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-5227] PR-108404 M2RTS_Halt fails with a segv
@ 2023-01-17 13:27 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-01-17 13:27 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:3a121c06f3cff8206883dea526bec4569876b059
commit r13-5227-g3a121c06f3cff8206883dea526bec4569876b059
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Tue Jan 17 13:27:42 2023 +0000
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:
---
gcc/m2/gm2-libs-iso/M2RTS.def | 17 +++++++--
gcc/m2/gm2-libs-iso/M2RTS.mod | 80 ++++++++++++++++++++++++++++++++++++-------
gcc/m2/gm2-libs/M2RTS.def | 19 +++++++---
gcc/m2/gm2-libs/M2RTS.mod | 80 ++++++++++++++++++++++++++++++++++++-------
libgm2/libm2iso/RTco.cc | 31 +++++++++--------
libgm2/libm2iso/m2rts.h | 4 ++-
6 files changed, 183 insertions(+), 48 deletions(-)
diff --git a/gcc/m2/gm2-libs-iso/M2RTS.def b/gcc/m2/gm2-libs-iso/M2RTS.def
index ce9c6ab9bc5..6958fd41667 100644
--- 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 2448c265ccf..cbe70a958d1 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 94ed2d09d57..b551725126e 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 0534c5dbb83..4280fec7dc7 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 ;
diff --git a/libgm2/libm2iso/RTco.cc b/libgm2/libm2iso/RTco.cc
index b6e46653530..eeb38106f12 100644
--- 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 57e6e90d94d..1f3bc2db7c4 100644
--- 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));
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-01-17 13:27 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-01-17 13:27 [gcc r13-5227] PR-108404 M2RTS_Halt fails with a segv 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).