From: Gaius Mulley <gaiusmod2@gmail.com>
Date: Tue, 26 Sep 2023 17:08:37 +0000 (+0100)
Subject: PR modula2/111510 runtime ICE findChildAndParent has caused internal runtime error
X-Git-Tag: basepoints/gcc-15~5857
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=53daf67fd55e005e37cb3ab33ac0783a71761de9;p=thirdparty%2Fgcc.git

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.

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 c023eda077b1..e0b024d244a5 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -391,7 +391,7 @@ BEGIN
    IF WholeProgram
    THEN
       scope := GetScope (sym) ;
-      WHILE scope#NulSym DO
+      WHILE scope # NulSym DO
          IF IsDefImp (scope)
          THEN
             RETURN IsExported (scope, sym)
@@ -771,7 +771,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 1a64cf0d4576..9d72a10b73eb 100644
--- 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 0cea54040f0a..95ca15a0b9e5 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -2580,6 +2580,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 -
 *)
@@ -2620,22 +2637,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) ;