https://gcc.gnu.org/g:3d961691e0878e1328f9cbbc1d1af5e573ee6786
commit r14-11306-g3d961691e0878e1328f9cbbc1d1af5e573ee6786
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Thu Feb 13 18:17:17 2025 +0000
[PATCH] PR modula2/115112 Incorrect line debugging information occurs
during INC builtin
This patch fixes location bugs in BuildDecProcedure,
BuildIncProcedure, BuildInclProcedure, BuildExclProcedure and
BuildThrow. All these procedure functions use the token position
passed as a parameter (rather than from the quad stack). It also
fixes location bugs in CheckRangeIncDec to ensure that the token
position is stored on the quad stack before calling subsidiary
procedure functions.
gcc/m2/ChangeLog:
PR modula2/115112
* gm2-compiler/M2Quads.mod (BuildPseudoProcedureCall): Pass
tokno to each build procedure.
(BuildThrowProcedure): New parameter functok.
(BuildIncProcedure): New parameter proctok.
Pass proctok on the quad stack during every push.
(BuildDecProcedure): Ditto.
(BuildInclProcedure): New parameter proctok.
(BuildExclProcedure): New parameter proctok.
gcc/testsuite/ChangeLog:
PR modula2/115112
* gm2/pim/run/pass/dectest.mod: New test.
* gm2/pim/run/pass/inctest.mod: New test.
(cherry picked from commit 4d0faaaaf917528d1c59bfad5401274c5be71b7b)
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Quads.mod | 64 +++++++++++++-----------------
gcc/testsuite/gm2/pim/run/pass/dectest.mod | 10 +++++
gcc/testsuite/gm2/pim/run/pass/inctest.mod | 10 +++++
3 files changed, 47 insertions(+), 37 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 2c3969805dc4..21699554a658 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -7020,19 +7020,19 @@ BEGIN
BuildDisposeProcedure (tokno)
ELSIF ProcSym = Inc
THEN
- BuildIncProcedure
+ BuildIncProcedure (tokno)
ELSIF ProcSym = Dec
THEN
- BuildDecProcedure
+ BuildDecProcedure (tokno)
ELSIF ProcSym = Incl
THEN
- BuildInclProcedure
+ BuildInclProcedure (tokno)
ELSIF ProcSym = Excl
THEN
- BuildExclProcedure
+ BuildExclProcedure (tokno)
ELSIF ProcSym = Throw
THEN
- BuildThrowProcedure
+ BuildThrowProcedure (tokno)
ELSE
InternalError ('pseudo procedure not implemented yet')
END
@@ -7083,14 +7083,12 @@ END GetItemPointedTo ;
|----------------|
*)
-PROCEDURE BuildThrowProcedure ;
+PROCEDURE BuildThrowProcedure (functok: CARDINAL) ;
VAR
- functok : CARDINAL ;
op : CARDINAL ;
NoOfParam: CARDINAL ;
BEGIN
PopT (NoOfParam) ;
- functok := OperandTtok (NoOfParam + 1) ;
IF NoOfParam = 1
THEN
op := OperandT (NoOfParam) ;
@@ -7327,19 +7325,19 @@ BEGIN
IF IsExpressionCompatible (dtype, etype)
THEN
(* the easy case simulate a straightforward macro *)
- PushTF (des, dtype) ;
+ PushTFtok (des, dtype, tokenpos) ;
PushT (tok) ;
- PushTF (expr, etype) ;
+ PushTFtok (expr, etype, tokenpos) ;
doBuildBinaryOp (FALSE, TRUE)
ELSE
IF (IsOrdinalType (dtype) OR (dtype = Address) OR IsPointer (dtype)) AND
(IsOrdinalType (etype) OR (etype = Address) OR IsPointer (etype))
THEN
- PushTF (des, dtype) ;
+ PushTFtok (des, dtype, tokenpos) ;
PushT (tok) ;
- PushTF (Convert, NulSym) ;
- PushT (dtype) ;
- PushT (expr) ;
+ PushTFtok (Convert, NulSym, tokenpos) ;
+ PushTtok (dtype, tokenpos) ;
+ PushTtok (expr, tokenpos) ;
PushT (2) ; (* Two parameters *)
BuildConvertFunction (Convert, FALSE) ;
doBuildBinaryOp (FALSE, TRUE)
@@ -7386,9 +7384,8 @@ END CheckRangeIncDec ;
|----------------|
*)
-PROCEDURE BuildIncProcedure ;
+PROCEDURE BuildIncProcedure (proctok: CARDINAL) ;
VAR
- proctok : CARDINAL ;
NoOfParam,
dtype,
OperandSym,
@@ -7396,26 +7393,25 @@ VAR
TempSym : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
- proctok := OperandTtok (NoOfParam + 1) ;
IF (NoOfParam = 1) OR (NoOfParam = 2)
THEN
- VarSym := OperandT (NoOfParam) ; (* bottom/first parameter *)
+ VarSym := OperandT (NoOfParam) ; (* Bottom/first parameter. *)
IF IsVar (VarSym)
THEN
dtype := GetDType (VarSym) ;
IF NoOfParam = 2
THEN
- OperandSym := DereferenceLValue (OperandTok (1), OperandT (1))
+ OperandSym := DereferenceLValue (proctok, OperandT (1))
ELSE
PushOne (proctok, dtype,
'the {%EkINC} will cause an overflow {%1ad}') ;
PopT (OperandSym)
END ;
- PushT (VarSym) ;
- TempSym := DereferenceLValue (OperandTok (NoOfParam), VarSym) ;
- CheckRangeIncDec (proctok, TempSym, OperandSym, PlusTok) ; (*
TempSym + OperandSym *)
- BuildAssignmentWithoutBounds (proctok, FALSE, TRUE) (* VarSym :=
TempSym + OperandSym *)
+ PushTtok (VarSym, proctok) ;
+ TempSym := DereferenceLValue (proctok, VarSym) ;
+ CheckRangeIncDec (proctok, TempSym, OperandSym, PlusTok) ; (*
TempSym + OperandSym. *)
+ BuildAssignmentWithoutBounds (proctok, FALSE, TRUE) (* VarSym :=
TempSym + OperandSym. *)
ELSE
MetaErrorT1 (proctok,
'base procedure {%EkINC} expects a variable as a
parameter but was given {%1Ed}',
@@ -7459,9 +7455,8 @@ END BuildIncProcedure ;
|----------------|
*)
-PROCEDURE BuildDecProcedure ;
+PROCEDURE BuildDecProcedure (proctok: CARDINAL) ;
VAR
- proctok,
NoOfParam,
dtype,
OperandSym,
@@ -7469,26 +7464,25 @@ VAR
TempSym : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
- proctok := OperandTtok (NoOfParam + 1) ;
IF (NoOfParam = 1) OR (NoOfParam = 2)
THEN
- VarSym := OperandT (NoOfParam) ; (* bottom/first parameter *)
+ VarSym := OperandT (NoOfParam) ; (* Bottom/first parameter. *)
IF IsVar (VarSym)
THEN
dtype := GetDType (VarSym) ;
IF NoOfParam = 2
THEN
- OperandSym := DereferenceLValue (OperandTok (1), OperandT (1))
+ OperandSym := DereferenceLValue (proctok, OperandT (1))
ELSE
PushOne (proctok, dtype,
'the {%EkDEC} will cause an overflow {%1ad}') ;
PopT (OperandSym)
END ;
- PushT (VarSym) ;
+ PushTtok (VarSym, proctok) ;
TempSym := DereferenceLValue (OperandTok (NoOfParam), VarSym) ;
- CheckRangeIncDec (proctok, TempSym, OperandSym, MinusTok) ; (*
TempSym - OperandSym *)
- BuildAssignmentWithoutBounds (proctok, FALSE, TRUE) (* VarSym :=
TempSym - OperandSym *)
+ CheckRangeIncDec (proctok, TempSym, OperandSym, MinusTok) ; (*
TempSym - OperandSym. *)
+ BuildAssignmentWithoutBounds (proctok, FALSE, TRUE) (* VarSym :=
TempSym - OperandSym. *)
ELSE
MetaErrorT1 (proctok,
'base procedure {%EkDEC} expects a variable as a
parameter but was given {%1Ed}',
@@ -7552,9 +7546,8 @@ END DereferenceLValue ;
|----------------|
*)
-PROCEDURE BuildInclProcedure ;
+PROCEDURE BuildInclProcedure (proctok: CARDINAL) ;
VAR
- proctok,
optok : CARDINAL ;
NoOfParam,
DerefSym,
@@ -7562,7 +7555,6 @@ VAR
VarSym : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
- proctok := OperandTtok (NoOfParam + 1) ;
IF NoOfParam = 2
THEN
VarSym := OperandT (2) ;
@@ -7618,9 +7610,8 @@ END BuildInclProcedure ;
|----------------|
*)
-PROCEDURE BuildExclProcedure ;
+PROCEDURE BuildExclProcedure (proctok: CARDINAL) ;
VAR
- proctok,
optok : CARDINAL ;
NoOfParam,
DerefSym,
@@ -7628,7 +7619,6 @@ VAR
VarSym : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
- proctok := OperandTtok (NoOfParam + 1) ;
IF NoOfParam=2
THEN
VarSym := OperandT (2) ;
diff --git a/gcc/testsuite/gm2/pim/run/pass/dectest.mod
b/gcc/testsuite/gm2/pim/run/pass/dectest.mod
new file mode 100644
index 000000000000..41d4744aff08
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/dectest.mod
@@ -0,0 +1,10 @@
+MODULE dectest ;
+
+VAR
+ c: CARDINAL ;
+BEGIN
+ c := 20 ;
+ WHILE c > 1 DO
+ DEC (c)
+ END
+END dectest.
diff --git a/gcc/testsuite/gm2/pim/run/pass/inctest.mod
b/gcc/testsuite/gm2/pim/run/pass/inctest.mod
new file mode 100644
index 000000000000..c4d9d2e0a358
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/inctest.mod
@@ -0,0 +1,10 @@
+MODULE inctest ;
+
+VAR
+ c: CARDINAL ;
+BEGIN
+ c := 0 ;
+ WHILE c < 20 DO
+ INC (c)
+ END
+END inctest.
