PR modula2/111510 runtime ICE findChildAndParent has caused internal runtime error

This patch fixes the runtime bug above.  The full runtime message is:
findChildAndParent has caused internal runtime error, RTentity is either
corrupt or the module storage has not been initialized yet.  The bug is
due to a non nul terminated string determining the module initialization order.
This results in modules being uninitialized and the above crash.  The bug
manifests itself on 32 bit systems - but obviously is latent on all
targets and the fix should be applied to both gcc-14 and gcc-13.

gcc/m2/ChangeLog:

	PR modula2/111510
	* gm2-compiler/M2GenGCC.mod (IsExportedGcc): Minor spacing changes.
	(BuildTrashTreeFromInterface): Minor spacing changes.
	* gm2-compiler/M2Options.mod (GetRuntimeModuleOverride): Call
	string to generate a nul terminated C style string.
	* gm2-compiler/M2Quads.mod (BuildStringAdrParam): New procedure.
	(BuildM2InitFunction): Replace inline parameter generation with
	calls to BuildStringAdrParam.

(cherry picked from commit 53daf67fd55e005e37cb3ab33ac0783a71761de9)

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

diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index bcef4e70c405ceed994708b44c4dbe8f442412eb..dc58f23247b93eea4b852cc0df8404dae2ea32bc 100644 (file)
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -388,7 +388,7 @@ BEGIN
    IF WholeProgram
    THEN
       scope := GetScope (sym) ;
-      WHILE scope#NulSym DO
+      WHILE scope # NulSym DO
          IF IsDefImp (scope)
          THEN
             RETURN IsExported (scope, sym)
@@ -766,7 +766,7 @@ VAR
    tree: Tree ;
 BEGIN
    tree := Tree (NIL) ;
-   IF sym#NulSym
+   IF sym # NulSym
    THEN
       i := 1 ;
       REPEAT

diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod
index f265aa5da2b5b0a13b532142265aa653c69e1179..75c2ad0ae7249a30b6e238adc4d2ba0c53a7cc84 100644 (file)
--- a/gcc/m2/gm2-compiler/M2Options.mod
+++ b/gcc/m2/gm2-compiler/M2Options.mod
@@ -1326,7 +1326,7 @@ END SetRuntimeModuleOverride ;
 
 PROCEDURE GetRuntimeModuleOverride () : ADDRESS ;
 BEGIN
-   RETURN RuntimeModuleOverride
+   RETURN string (RuntimeModuleOverride)
 END GetRuntimeModuleOverride ;
 
 

diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index be837b328e5d2bcdf81b96d86632d05854aa760e..9d4616ae6e64168ceb3af41ef5aa59d2312e6abf 100644 (file)
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -2579,6 +2579,23 @@ BEGIN
 END BuildM2MainFunction ;
 
 
+(*
+   BuildStringAdrParam - push the address of a nul terminated string onto the quad stack.
+*)
+
+PROCEDURE BuildStringAdrParam (tok: CARDINAL; name: Name);
+VAR
+   str, m2strnul: CARDINAL ;
+BEGIN
+   PushTF (Adr, Address) ;
+   str := MakeConstLitString (tok, name) ;
+   m2strnul := MakeConstStringM2nul (tok, str) ;
+   PushTtok (m2strnul, tok) ;
+   PushT (1) ;
+   BuildAdrFunction
+END BuildAdrFunction ;
+
+
 (*
    BuildM2InitFunction -
 *)
@@ -2619,22 +2636,9 @@ BEGIN
             (* ConstructModules (module_name, argc, argv, envp);  *)
             PushTtok (constructModules, tok) ;
 
-            PushTF(Adr, Address) ;
-            PushTtok (MakeConstLitString (tok, GetSymName (moduleSym)), tok) ;
-            PushT(1) ;
-            BuildAdrFunction ;
-
-            PushTF(Adr, Address) ;
-            PushTtok (MakeConstLitString (tok, GetLibName (moduleSym)), tok) ;
-            PushT(1) ;
-            BuildAdrFunction ;
-
-            PushTF(Adr, Address) ;
-            PushTtok (MakeConstLitString (tok,
-                                          makekey (GetRuntimeModuleOverride ())),
-                      tok) ;
-            PushT(1) ;
-            BuildAdrFunction ;
+           BuildStringAdrParam (tok, GetSymName (moduleSym)) ;
+           BuildStringAdrParam (tok, GetLibName (moduleSym)) ;
+           BuildStringAdrParam (tok, makekey (GetRuntimeModuleOverride ())) ;
 
             PushTtok (SafeRequestSym (tok, MakeKey ("argc")), tok) ;
             PushTtok (SafeRequestSym (tok, MakeKey ("argv")), tok) ;