From 4d0faaaaf917528d1c59bfad5401274c5be71b7b Mon Sep 17 00:00:00 2001
From: Gaius Mulley <gaiusmod2@gmail.com>
Date: Tue, 4 Feb 2025 23:21:52 +0000
Subject: [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.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
---
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(-)
create mode 100644 gcc/testsuite/gm2/pim/run/pass/dectest.mod
create mode 100644 gcc/testsuite/gm2/pim/run/pass/inctest.mod
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 785a6e9885a8..46db4a6556da 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -7021,19 +7021,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
@@ -7084,14 +7084,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) ;
@@ -7328,19 +7326,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)
@@ -7387,9 +7385,8 @@ END CheckRangeIncDec ;
|----------------|
*)
-PROCEDURE BuildIncProcedure ;
+PROCEDURE BuildIncProcedure (proctok: CARDINAL) ;
VAR
- proctok : CARDINAL ;
NoOfParam,
dtype,
OperandSym,
@@ -7397,26 +7394,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}',
@@ -7460,9 +7456,8 @@ END BuildIncProcedure ;
|----------------|
*)
-PROCEDURE BuildDecProcedure ;
+PROCEDURE BuildDecProcedure (proctok: CARDINAL) ;
VAR
- proctok,
NoOfParam,
dtype,
OperandSym,
@@ -7470,26 +7465,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}',
@@ -7553,9 +7547,8 @@ END DereferenceLValue ;
|----------------|
*)
-PROCEDURE BuildInclProcedure ;
+PROCEDURE BuildInclProcedure (proctok: CARDINAL) ;
VAR
- proctok,
optok : CARDINAL ;
NoOfParam,
DerefSym,
@@ -7563,7 +7556,6 @@ VAR
VarSym : CARDINAL ;
BEGIN
PopT (NoOfParam) ;
- proctok := OperandTtok (NoOfParam + 1) ;
IF NoOfParam = 2
THEN
VarSym := OperandT (2) ;
@@ -7619,9 +7611,8 @@ END BuildInclProcedure ;
|----------------|
*)
-PROCEDURE BuildExclProcedure ;
+PROCEDURE BuildExclProcedure (proctok: CARDINAL) ;
VAR
- proctok,
optok : CARDINAL ;
NoOfParam,
DerefSym,
@@ -7629,7 +7620,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.
--
GitLab