aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/m2/gm2-libs-iso/M2RTS.def17
-rw-r--r--gcc/m2/gm2-libs-iso/M2RTS.mod80
-rw-r--r--gcc/m2/gm2-libs/M2RTS.def19
-rw-r--r--gcc/m2/gm2-libs/M2RTS.mod80
-rw-r--r--libgm2/libm2iso/RTco.cc31
-rw-r--r--libgm2/libm2iso/m2rts.h4
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 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 ;
diff --git a/libgm2/libm2iso/RTco.cc b/libgm2/libm2iso/RTco.cc
index b6e4665..eeb3810 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 57e6e90..1f3bc2d 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));
generated by cgit v1.1 at 2024-10-01 13:25:54 +0000