aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGaius Mulley <gaiusmod2@gmail.com>2023-09-26 18:08:37 +0100
committerGaius Mulley <gaiusmod2@gmail.com>2023-09-26 18:08:37 +0100
commit53daf67fd55e005e37cb3ab33ac0783a71761de9 (patch)
treea9595aa80b3e6824ee8f51ad346da408cc28b2ef
parente1e18ea0defe9e1ee35abbbe5279028ecf786957 (diff)
downloadgcc-53daf67fd55e005e37cb3ab33ac0783a71761de9.zip
gcc-53daf67fd55e005e37cb3ab33ac0783a71761de9.tar.gz
gcc-53daf67fd55e005e37cb3ab33ac0783a71761de9.tar.bz2
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>
-rw-r--r--gcc/m2/gm2-compiler/M2GenGCC.mod4
-rw-r--r--gcc/m2/gm2-compiler/M2Options.mod2
-rw-r--r--gcc/m2/gm2-compiler/M2Quads.mod36
3 files changed, 23 insertions, 19 deletions
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index c023eda..e0b024d 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 1a64cf0..9d72a10 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 0cea540..95ca15a 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -2581,6 +2581,23 @@ 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) ;