From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1499) id 6DC893858D28; Tue, 17 Jan 2023 13:27:58 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 6DC893858D28 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1673962078; bh=P19NE5lem0KNU10aypUvtxtre0OLTStK0/cdCaP20iQ=; h=From:To:Subject:Date:From; b=tkuOqe0XDbxaxmeICWqHjf1ZVfSQh+BtmF1JOYcBh6mbOez5haqK0ieXiG/IPkCxI cXBA0iNCsXpTefurmfdCc336SB9LcT+3OLCU9JaxXV/Y46bwLPXnDXOdAJ8P0SVtEg ywHd15UjvTZIMCTESJffep+jBCD51MZQRBar6qHU= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Gaius Mulley To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-5227] PR-108404 M2RTS_Halt fails with a segv X-Act-Checkin: gcc X-Git-Author: Gaius Mulley X-Git-Refname: refs/heads/master X-Git-Oldrev: be6d1a76d7eec27be54c4d0f5926da0e7fbf7837 X-Git-Newrev: 3a121c06f3cff8206883dea526bec4569876b059 Message-Id: <20230117132758.6DC893858D28@sourceware.org> Date: Tue, 17 Jan 2023 13:27:58 +0000 (GMT) List-Id: https://gcc.gnu.org/g:3a121c06f3cff8206883dea526bec4569876b059 commit r13-5227-g3a121c06f3cff8206883dea526bec4569876b059 Author: Gaius Mulley 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 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));