public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-7650] PR modula2/110125 variables reported as uninitialized when set inside WITH
@ 2023-07-30 1:19 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-07-30 1:19 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:3fd979bf568d91016b797818e6c9c940b6f389bd
commit r13-7650-g3fd979bf568d91016b797818e6c9c940b6f389bd
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Sun Jul 30 02:18:57 2023 +0100
PR modula2/110125 variables reported as uninitialized when set inside WITH
The modula-2 static analysis incorrectly identifies variables as
uninitialized if they are initialized within a WITH statement. This bug
fix re-implements the variable static analysis and will detect simple
pointer record fields being accessed before being initialized.
The static analysis is limited to the first basic block in a procedure.
It does not check variant records, arrays or sets. A new option
-Wuninit-variable-checking will turn on the new semantic checking
(-Wall also enables the new checking).
gcc/ChangeLog:
PR modula2/110125
* doc/gm2.texi (Semantic checking): Include examples using
-Wuninit-variable-checking.
gcc/m2/ChangeLog:
PR modula2/110125
* Make-lang.in (GM2-COMP-BOOT-DEFS): Add M2SymInit.def.
(GM2-COMP-BOOT-MODS): Add M2SymInit.mod.
* gm2-compiler/M2BasicBlock.mod: Formatting changes.
* gm2-compiler/M2Code.mod: Remove import of VariableAnalysis from
M2Quads. Import VariableAnalysis from M2SymInit.mod.
* gm2-compiler/M2GCCDeclare.mod (PrintVerboseFromList):
Add debugging print for a component.
(TypeConstFullyDeclared): Call RememberType for every type.
* gm2-compiler/M2GenGCC.mod (CodeReturnValue): Add parameter to
GetQuadOtok.
(CodeBecomes): Add parameter to GetQuadOtok.
(CodeXIndr): Add parameter to GetQuadOtok.
* gm2-compiler/M2Optimize.mod (ReduceBranch): Reformat and
preserve operand token positions when reducing the branch
quadruples.
(ReduceGoto): Reformat.
(FoldMultipleGoto): Reformat.
(KnownReachable): Reformat.
* gm2-compiler/M2Options.def (UninitVariableChecking): New
variable declared and exported.
(SetUninitVariableChecking): New procedure.
* gm2-compiler/M2Options.mod (SetWall): Set
UninitVariableChecking.
(SetUninitVariableChecking): New procedure.
* gm2-compiler/M2Quads.def (PutQuadOtok): Exported and declared.
(VariableAnalysis): Removed.
* gm2-compiler/M2Quads.mod (PutQuadOtok): New procedure.
(doVal): Reformatted.
(MarkAsWrite): Reformatted.
(MarkArrayAsWritten): Reformatted.
(doIndrX): Use PutQuadOtok.
(MakeRightValue): Use GenQuadOtok.
(MakeLeftValue): Use GenQuadOtok.
(CheckReadBeforeInitialized): Remove.
(IsNeverAltered): Reformat.
(DebugLocation): New procedure.
(BuildDesignatorPointer): Use GenQuadO to preserve operand token
position.
(BuildRelOp): Use GenQuadOtok ditto.
* gm2-compiler/SymbolTable.def (VarCheckReadInit): New procedure.
(VarInitState): New procedure.
(PutVarInitialized): New procedure.
(PutVarFieldInitialized): New procedure function.
(GetVarFieldInitialized): New procedure function.
(PrintInitialized): New procedure.
* gm2-compiler/SymbolTable.mod (VarCheckReadInit): New procedure.
(VarInitState): New procedure.
(PutVarInitialized): New procedure.
(PutVarFieldInitialized): New procedure function.
(GetVarFieldInitialized): New procedure function.
(PrintInitialized): New procedure.
(LRInitDesc): New type.
(SymVar): InitState new field.
(MakeVar): Initialize InitState.
* gm2-gcc/m2options.h (M2Options_SetUninitVariableChecking):
New function declaration.
* gm2-lang.cc (gm2_langhook_handle_option): Detect
OPT_Wuninit_variable_checking and call SetUninitVariableChecking.
* lang.opt: Add Wuninit-variable-checking.
* gm2-compiler/M2SymInit.def: New file.
* gm2-compiler/M2SymInit.mod: New file.
gcc/testsuite/ChangeLog:
PR modula2/110125
* gm2/switches/uninit-variable-checking/fail/testinit.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testlarge.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testlarge2.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testrecinit.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testrecinit2.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testrecinit5.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testsmallrec.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testsmallrec2.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testsmallvec.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testvarinit.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testwithnoptr.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testwithptr.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testwithptr2.mod: New test.
* gm2/switches/uninit-variable-checking/fail/testwithptr3.mod: New test.
* gm2/switches/uninit-variable-checking/pass/testrecinit3.mod: New test.
* gm2/switches/uninit-variable-checking/pass/testrecinit5.mod: New test.
* gm2/switches/uninit-variable-checking/pass/testsmallrec.mod: New test.
* gm2/switches/uninit-variable-checking/pass/testsmallrec2.mod: New test.
* gm2/switches/uninit-variable-checking/pass/testvarinit.mod: New test.
* gm2/switches/uninit-variable-checking/pass/testwithptr.mod: New test.
* gm2/switches/uninit-variable-checking/pass/testwithptr2.mod: New test.
* gm2/switches/uninit-variable-checking/pass/testwithptr3.mod: New test.
(cherry picked from commit b0762d4c7e7894845e70e839c8513ae4c9e9d42e)
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/doc/gm2.texi | 126 ++
gcc/m2/Make-lang.in | 6 +-
gcc/m2/gm2-compiler/M2BasicBlock.mod | 2 +-
gcc/m2/gm2-compiler/M2Code.mod | 4 +-
gcc/m2/gm2-compiler/M2GCCDeclare.mod | 21 +-
gcc/m2/gm2-compiler/M2GenGCC.mod | 30 +-
gcc/m2/gm2-compiler/M2Optimize.mod | 97 +-
gcc/m2/gm2-compiler/M2Options.def | 10 +
gcc/m2/gm2-compiler/M2Options.mod | 14 +
gcc/m2/gm2-compiler/M2Quads.def | 28 +-
gcc/m2/gm2-compiler/M2Quads.mod | 238 ++--
gcc/m2/gm2-compiler/M2SymInit.def | 59 +
gcc/m2/gm2-compiler/M2SymInit.mod | 1307 ++++++++++++++++++++
gcc/m2/gm2-compiler/SymbolTable.def | 52 +-
gcc/m2/gm2-compiler/SymbolTable.mod | 173 ++-
gcc/m2/gm2-gcc/m2options.h | 2 +
gcc/m2/gm2-lang.cc | 3 +
gcc/m2/lang.opt | 4 +
.../switches-uninit-variable-checking-fail.exp | 37 +
.../uninit-variable-checking/fail/testinit.mod | 17 +
.../uninit-variable-checking/fail/testlarge.mod | 27 +
.../uninit-variable-checking/fail/testlarge2.mod | 24 +
.../uninit-variable-checking/fail/testrecinit.mod | 31 +
.../uninit-variable-checking/fail/testrecinit2.mod | 25 +
.../uninit-variable-checking/fail/testrecinit5.mod | 25 +
.../uninit-variable-checking/fail/testsmallrec.mod | 22 +
.../fail/testsmallrec2.mod | 24 +
.../uninit-variable-checking/fail/testsmallvec.mod | 20 +
.../uninit-variable-checking/fail/testvarinit.mod | 17 +
.../fail/testwithnoptr.mod | 29 +
.../uninit-variable-checking/fail/testwithptr.mod | 34 +
.../uninit-variable-checking/fail/testwithptr2.mod | 30 +
.../uninit-variable-checking/fail/testwithptr3.mod | 21 +
.../switches-uninit-variable-checking-pass.exp | 37 +
.../uninit-variable-checking/pass/testrecinit3.mod | 30 +
.../uninit-variable-checking/pass/testrecinit5.mod | 25 +
.../uninit-variable-checking/pass/testsmallrec.mod | 22 +
.../pass/testsmallrec2.mod | 24 +
.../uninit-variable-checking/pass/testvarinit.mod | 17 +
.../uninit-variable-checking/pass/testwithptr.mod | 34 +
.../uninit-variable-checking/pass/testwithptr2.mod | 31 +
.../uninit-variable-checking/pass/testwithptr3.mod | 31 +
42 files changed, 2608 insertions(+), 202 deletions(-)
diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi
index 3e531a8c6ea..ae87434217a 100644
--- a/gcc/doc/gm2.texi
+++ b/gcc/doc/gm2.texi
@@ -659,6 +659,11 @@ zero.
@item -fwholevalue
generate code to detect whole number overflow and underflow.
+@item -Wuninit-variable-checking
+issue a warning if a variable is used before it is initialized.
+The checking only occurs in the first basic block in each procedure.
+It does not check parameters, array types or set types.
+
@c the following warning options are complete but need to be
@c regression tested against all other front ends
@c to ensure the options do not conflict.
@@ -1452,6 +1457,127 @@ with @samp{-fsoft-check-all} so that the compiler is able to run the
optimizer and perform variable and flow analysis before the semantic
plugin is invoked.
+The @samp{-Wuninit-variable-checking} can be used to identify
+uninitialized variables within the first basic block in a procedure.
+The checking is limited to variables so long as they are
+not an array or set or a variant record.
+
+The following example detects whether a sub component within a record
+is uninitialized.
+
+@example
+MODULE testlarge2 ;
+
+TYPE
+ color = RECORD
+ r, g, b: CARDINAL ;
+ END ;
+
+ pixel = RECORD
+ fg, bg: color ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ p: pixel ;
+BEGIN
+ p.fg.r := 1 ;
+ p.fg.g := 2 ;
+ p.fg.g := 3 ; (* Deliberate typo should be p.fg.b. *)
+ p.bg := p.fg ; (* Accessing an uninitialized field. *)
+END test ;
+
+BEGIN
+ test
+END testlarge2.
+@end example
+
+@example
+$ gm2 -c -Wuninit-variable-checking testlarge2.mod
+testlarge2.mod:19:13: warning: In procedure ‘test’: attempting to
+access expression before it has been initialized
+ 19 | p.bg := p.fg ; (* Accessing an uninitialized field. *)
+ | ~^~~
+@end example
+
+The following example detects if an individual field is uninitialized.
+
+@example
+MODULE testwithnoptr ;
+
+TYPE
+ Vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ p: Vec ;
+BEGIN
+ WITH p DO
+ x := 1 ;
+ x := 2 (* Deliberate typo, user meant y. *)
+ END ;
+ IF p.y = 2
+ THEN
+ END
+END test ;
+
+BEGIN
+ test
+END testwithnoptr.
+@end example
+
+The following example detects a record is uninitialized via a
+pointer variable in a @samp{WITH} block.
+
+@example
+$ gm2 -g -c -Wuninit-variable-checking testwithnoptr.mod
+testwithnoptr.mod:21:8: warning: In procedure ‘test’: attempting to
+access expression before it has been initialized
+ 21 | IF p.y = 2
+ | ~^~
+@end example
+
+@example
+MODULE testwithptr ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ p: PtrToVec ;
+ v: Vec ;
+BEGIN
+ p := ADR (v) ;
+ WITH p^ DO
+ x := 1 ;
+ x := 2 (* Deliberate typo, user meant y. *)
+ END ;
+ IF p^.y = 2
+ THEN
+ END
+END test ;
+
+BEGIN
+ test
+END testwithptr.
+@end example
+
+@example
+gm2 -c -Wuninit-variable-checking testwithptr.mod
+testwithptr.mod:26:9: warning: In procedure ‘test’: attempting to
+access expression before it has been initialized
+ 26 | IF p^.y = 2
+ | ~~^~
+@end example
+
@node Extensions, Type compatibility, Semantic checking, Using
@section GNU Modula-2 language extensions
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index 07fd054725f..8b2c022c7f3 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -462,7 +462,7 @@ GM2_G=-g -fm2-g
GM2_CPP=
# GM2_DEBUG_STRMEM=-fcpp
GM2_DEBUG_STRMEM=
-GM2_FLAGS=-Wunused-variable -fsoft-check-all \
+GM2_FLAGS=-Wunused-variable -Wuninit-variable-checking -fsoft-check-all \
-fno-return -Wreturn-type \
$(GM2_G) $(GM2_O) \
-funbounded-by-reference -fpim -fextended-opaque \
@@ -748,6 +748,7 @@ GM2-COMP-BOOT-DEFS = \
M2StackWord.def \
M2Students.def \
M2Swig.def \
+ M2SymInit.def \
M2System.def \
NameKey.def \
ObjectFiles.def \
@@ -820,6 +821,7 @@ GM2-COMP-BOOT-MODS = \
M2StackWord.mod \
M2Students.mod \
M2Swig.mod \
+ M2SymInit.mod \
M2System.mod \
NameKey.mod \
NameKey.mod \
@@ -1025,6 +1027,7 @@ GM2-COMP-DEFS = \
M2StackWord.def \
M2Students.def \
M2Swig.def \
+ M2SymInit.def \
M2System.def \
NameKey.def \
ObjectFiles.def \
@@ -1094,6 +1097,7 @@ GM2-COMP-MODS = \
M2StackWord.mod \
M2Students.mod \
M2Swig.mod \
+ M2SymInit.mod \
M2System.mod \
NameKey.mod \
ObjectFiles.mod \
diff --git a/gcc/m2/gm2-compiler/M2BasicBlock.mod b/gcc/m2/gm2-compiler/M2BasicBlock.mod
index 61eb6130fb1..1d005f6d74a 100644
--- a/gcc/m2/gm2-compiler/M2BasicBlock.mod
+++ b/gcc/m2/gm2-compiler/M2BasicBlock.mod
@@ -242,7 +242,7 @@ BEGIN
b := bb ;
REPEAT
WITH b^ DO
- p(StartQuad, EndQuad)
+ p (StartQuad, EndQuad)
END ;
b := b^.Right
UNTIL b=bb
diff --git a/gcc/m2/gm2-compiler/M2Code.mod b/gcc/m2/gm2-compiler/M2Code.mod
index 6965b44e6c5..c4069e9a8d7 100644
--- a/gcc/m2/gm2-compiler/M2Code.mod
+++ b/gcc/m2/gm2-compiler/M2Code.mod
@@ -42,9 +42,11 @@ FROM NameKey IMPORT Name ;
FROM M2Batch IMPORT ForeachSourceModuleDo ;
FROM M2Quads IMPORT CountQuads, GetFirstQuad, DisplayQuadList, DisplayQuadRange,
- BackPatchSubrangesAndOptParam, VariableAnalysis,
+ BackPatchSubrangesAndOptParam,
LoopAnalysis, ForLoopAnalysis, GetQuad, QuadOperator ;
+FROM M2SymInit IMPORT VariableAnalysis ;
+
FROM M2Pass IMPORT SetPassToNoPass, SetPassToCodeGeneration ;
FROM M2BasicBlock IMPORT BasicBlock,
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
index 5c171f728ac..c50272674fa 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -120,7 +120,7 @@ FROM SymbolTable IMPORT NulSym,
ForeachLocalSymDo, ForeachFieldEnumerationDo,
ForeachProcedureDo, ForeachModuleDo,
ForeachInnerModuleDo, ForeachImportedDo,
- ForeachExportedDo ;
+ ForeachExportedDo, PrintInitialized ;
FROM M2Base IMPORT IsPseudoBaseProcedure, IsPseudoBaseFunction,
GetBaseTypeMinMax, MixTypes,
@@ -339,7 +339,6 @@ END DebugSetNumbers ;
lists.
*)
-(*
PROCEDURE AddSymToWatch (sym: WORD) ;
BEGIN
IF (sym#NulSym) AND (NOT IsElementInSet(WatchList, sym))
@@ -350,7 +349,6 @@ BEGIN
FIO.FlushBuffer(FIO.StdOut)
END
END AddSymToWatch ;
-*)
(*
@@ -409,7 +407,7 @@ BEGIN
tobesolvedbyquads : doInclude(ToBeSolvedByQuads, "symbol %d -> ToBeSolvedByQuads\n", sym) |
fullydeclared : doInclude(FullyDeclared, "symbol %d -> FullyDeclared\n", sym) ;
- IF sym=1265
+ IF sym=8821
THEN
mystop
END |
@@ -2797,7 +2795,7 @@ PROCEDURE StartDeclareScope (scope: CARDINAL) ;
VAR
n: Name ;
BEGIN
- (* AddSymToWatch (1265) ; *)
+ (* AddSymToWatch (8821) ; *)
(* AddSymToWatch (1157) ; *) (* watch goes here *)
(* AddSymToWatch(TryFindSymbol('IOLink', 'DeviceId')) ; *)
(* AddSymToWatch(819) ; *)
@@ -3911,6 +3909,8 @@ BEGIN
THEN
printf0('component ')
END ;
+ printf0 ('\n') ;
+ PrintInitialized (sym) ;
IncludeType(l, sym)
ELSIF IsConst(sym)
THEN
@@ -5229,16 +5229,7 @@ BEGIN
t := CheckAlignment(t, sym)
END
END ;
- IF GetSymName(sym)#NulName
- THEN
- IF Debugging
- THEN
- n := GetSymName(sym) ;
- printf1('declaring type %a\n', n)
- END ;
- t := RememberType(t)
- END ;
- RETURN( t )
+ RETURN RememberType (t)
END TypeConstFullyDeclared ;
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 90e237d82f5..8b877e272e4 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -1842,13 +1842,14 @@ END CodeProcedureScope ;
PROCEDURE CodeReturnValue (quad: CARDINAL) ;
VAR
op : QuadOperator ;
+ overflowChecking : BOOLEAN ;
expr, none, procedure : CARDINAL ;
combinedpos,
returnpos, exprpos, nonepos, procpos: CARDINAL ;
value, length : Tree ;
location : location_t ;
BEGIN
- GetQuadOtok (quad, returnpos, op, expr, none, procedure,
+ GetQuadOtok (quad, returnpos, op, expr, none, procedure, overflowChecking,
exprpos, nonepos, procpos) ;
combinedpos := MakeVirtualTok (returnpos, returnpos, exprpos) ;
location := TokenToLocation (combinedpos) ;
@@ -3079,18 +3080,19 @@ END checkDeclare ;
PROCEDURE CodeBecomes (quad: CARDINAL) ;
VAR
- op : QuadOperator ;
- op1, op2,
- op3 : CARDINAL ;
+ overflowChecking: BOOLEAN ;
+ op : QuadOperator ;
+ op1, op2, op3 : CARDINAL ;
becomespos,
op1pos,
op2pos,
- op3pos : CARDINAL ;
+ op3pos : CARDINAL ;
length,
- op3t : Tree ;
- location : location_t ;
+ op3t : Tree ;
+ location : location_t ;
BEGIN
- GetQuadOtok (quad, becomespos, op, op1, op2, op3, op1pos, op2pos, op3pos) ;
+ GetQuadOtok (quad, becomespos, op, op1, op2, op3, overflowChecking,
+ op1pos, op2pos, op3pos) ;
Assert (op2pos = UnknownTokenNo) ;
DeclareConstant (CurrentQuadToken, op3) ; (* Check to see whether op3 is a constant and declare it. *)
DeclareConstructor (CurrentQuadToken, quad, op3) ;
@@ -7177,7 +7179,8 @@ END CodeIndrX ;
PROCEDURE CodeXIndr (quad: CARDINAL) ;
VAR
- op : QuadOperator ;
+ overflowChecking: BOOLEAN ;
+ op : QuadOperator ;
tokenno,
op1,
type,
@@ -7185,12 +7188,13 @@ VAR
op1pos,
op3pos,
typepos,
- xindrpos: CARDINAL ;
+ xindrpos : CARDINAL ;
length,
- newstr : Tree ;
- location: location_t ;
+ newstr : Tree ;
+ location : location_t ;
BEGIN
- GetQuadOtok (quad, xindrpos, op, op1, type, op3, op1pos, typepos, op3pos) ;
+ GetQuadOtok (quad, xindrpos, op, op1, type, op3, overflowChecking,
+ op1pos, typepos, op3pos) ;
tokenno := MakeVirtualTok (xindrpos, op1pos, op3pos) ;
location := TokenToLocation (tokenno) ;
diff --git a/gcc/m2/gm2-compiler/M2Optimize.mod b/gcc/m2/gm2-compiler/M2Optimize.mod
index ca03092986d..416eb42c6a7 100644
--- a/gcc/m2/gm2-compiler/M2Optimize.mod
+++ b/gcc/m2/gm2-compiler/M2Optimize.mod
@@ -58,8 +58,7 @@ FROM SymbolTable IMPORT GetSymName,
FROM M2Quads IMPORT QuadOperator, GetQuad, GetFirstQuad, GetNextQuad,
PutQuad, SubQuad, Opposite, IsReferenced,
- GetRealQuad ;
-
+ GetRealQuad, GetQuadOtok, PutQuadOtok ;
(*
FoldBranches - folds unneccessary branches in the list of quadruples.
@@ -114,14 +113,14 @@ BEGIN
GetQuad(i, Operator, Operand1, Operand2, Operand3) ;
CASE Operator OF
- GotoOp : Folded := ReduceGoto(i, Operand3,
- Right, Folded) |
+ GotoOp : Folded := ReduceGoto (i, Operand3,
+ Right, Folded) |
IfInOp, IfNotInOp,
IfNotEquOp, IfEquOp,
IfLessEquOp, IfGreEquOp,
- IfGreOp, IfLessOp : Folded := ReduceBranch(Operator, i,
- Operand1, Operand2, Operand3,
- Right, Folded)
+ IfGreOp, IfLessOp : Folded := ReduceBranch (Operator, i,
+ Operand1, Operand2, Operand3,
+ Right, Folded)
ELSE
END ;
@@ -154,48 +153,56 @@ PROCEDURE ReduceBranch (Operator: QuadOperator;
VAR NextQuad: CARDINAL;
Folded: BOOLEAN) : BOOLEAN ;
VAR
- OpNext : QuadOperator ;
+ overflowChecking: BOOLEAN ;
+ OpNext : QuadOperator ;
+ tok,
NextPlusOne,
Op1Next,
Op2Next,
Op3Next,
- From,
- To : CARDINAL ;
+ op1tok,
+ op2tok,
+ op3tok,
+ From, To : CARDINAL ;
BEGIN
(* If op NextQuad+1 *)
(* Goto x *)
IF NextQuad#0
THEN
- IF (GetNextQuad(CurrentQuad)=CurrentOperand3) OR
- (GetRealQuad(GetNextQuad(CurrentQuad))=CurrentOperand3)
+ IF (GetNextQuad (CurrentQuad) = CurrentOperand3) OR
+ (GetRealQuad (GetNextQuad (CurrentQuad)) = CurrentOperand3)
THEN
- SubQuad(CurrentQuad) ;
+ SubQuad (CurrentQuad) ;
Folded := TRUE
ELSE
- From := GetNextQuad(CurrentQuad) ; (* start after CurrentQuad *)
+ From := GetNextQuad (CurrentQuad) ; (* start after CurrentQuad *)
To := NextQuad ;
- CurrentOperand3 := GetRealQuad(CurrentOperand3) ;
+ CurrentOperand3 := GetRealQuad (CurrentOperand3) ;
- NextPlusOne := GetRealQuad(GetNextQuad(NextQuad)) ;
- GetQuad(NextQuad, OpNext, Op1Next, Op2Next, Op3Next) ;
- IF (OpNext=GotoOp) AND (NextPlusOne=CurrentOperand3) AND
- IsBasicBlock(From, To)
+ NextPlusOne := GetRealQuad (GetNextQuad (NextQuad)) ;
+ GetQuad (NextQuad, OpNext, Op1Next, Op2Next, Op3Next) ;
+ IF (OpNext = GotoOp) AND (NextPlusOne = CurrentOperand3) AND
+ IsBasicBlock (From, To)
THEN
- (* Op3Next := GetRealQuad(Op3Next) ; *)
- SubQuad(NextQuad) ;
- PutQuad(CurrentQuad, Opposite(Operator),
- CurrentOperand1, CurrentOperand2, Op3Next) ;
+ GetQuadOtok (CurrentQuad, tok, Operator,
+ CurrentOperand1, CurrentOperand2, CurrentOperand3,
+ overflowChecking, op1tok, op2tok, op3tok) ;
+ SubQuad (NextQuad) ;
+ PutQuadOtok (CurrentQuad, tok, Opposite (Operator),
+ CurrentOperand1, CurrentOperand2, Op3Next,
+ overflowChecking,
+ op1tok, op2tok, op3tok) ;
NextQuad := NextPlusOne ;
Folded := TRUE
END
END ;
- IF FoldMultipleGoto(CurrentQuad)
+ IF FoldMultipleGoto (CurrentQuad)
THEN
Folded := TRUE
END
END ;
- RETURN( Folded )
+ RETURN Folded
END ReduceBranch ;
@@ -237,20 +244,20 @@ END IsBasicBlock ;
PROCEDURE ReduceGoto (CurrentQuad, CurrentOperand3, NextQuad: CARDINAL;
Folded: BOOLEAN) : BOOLEAN ;
BEGIN
- CurrentOperand3 := GetRealQuad(CurrentOperand3) ;
+ CurrentOperand3 := GetRealQuad (CurrentOperand3) ;
(* IF next quad is a GotoOp *)
- IF CurrentOperand3=NextQuad
+ IF CurrentOperand3 = NextQuad
THEN
- SubQuad(CurrentQuad) ;
+ SubQuad (CurrentQuad) ;
Folded := TRUE
ELSE
(* Does Goto point to another Goto ? *)
- IF FoldMultipleGoto(CurrentQuad)
+ IF FoldMultipleGoto (CurrentQuad)
THEN
Folded := TRUE
END
END ;
- RETURN( Folded )
+ RETURN Folded
END ReduceGoto ;
@@ -272,18 +279,18 @@ VAR
Operand2,
Operand3: CARDINAL ;
BEGIN
- GetQuad(QuadNo, Operator, Operand1, Operand2, Operand3) ;
- Operand3 := GetRealQuad(Operand3) ; (* skip pseudo quadruples *)
- GetQuad(Operand3, Op, Op1, Op2, Op3) ;
- IF Op=GotoOp
+ GetQuad (QuadNo, Operator, Operand1, Operand2, Operand3) ;
+ Operand3 := GetRealQuad (Operand3) ; (* skip pseudo quadruples *)
+ GetQuad (Operand3, Op, Op1, Op2, Op3) ;
+ IF Op = GotoOp
THEN
- PutQuad(QuadNo, Operator, Operand1, Operand2, Op3) ;
+ PutQuad (QuadNo, Operator, Operand1, Operand2, Op3) ;
(* Dont want success to be returned if in fact the Goto *)
(* line number has not changed... otherwise we loop *)
(* forever. *)
- RETURN( Op3#Operand3 )
+ RETURN Op3 # Operand3
ELSE
- RETURN( FALSE )
+ RETURN FALSE
END
END FoldMultipleGoto ;
@@ -352,29 +359,29 @@ BEGIN
IF Start#0
THEN
REPEAT
- GetQuad(Start, Op, Op1, Op2, Op3) ;
+ GetQuad (Start, Op, Op1, Op2, Op3) ;
CASE Op OF
- CallOp : KnownReach(Op3) |
+ CallOp : KnownReach (Op3) |
AddrOp,
ParamOp,
XIndrOp,
- BecomesOp: KnownReach(Op3) ;
- CheckNeedSavePriority(Op3)
+ BecomesOp: KnownReach (Op3) ;
+ CheckNeedSavePriority (Op3)
ELSE
END ;
- Start := GetNextQuad(Start)
- UNTIL (Start>End) OR (Start=0)
+ Start := GetNextQuad (Start)
+ UNTIL (Start > End) OR (Start = 0)
END
END KnownReachable ;
PROCEDURE KnownReach (sym: CARDINAL) ;
BEGIN
- IF IsProcedure(sym) AND (NOT IsProcedureReachable(sym))
+ IF IsProcedure (sym) AND (NOT IsProcedureReachable (sym))
THEN
- RemoveProcedures(sym)
+ RemoveProcedures (sym)
END
END KnownReach ;
diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def
index 7e4d2aa6b41..722e56c69c7 100644
--- a/gcc/m2/gm2-compiler/M2Options.def
+++ b/gcc/m2/gm2-compiler/M2Options.def
@@ -72,6 +72,7 @@ EXPORT QUALIFIED SetReturnCheck, SetNilCheck, SetCaseCheck,
AutoInit,
VariantValueChecking,
UnusedVariableChecking, UnusedParameterChecking,
+ UninitVariableChecking, SetUninitVariableChecking,
SetUnusedVariableChecking, SetUnusedParameterChecking,
Quiet, LineDirectives, StrictTypeChecking,
CPreProcessor, Xcode, ExtendedOpaque,
@@ -159,6 +160,8 @@ VAR
Exceptions, (* Should we generate exception code? *)
UnusedVariableChecking, (* Should we warn about unused variables? *)
UnusedParameterChecking, (* Should we warn about unused parameters? *)
+ UninitVariableChecking, (* Should we warn about accessing *)
+ (* uninitialized variables in the first bb? *)
LowerCaseKeywords, (* Should keywords in errors be in lower? *)
DebugBuiltins, (* Should we always call a real function? *)
AutoInit, (* -fauto-init assigns pointers to NIL. *)
@@ -918,6 +921,13 @@ PROCEDURE GetGenModuleFilename () : String ;
PROCEDURE SetShared (value: BOOLEAN) ;
+(*
+ SetUninitVariableChecking - sets the UninitVariableChecking flag to value.
+*)
+
+PROCEDURE SetUninitVariableChecking (value: BOOLEAN) ;
+
+
(*
FinaliseOptions - once all options have been parsed we set any inferred
values.
diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod
index 7cacee26bcf..84fcb572319 100644
--- a/gcc/m2/gm2-compiler/M2Options.mod
+++ b/gcc/m2/gm2-compiler/M2Options.mod
@@ -1190,6 +1190,7 @@ PROCEDURE SetWall (value: BOOLEAN) ;
BEGIN
UnusedVariableChecking := value ;
UnusedParameterChecking := value ;
+ UninitVariableChecking := value ;
PedanticCast := value ;
PedanticParamNames := value ;
StyleChecking := value
@@ -1226,6 +1227,7 @@ BEGIN
RETURN SaveTempsDir
END GetSaveTempsDir ;
+
(*
SetDumpDir - Set the dump dir.
*)
@@ -1363,6 +1365,17 @@ BEGIN
END SetShared ;
+(*
+ SetUninitVariableChecking - sets the UninitVariableChecking flag to value.
+*)
+
+PROCEDURE SetUninitVariableChecking (value: BOOLEAN) ;
+BEGIN
+ UninitVariableChecking := value
+END SetUninitVariableChecking ;
+
+
+
BEGIN
cflag := FALSE ; (* -c. *)
RuntimeModuleOverride := InitString (DefaultRuntimeModuleOverride) ;
@@ -1433,6 +1446,7 @@ BEGIN
MQarg := NIL ;
SaveTempsDir := NIL ;
DumpDir := NIL ;
+ UninitVariableChecking := FALSE ;
M2Prefix := InitString ('') ;
M2PathName := InitString ('')
END M2Options.
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index fcb59bbcf49..ef6c06c3959 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -129,13 +129,13 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile,
GetQuad, GetFirstQuad, GetNextQuad, PutQuad,
SubQuad, EraseQuad, GetRealQuad,
- GetQuadtok, GetQuadOtok,
+ GetQuadtok, GetQuadOtok, PutQuadOtok,
GetQuadOp, GetM2OperatorDesc,
CountQuads,
GetLastFileQuad,
GetLastQuadNo,
QuadToLineNo, QuadToTokenNo,
- VariableAnalysis, LoopAnalysis, ForLoopAnalysis,
+ LoopAnalysis, ForLoopAnalysis,
AddVarientFieldToList, AddRecordToList,
AddVarientToList,
AddVarientRange, AddVarientEquality,
@@ -477,9 +477,23 @@ PROCEDURE GetQuadOtok (QuadNo: CARDINAL;
VAR tok: CARDINAL;
VAR Op: QuadOperator;
VAR Oper1, Oper2, Oper3: CARDINAL;
+ VAR overflowChecking: BOOLEAN ;
VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
+(*
+ PutQuadOtok - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
+ sets a boolean to determinine whether overflow should be checked.
+*)
+
+PROCEDURE PutQuadOtok (QuadNo: CARDINAL;
+ tok: CARDINAL;
+ Op: QuadOperator;
+ Oper1, Oper2, Oper3: CARDINAL;
+ overflowChecking: BOOLEAN ;
+ Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
+
+
(*
PutQuad - overwrites a quadruple QuadNo with Op, Oper1, Oper2, Oper3
*)
@@ -2573,16 +2587,6 @@ PROCEDURE PushLineNo ;
PROCEDURE BuildStmtNote (offset: INTEGER) ;
-(*
- VariableAnalysis - checks to see whether a variable is:
-
- read without being initialized or
- written over when it is a non var parameter
-*)
-
-PROCEDURE VariableAnalysis (Start, End: CARDINAL) ;
-
-
(*
LoopAnalysis - checks whether an infinite loop exists.
*)
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index a27c3e1971d..dc732654003 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -109,7 +109,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
PutConstructor, PutConstructorFrom,
PutDeclared,
MakeComponentRecord, MakeComponentRef,
- IsSubscript,
+ IsSubscript, IsComponent,
IsTemporary,
IsAModula2Type,
PutLeftValueFrontBackType,
@@ -210,6 +210,7 @@ FROM M2Options IMPORT NilChecking,
Pedantic, CompilerDebugging, GenerateDebugging,
GenerateLineDebug, Exceptions,
Profiling, Coding, Optimizing,
+ UninitVariableChecking,
ScaffoldDynamic, ScaffoldStatic, cflag,
ScaffoldMain, SharedFlag, WholeProgram,
GetRuntimeModuleOverride ;
@@ -262,15 +263,14 @@ IMPORT M2Error ;
CONST
DebugStackOn = TRUE ;
DebugVarients = FALSE ;
- BreakAtQuad = 133 ;
+ BreakAtQuad = 53 ;
DebugTokPos = FALSE ;
TYPE
- ConstructorFrame = POINTER TO constructorFrame ;
- constructorFrame = RECORD
- type : CARDINAL ;
- index: CARDINAL ;
- END ;
+ ConstructorFrame = POINTER TO RECORD
+ type : CARDINAL ;
+ index: CARDINAL ;
+ END ;
BoolFrame = POINTER TO RECORD
TrueExit : CARDINAL ;
@@ -1127,7 +1127,7 @@ PROCEDURE GetQuadtok (QuadNo: CARDINAL;
VAR
f: QuadFrame ;
BEGIN
- f := GetQF(QuadNo) ;
+ f := GetQF (QuadNo) ;
LastQuadNo := QuadNo ;
WITH f^ DO
Op := Operator ;
@@ -1149,11 +1149,12 @@ PROCEDURE GetQuadOtok (QuadNo: CARDINAL;
VAR tok: CARDINAL;
VAR Op: QuadOperator;
VAR Oper1, Oper2, Oper3: CARDINAL;
+ VAR overflowChecking: BOOLEAN ;
VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
VAR
f: QuadFrame ;
BEGIN
- f := GetQF(QuadNo) ;
+ f := GetQF (QuadNo) ;
LastQuadNo := QuadNo ;
WITH f^ DO
Op := Operator ;
@@ -1163,11 +1164,50 @@ BEGIN
Op1Pos := op1pos ;
Op2Pos := op2pos ;
Op3Pos := op3pos ;
- tok := TokenNo
+ tok := TokenNo ;
+ overflowChecking := CheckOverflow
END
END GetQuadOtok ;
+(*
+ PutQuadOtok - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
+ sets a boolean to determinine whether overflow should be checked.
+*)
+
+PROCEDURE PutQuadOtok (QuadNo: CARDINAL;
+ tok: CARDINAL;
+ Op: QuadOperator;
+ Oper1, Oper2, Oper3: CARDINAL;
+ overflowChecking: BOOLEAN ;
+ Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ IF QuadNo = BreakAtQuad
+ THEN
+ stop
+ END ;
+ IF QuadrupleGeneration
+ THEN
+ EraseQuad (QuadNo) ;
+ AddQuadInformation (QuadNo, Op, Oper1, Oper2, Oper3) ;
+ f := GetQF (QuadNo) ;
+ WITH f^ DO
+ Operator := Op ;
+ Operand1 := Oper1 ;
+ Operand2 := Oper2 ;
+ Operand3 := Oper3 ;
+ CheckOverflow := overflowChecking ;
+ op1pos := Op1Pos ;
+ op2pos := Op2Pos ;
+ op3pos := Op3Pos ;
+ TokenNo := tok
+ END
+ END
+END PutQuadOtok ;
+
+
(*
AddQuadInformation - adds variable analysis and jump analysis to the new quadruple.
*)
@@ -3118,7 +3158,7 @@ PROCEDURE MarkArrayWritten (Array: CARDINAL) ;
BEGIN
IF (Array#NulSym) AND IsVarAParam(Array)
THEN
- PutVarWritten(Array, TRUE)
+ PutVarWritten (Array, TRUE)
END
END MarkArrayWritten ;
@@ -3157,9 +3197,9 @@ END MarkAsRead ;
PROCEDURE MarkAsWrite (sym: CARDINAL) ;
BEGIN
- IF (sym#NulSym) AND IsVar(sym)
+ IF (sym # NulSym) AND IsVar (sym)
THEN
- PutWriteQuad(sym, RightValue, NextQuad)
+ PutWriteQuad (sym, RightValue, NextQuad)
END
END MarkAsWrite ;
@@ -3171,14 +3211,14 @@ END MarkAsWrite ;
PROCEDURE doVal (type, expr: CARDINAL) : CARDINAL ;
BEGIN
- IF (NOT IsConst(expr)) AND (SkipType(type)#GetDType(expr))
+ IF (NOT IsConst (expr)) AND (SkipType (type) # GetDType (expr))
THEN
- PushTF(Convert, NulSym) ;
- PushT(SkipType(type)) ;
- PushT(expr) ;
- PushT(2) ; (* Two parameters *)
+ PushTF (Convert, NulSym) ;
+ PushT (SkipType(type)) ;
+ PushT (expr) ;
+ PushT (2) ; (* Two parameters *)
BuildConvertFunction ;
- PopT(expr)
+ PopT (expr)
END ;
RETURN( expr )
END doVal ;
@@ -5952,12 +5992,15 @@ VAR
BEGIN
IF GetDType(des)=GetDType(exp)
THEN
- GenQuadO (tok, IndrXOp, des, GetSType(des), exp, TRUE)
+ GenQuadOtok (tok, IndrXOp, des, GetSType (des), exp, TRUE,
+ tok, tok, tok)
ELSE
t := MakeTemporary (tok, RightValue) ;
PutVar (t, GetSType (exp)) ;
- GenQuadO (tok, IndrXOp, t, GetSType (exp), exp, TRUE) ;
- GenQuadO (tok, BecomesOp, des, NulSym, doVal (GetSType(des), t), TRUE)
+ GenQuadOtok (tok, IndrXOp, t, GetSType (exp), exp, TRUE,
+ tok, tok, tok) ;
+ GenQuadOtok (tok, BecomesOp, des, NulSym, doVal (GetSType(des), t), TRUE,
+ tok, UnknownTokenNo, tok)
END
END doIndrX ;
@@ -5986,7 +6029,8 @@ BEGIN
*)
t := MakeTemporary (tok, RightValue) ;
PutVar (t, type) ;
- GenQuadO (tok, BecomesOp, t, NulSym, doVal(type, Sym), TRUE) ;
+ GenQuadOtok (tok, BecomesOp, t, NulSym, doVal (type, Sym), TRUE,
+ tok, tok, tok) ;
RETURN t
END
ELSE
@@ -6022,13 +6066,15 @@ BEGIN
*)
t := MakeTemporary (tok, with) ;
PutVar (t, type) ;
- GenQuadO (tok, BecomesOp, t, NulSym, Sym, TRUE) ;
+ GenQuadOtok (tok, BecomesOp, t, NulSym, Sym, TRUE,
+ tok, UnknownTokenNo, tok) ;
RETURN t
END
ELSE
t := MakeTemporary (tok, with) ;
PutVar (t, type) ;
- GenQuadO (tok, AddrOp, t, NulSym, Sym, TRUE) ;
+ GenQuadOtok (tok, AddrOp, t, NulSym, Sym, TRUE,
+ tok, UnknownTokenNo, tok) ;
RETURN t
END
END MakeLeftValue ;
@@ -6998,13 +7044,13 @@ BEGIN
IF IsExpressionCompatible (dtype, etype)
THEN
(* the easy case simulate a straightforward macro *)
- PushTF(des, dtype) ;
- PushT(tok) ;
- PushTF(expr, etype) ;
- doBuildBinaryOp(FALSE, TRUE)
+ PushTF (des, dtype) ;
+ PushT (tok) ;
+ PushTF (expr, etype) ;
+ doBuildBinaryOp (FALSE, TRUE)
ELSE
- IF (IsOrdinalType(dtype) OR (dtype=Address) OR IsPointer(dtype)) AND
- (IsOrdinalType(etype) OR (etype=Address) OR IsPointer(etype))
+ IF (IsOrdinalType (dtype) OR (dtype = Address) OR IsPointer (dtype)) AND
+ (IsOrdinalType (etype) OR (etype = Address) OR IsPointer (etype))
THEN
PushTF (des, dtype) ;
PushT (tok) ;
@@ -10501,72 +10547,6 @@ BEGIN
END BuildProcedureEnd ;
-(*
- CheckReadBeforeInitialized -
-*)
-
-PROCEDURE CheckReadBeforeInitialized (ProcSym: CARDINAL; End: CARDINAL) ;
-VAR
- s1, s2 : String ;
- i, n, ParamNo,
- ReadStart, ReadEnd,
- WriteStart, WriteEnd: CARDINAL ;
-BEGIN
- ParamNo := NoOfParam(ProcSym) ;
- i := 1 ;
- REPEAT
- n := GetNth(ProcSym, i) ;
- IF (n#NulSym) AND (NOT IsTemporary(n))
- THEN
- GetReadQuads(n, RightValue, ReadStart, ReadEnd) ;
- GetWriteQuads(n, RightValue, WriteStart, WriteEnd) ;
- IF i>ParamNo
- THEN
- (* n is a not a parameter thus we can check *)
- IF (ReadStart>0) AND (ReadStart<End)
- THEN
- (* it is read in the first basic block *)
- IF ReadStart<WriteStart
- THEN
- (* read before written, this is a problem which must be fixed *)
- s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(n)))) ;
- s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ProcSym)))) ;
- ErrorStringAt2(Sprintf2(Mark(InitString('reading from a variable (%s) before it is initialized in procedure (%s)')),
- s1, s2),
- GetDeclaredMod(n), GetDeclaredMod(n))
- END
- END
- END
- END ;
- INC(i)
- UNTIL n=NulSym
-END CheckReadBeforeInitialized ;
-
-
-(*
- VariableAnalysis - checks to see whether a variable is:
-
- read before it has been initialized
-*)
-
-PROCEDURE VariableAnalysis (Start, End: CARDINAL) ;
-VAR
- Op : QuadOperator ;
- Op1, Op2, Op3: CARDINAL ;
-BEGIN
- IF Pedantic
- THEN
- GetQuad(Start, Op, Op1, Op2, Op3) ;
- CASE Op OF
-
- NewLocalVarOp: CheckReadBeforeInitialized(Op3, End)
-
- ELSE
- END
- END
-END VariableAnalysis ;
-
-
(*
IsNeverAltered - returns TRUE if variable, sym, is never altered
between quadruples: Start..End
@@ -10576,8 +10556,8 @@ PROCEDURE IsNeverAltered (sym: CARDINAL; Start, End: CARDINAL) : BOOLEAN ;
VAR
WriteStart, WriteEnd: CARDINAL ;
BEGIN
- GetWriteLimitQuads(sym, GetMode(sym), Start, End, WriteStart, WriteEnd) ;
- RETURN( (WriteStart=0) AND (WriteEnd=0) )
+ GetWriteLimitQuads (sym, GetMode (sym), Start, End, WriteStart, WriteEnd) ;
+ RETURN( (WriteStart = 0) AND (WriteEnd = 0) )
END IsNeverAltered ;
@@ -10592,8 +10572,8 @@ VAR
LeftFixed,
RightFixed : BOOLEAN ;
BEGIN
- GetQuad(q, op, op1, op2, op3) ;
- IF op=GotoOp
+ GetQuad (q, op, op1, op2, op3) ;
+ IF op = GotoOp
THEN
RETURN( FALSE )
ELSE
@@ -10844,6 +10824,7 @@ END AsmStatementsInBlock ;
PROCEDURE CheckVariablesInBlock (BlockSym: CARDINAL) ;
BEGIN
CheckVariablesAndParameterTypesInBlock (BlockSym) ;
+ (*
IF UnusedVariableChecking OR UnusedParameterChecking
THEN
IF (NOT AsmStatementsInBlock (BlockSym))
@@ -10851,6 +10832,7 @@ BEGIN
CheckUninitializedVariablesAreUsed (BlockSym)
END
END
+ *)
END CheckVariablesInBlock ;
@@ -11428,6 +11410,19 @@ BEGIN
END BuildDynamicArray ;
+(*
+ DebugLocation -
+*)
+
+PROCEDURE DebugLocation (tok: CARDINAL; message: ARRAY OF CHAR) ;
+BEGIN
+ IF DebugTokPos
+ THEN
+ WarnStringAt (InitString (message), tok)
+ END
+END DebugLocation ;
+
+
(*
BuildDesignatorPointer - Builds a pointer reference.
The Stack is expected to contain:
@@ -11451,6 +11446,8 @@ VAR
Sym2, Type2: CARDINAL ;
BEGIN
PopTFrwtok (Sym1, Type1, rw, exprtok) ;
+ DebugLocation (exprtok, "expression") ;
+
Type1 := SkipType (Type1) ;
IF Type1 = NulSym
THEN
@@ -11473,15 +11470,16 @@ BEGIN
THEN
rw := NulSym ;
PutLeftValueFrontBackType (Sym2, Type2, Type1) ;
- GenQuad (IndrXOp, Sym2, Type1, Sym1) (* Sym2 := *Sym1 *)
+ GenQuadO (ptrtok, IndrXOp, Sym2, Type1, Sym1, FALSE) (* Sym2 := *Sym1 *)
ELSE
PutLeftValueFrontBackType (Sym2, Type2, NulSym) ;
- GenQuad (BecomesOp, Sym2, NulSym, Sym1) (* Sym2 := Sym1 *)
+ GenQuadO (ptrtok, BecomesOp, Sym2, NulSym, Sym1, FALSE) (* Sym2 := Sym1 *)
END ;
PutVarPointerCheck (Sym2, TRUE) ; (* we should check this for *)
(* Sym2 later on (pointer via NIL) *)
combinedtok := MakeVirtualTok (exprtok, exprtok, ptrtok) ;
- PushTFrwtok (Sym2, Type2, rw, combinedtok)
+ PushTFrwtok (Sym2, Type2, rw, combinedtok) ;
+ DebugLocation (combinedtok, "pointer expression")
ELSE
MetaError2 ('{%1ad} is not a pointer type but a {%2d}', Sym1, Type1)
END
@@ -11505,23 +11503,26 @@ VAR
Sym, Type,
Ref : CARDINAL ;
BEGIN
+ DebugLocation (withtok, "with") ;
BuildStmtNoteTok (withTok) ;
DisplayStack ;
PopTFtok (Sym, Type, tok) ;
+ DebugLocation (tok, "expression") ;
Type := SkipType (Type) ;
Ref := MakeTemporary (tok, LeftValue) ;
PutVar (Ref, Type) ;
IF GetMode (Sym) = LeftValue
THEN
- (* copy LeftValue *)
+ (* Copy LeftValue. *)
GenQuadO (tok, BecomesOp, Ref, NulSym, Sym, TRUE)
ELSE
- (* calculate the address of Sym *)
+ (* Calculate the address of Sym. *)
GenQuadO (tok, AddrOp, Ref, NulSym, Sym, TRUE)
END ;
PushWith (Sym, Type, Ref, tok) ;
+ DebugLocation (tok, "with ref") ;
IF Type = NulSym
THEN
MetaError1 ('{%1Ea} {%1d} has a no type, the {%kWITH} statement requires a variable or parameter of a {%kRECORD} type',
@@ -11562,9 +11563,9 @@ BEGIN
IF Pedantic
THEN
n := NoOfItemsInStackAddress(WithStack) ;
- i := 1 ; (* top of the stack *)
+ i := 1 ; (* Top of the stack. *)
WHILE i <= n DO
- (* Search for other declarations of the with using Type *)
+ (* Search for other declarations of the with using Type. *)
f := PeepAddress(WithStack, i) ;
IF f^.RecordSym=Type
THEN
@@ -12454,7 +12455,7 @@ VAR
leftpos, rightpos : CARDINAL ;
value : CARDINAL ;
BEGIN
- Operator := OperandT(2) ;
+ Operator := OperandT (2) ;
IF Operator = OrTok
THEN
CheckBooleanId ;
@@ -12874,6 +12875,7 @@ VAR
t,
rightType, leftType,
right, left : CARDINAL ;
+ s : String ;
BEGIN
IF CompilerDebugging
THEN
@@ -12926,7 +12928,23 @@ BEGIN
left := t
END ;
combinedTok := MakeVirtualTok (optokpos, leftpos, rightpos) ;
- GenQuadO (combinedTok, MakeOp (Op), left, right, 0, FALSE) ; (* True Exit *)
+
+ IF DebugTokPos
+ THEN
+ s := InitStringCharStar (KeyToCharStar (GetTokenName (Op))) ;
+ WarnStringAt (s, optokpos) ;
+ s := InitString ('left') ;
+ WarnStringAt (s, leftpos) ;
+ s := InitString ('right') ;
+ WarnStringAt (s, rightpos) ;
+ s := InitString ('caret') ;
+ WarnStringAt (s, optokpos) ;
+ s := InitString ('combined') ;
+ WarnStringAt (s, combinedTok)
+ END ;
+
+ GenQuadOtok (combinedTok, MakeOp (Op), left, right, 0, FALSE,
+ leftpos, rightpos, UnknownTokenNo) ; (* True Exit *)
GenQuadO (combinedTok, GotoOp, NulSym, NulSym, 0, FALSE) ; (* False Exit *)
PushBool (NextQuad-2, NextQuad-1)
END
diff --git a/gcc/m2/gm2-compiler/M2SymInit.def b/gcc/m2/gm2-compiler/M2SymInit.def
new file mode 100644
index 00000000000..2ea6bfc2a98
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2SymInit.def
@@ -0,0 +1,59 @@
+(* M2SymInit.def records initialization state for variables.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+DEFINITION MODULE M2SymInit ;
+
+FROM Lists IMPORT List ;
+
+TYPE
+ InitDesc ;
+
+
+PROCEDURE InitSymInit () : InitDesc ;
+PROCEDURE KillSymInit (VAR desc: InitDesc) ;
+
+
+PROCEDURE ConfigSymInit (desc: InitDesc; sym: CARDINAL) ;
+
+
+PROCEDURE SetInitialized (desc: InitDesc) ;
+PROCEDURE GetInitialized (desc: InitDesc) : BOOLEAN ;
+
+
+PROCEDURE GetFieldDesc (desc: InitDesc; field: CARDINAL) : InitDesc ;
+
+PROCEDURE SetFieldInitialized (desc: InitDesc; fieldlist: List) : BOOLEAN ;
+PROCEDURE GetFieldInitialized (desc: InitDesc; fieldlist: List) : BOOLEAN ;
+
+
+(*
+ VariableAnalysis - checks to see whether a variable is:
+
+ read before it has been initialized
+*)
+
+PROCEDURE VariableAnalysis (Start, End: CARDINAL) ;
+
+
+PROCEDURE PrintSymInit (desc: InitDesc) ;
+
+
+END M2SymInit.
diff --git a/gcc/m2/gm2-compiler/M2SymInit.mod b/gcc/m2/gm2-compiler/M2SymInit.mod
new file mode 100644
index 00000000000..18200af06e7
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2SymInit.mod
@@ -0,0 +1,1307 @@
+(* M2SymInit.mod records initialization state for variables.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+IMPLEMENTATION MODULE M2SymInit ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM M2Debug IMPORT Assert ;
+FROM libc IMPORT printf ;
+FROM NameKey IMPORT Name, NulName, KeyToCharStar ;
+FROM M2Options IMPORT UninitVariableChecking ;
+FROM M2MetaError IMPORT MetaErrorT1 ;
+FROM M2LexBuf IMPORT UnknownTokenNo ;
+
+IMPORT Indexing ;
+
+FROM Lists IMPORT List, InitList, GetItemFromList, PutItemIntoList,
+ IsItemInList, IncludeItemIntoList, NoOfItemsInList,
+ RemoveItemFromList, ForeachItemInListDo, KillList ;
+
+FROM SymbolTable IMPORT NulSym, ModeOfAddr, IsVar, IsRecord, GetSType,
+ GetNth, IsRecordField, IsSet, IsArray, IsProcedure,
+ GetVarScope, IsVarAParam, IsComponent, GetMode,
+ VarCheckReadInit, VarInitState, PutVarInitialized,
+ PutVarFieldInitialized, GetVarFieldInitialized,
+ IsConst, IsConstString, NoOfParam, IsVarParam,
+ ForeachLocalSymDo, IsTemporary, ModeOfAddr,
+ IsReallyPointer, IsUnbounded,
+ IsVarient, IsFieldVarient, GetVarient ;
+
+FROM M2Quads IMPORT QuadOperator, GetQuadOtok, GetQuad, GetNextQuad ;
+FROM M2Options IMPORT CompilerDebugging ;
+FROM M2Printf IMPORT printf0, printf1, printf2 ;
+FROM M2GCCDeclare IMPORT PrintSym ;
+
+
+CONST
+ Debugging = FALSE ;
+
+TYPE
+ descType = (scalar, record) ;
+
+ InitDesc = POINTER TO RECORD
+ sym, type : CARDINAL ;
+ initialized: BOOLEAN ;
+ CASE kind: descType OF
+
+ scalar: |
+ record: rec: recordDesc |
+
+ END
+ END ;
+
+ recordDesc = RECORD
+ fieldDesc: Indexing.Index ;
+ END ;
+
+ symAlias = POINTER TO RECORD
+ keySym,
+ alias : CARDINAL ;
+ next : symAlias ;
+ END ;
+
+VAR
+ aliasArray: Indexing.Index ;
+ freeList : symAlias ;
+
+
+(*
+ PrintSymInit -
+*)
+
+PROCEDURE PrintSymInit (desc: InitDesc) ;
+VAR
+ i, n: CARDINAL ;
+BEGIN
+ printf ("sym %d: type %d ", desc^.sym, desc^.type) ;
+ IF desc^.kind = scalar
+ THEN
+ printf ("scalar")
+ ELSE
+ printf ("record")
+ END ;
+ IF NOT desc^.initialized
+ THEN
+ printf (" not")
+ END ;
+ printf (" initialized\n") ;
+ IF (desc^.type # NulSym) AND IsRecord (desc^.type)
+ THEN
+ i := 1 ;
+ n := Indexing.HighIndice (desc^.rec.fieldDesc) ;
+ WHILE i <= n DO
+ PrintSymInit (Indexing.GetIndice (desc^.rec.fieldDesc, i)) ;
+ INC (i)
+ END
+ END
+END PrintSymInit ;
+
+
+PROCEDURE InitSymInit () : InitDesc ;
+VAR
+ id: InitDesc ;
+BEGIN
+ NEW (id) ;
+ WITH id^ DO
+ sym := NulSym ;
+ type := NulSym ;
+ initialized := TRUE ;
+ kind := scalar
+ END ;
+ RETURN id
+END InitSymInit ;
+
+
+PROCEDURE KillSymInit (VAR desc: InitDesc) ;
+BEGIN
+ WITH desc^ DO
+ CASE kind OF
+
+ record: KillFieldDesc (rec.fieldDesc)
+
+ ELSE
+ END
+ END ;
+ DISPOSE (desc) ;
+ desc := NIL
+END KillSymInit ;
+
+
+PROCEDURE ConfigSymInit (desc: InitDesc; sym: CARDINAL) ;
+BEGIN
+ IF IsVar (sym) OR IsRecordField (sym)
+ THEN
+ desc^.sym := sym ;
+ desc^.type := GetSType (sym) ;
+ desc^.initialized := FALSE ;
+ IF IsRecord (desc^.type)
+ THEN
+ desc^.kind := record ;
+ desc^.rec.fieldDesc := Indexing.InitIndex (1) ;
+ PopulateFields (desc, desc^.type)
+ ELSE
+ desc^.kind := scalar ;
+ IF IsArray (desc^.type)
+ THEN
+ desc^.initialized := TRUE (* For now we don't attempt to handle array types. *)
+ END
+ END
+ END
+END ConfigSymInit ;
+
+
+(*
+ KillFieldDesc -
+*)
+
+PROCEDURE KillFieldDesc (VAR fielddesc: Indexing.Index) ;
+VAR
+ i, h: CARDINAL ;
+ id : InitDesc ;
+BEGIN
+ i := 1 ;
+ h := Indexing.HighIndice (fielddesc) ;
+ WHILE i <= h DO
+ id := Indexing.GetIndice (fielddesc, i) ;
+ KillSymInit (id) ;
+ INC (i)
+ END ;
+ fielddesc := Indexing.KillIndex (fielddesc)
+END KillFieldDesc ;
+
+
+(*
+ PopulateFields -
+*)
+
+PROCEDURE PopulateFields (desc: InitDesc; recsym: CARDINAL) ;
+VAR
+ field,
+ i : CARDINAL ;
+ fdesc: InitDesc ;
+BEGIN
+ Assert (IsRecord (recsym)) ;
+ i := 1 ;
+ REPEAT
+ field := GetNth (recsym, i) ;
+ IF field # NulSym
+ THEN
+ fdesc := InitSymInit () ;
+ ConfigSymInit (fdesc, field) ;
+ Indexing.IncludeIndiceIntoIndex (desc^.rec.fieldDesc, fdesc) ;
+ INC (i)
+ END
+ UNTIL field = NulSym
+END PopulateFields ;
+
+
+PROCEDURE SetInitialized (desc: InitDesc) ;
+BEGIN
+ desc^.initialized := TRUE
+END SetInitialized ;
+
+
+PROCEDURE GetInitialized (desc: InitDesc) : BOOLEAN ;
+BEGIN
+ IF NOT desc^.initialized
+ THEN
+ IF IsRecord (desc^.type)
+ THEN
+ TrySetInitialized (desc)
+ END
+ END ;
+ IF Debugging
+ THEN
+ PrintSymInit (desc)
+ END ;
+ RETURN desc^.initialized
+END GetInitialized ;
+
+
+PROCEDURE GetFieldDesc (desc: InitDesc; field: CARDINAL) : InitDesc ;
+VAR
+ fsym,
+ i : CARDINAL ;
+BEGIN
+ IF IsRecord (desc^.type)
+ THEN
+ i := 1 ;
+ REPEAT
+ fsym := GetNth (desc^.type, i) ;
+ IF field = fsym
+ THEN
+ RETURN Indexing.GetIndice (desc^.rec.fieldDesc, i)
+ END ;
+ INC (i)
+ UNTIL fsym = NulSym
+ END ;
+ RETURN NIL
+END GetFieldDesc ;
+
+
+PROCEDURE SetFieldInitialized (desc: InitDesc; fieldlist: List) : BOOLEAN ;
+BEGIN
+ RETURN SetFieldInitializedNo (desc, fieldlist, 1)
+END SetFieldInitialized ;
+
+
+(*
+ TrySetInitialized -
+*)
+
+PROCEDURE TrySetInitialized (desc: InitDesc) ;
+VAR
+ i, h : CARDINAL ;
+ fdesc: InitDesc ;
+BEGIN
+ h := Indexing.HighIndice (desc^.rec.fieldDesc) ;
+ i := 1 ;
+ WHILE i <= h DO
+ fdesc := Indexing.GetIndice (desc^.rec.fieldDesc, i) ;
+ IF NOT fdesc^.initialized
+ THEN
+ RETURN
+ END ;
+ INC (i)
+ END ;
+ desc^.initialized := TRUE
+END TrySetInitialized ;
+
+
+(*
+ SetFieldInitializedNo -
+*)
+
+PROCEDURE SetFieldInitializedNo (desc: InitDesc;
+ fieldlist: List; level: CARDINAL) : BOOLEAN ;
+VAR
+ init : BOOLEAN ;
+ nsym : CARDINAL ;
+ fdesc: InitDesc ;
+BEGIN
+ IF level > NoOfItemsInList (fieldlist)
+ THEN
+ RETURN FALSE
+ ELSE
+ nsym := GetItemFromList (fieldlist, level) ;
+ fdesc := GetFieldDesc (desc, nsym) ;
+ IF fdesc = NIL
+ THEN
+ RETURN FALSE
+ ELSIF level = NoOfItemsInList (fieldlist)
+ THEN
+ SetInitialized (fdesc) ;
+ TrySetInitialized (desc) ;
+ RETURN desc^.initialized
+ ELSE
+ init := SetFieldInitializedNo (fdesc, fieldlist, level + 1) ;
+ TrySetInitialized (desc) ;
+ RETURN desc^.initialized
+ END
+ END
+END SetFieldInitializedNo ;
+
+
+PROCEDURE GetFieldInitialized (desc: InitDesc; fieldlist: List) : BOOLEAN ;
+BEGIN
+ RETURN GetFieldInitializedNo (desc, fieldlist, 1)
+END GetFieldInitialized ;
+
+
+PROCEDURE GetFieldInitializedNo (desc: InitDesc;
+ fieldlist: List; level: CARDINAL) : BOOLEAN ;
+VAR
+ nsym : CARDINAL ;
+ fdesc: InitDesc ;
+BEGIN
+ IF desc^.initialized
+ THEN
+ RETURN TRUE
+ ELSIF level > NoOfItemsInList (fieldlist)
+ THEN
+ RETURN FALSE
+ ELSE
+ nsym := GetItemFromList (fieldlist, level) ;
+ fdesc := GetFieldDesc (desc, nsym) ;
+ IF fdesc = NIL
+ THEN
+ (* The pointer variable maybe uninitialized and hence we cannot
+ find the record variable. *)
+ RETURN FALSE
+ ELSIF fdesc^.initialized
+ THEN
+ RETURN TRUE
+ ELSE
+ RETURN GetFieldInitializedNo (fdesc, fieldlist, level + 1)
+ END
+ END
+END GetFieldInitializedNo ;
+
+
+(*
+ IsGlobalVar -
+*)
+
+PROCEDURE IsGlobalVar (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN IsVar (sym) AND (NOT IsProcedure (GetVarScope (sym)))
+END IsGlobalVar ;
+
+
+(*
+ IsLocalVar -
+*)
+
+PROCEDURE IsLocalVar (procsym, varsym: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN IsVar (varsym) AND (GetVarScope (varsym) = procsym)
+END IsLocalVar ;
+
+
+(*
+ RecordFieldContainsVarient -
+*)
+
+PROCEDURE RecordFieldContainsVarient (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+ Assert (IsRecordField (sym)) ;
+ IF ContainsVariant (GetSType (sym))
+ THEN
+ RETURN TRUE
+ END ;
+ RETURN GetVarient (sym) # NulSym
+END RecordFieldContainsVarient ;
+
+
+(*
+ ContainsVariant - returns TRUE if type sym contains a variant record.
+*)
+
+PROCEDURE ContainsVariant (sym: CARDINAL) : BOOLEAN ;
+VAR
+ i,
+ fieldsym,
+ fieldtype: CARDINAL ;
+BEGIN
+ IF IsRecord (sym)
+ THEN
+ i := 1 ;
+ REPEAT
+ fieldsym := GetNth (sym, i) ;
+ IF fieldsym # NulSym
+ THEN
+ IF IsRecordField (fieldsym)
+ THEN
+ IF RecordFieldContainsVarient (fieldsym)
+ THEN
+ RETURN TRUE
+ END
+ ELSIF IsVarient (fieldsym)
+ THEN
+ RETURN TRUE
+ END ;
+ INC (i)
+ END
+ UNTIL fieldsym = NulSym
+ END ;
+ RETURN FALSE
+END ContainsVariant ;
+
+
+(*
+ CheckDeferredRecordAccess -
+*)
+
+PROCEDURE CheckDeferredRecordAccess (procsym: CARDINAL; tok: CARDINAL;
+ sym: CARDINAL; canDereference: BOOLEAN) ;
+BEGIN
+ IF IsVar (sym)
+ THEN
+ IF Debugging
+ THEN
+ Trace ("CheckDeferredRecordAccess %d\n", sym) ;
+ PrintSym (sym) ;
+ IF canDereference
+ THEN
+ printf1 ("checkReadInit (%d, true)\n", sym)
+ ELSE
+ printf1 ("checkReadInit (%d, false)\n", sym)
+ END
+ END ;
+ IF IsExempt (sym)
+ THEN
+ Trace ("checkReadInit sym is a parameter or not a local variable (%d)", sym) ;
+ (* We assume parameters have been initialized. *)
+ PutVarInitialized (sym, LeftValue) ;
+ PutVarInitialized (sym, RightValue)
+ (* SetVarInitialized (sym, TRUE) *)
+ ELSIF IsUnbounded (GetSType (sym))
+ THEN
+ SetVarInitialized (sym, TRUE)
+ ELSIF IsComponent (sym)
+ THEN
+ Trace ("checkReadInit IsComponent (%d) is true)", sym) ;
+ IF NOT GetVarComponentInitialized (sym)
+ THEN
+ MetaErrorT1 (tok,
+ 'attempting to access {%1Wad} before it has been initialized',
+ sym)
+ END
+ ELSIF (GetMode (sym) = LeftValue) AND canDereference
+ THEN
+ Trace ("checkReadInit GetMode (%d) = LeftValue and canDereference (LeftValue and RightValue VarCheckReadInit)", sym) ;
+ IF NOT VarCheckReadInit (sym, LeftValue)
+ THEN
+ MetaErrorT1 (tok,
+ 'attempting to access the address of {%1Wad} before it has been initialized',
+ sym)
+ END ;
+ IF NOT VarCheckReadInit (sym, RightValue)
+ THEN
+ MetaErrorT1 (tok,
+ 'attempting to access {%1Wad} before it has been initialized', sym)
+ END
+ ELSE
+ Trace ("checkReadInit call VarCheckReadInit using GetMode (%d)", sym) ;
+ IF NOT VarCheckReadInit (sym, GetMode (sym))
+ THEN
+ MetaErrorT1 (tok,
+ 'attempting to access {%1Wad} before it has been initialized', sym)
+ END
+ END
+ END
+END CheckDeferredRecordAccess ;
+
+
+(*
+ SetVarUninitialized - resets variable init state.
+*)
+
+PROCEDURE SetVarUninitialized (sym: CARDINAL) ;
+BEGIN
+ IF IsVar (sym) AND (NOT IsUnbounded (GetSType (sym))) AND (NOT IsVarAParam (sym))
+ THEN
+ VarInitState (sym)
+ END
+END SetVarUninitialized ;
+
+
+(*
+ ComponentFindVar -
+*)
+
+PROCEDURE ComponentFindVar (sym: CARDINAL) : CARDINAL ;
+VAR
+ nsym,
+ i : CARDINAL ;
+BEGIN
+ i := 1 ;
+ REPEAT
+ nsym := getAlias (GetNth (sym, i)) ;
+ IF (nsym # NulSym) AND IsVar (nsym)
+ THEN
+ IF (nsym # sym) AND IsComponent (nsym)
+ THEN
+ RETURN ComponentFindVar (nsym)
+ ELSE
+ RETURN nsym
+ END
+ END ;
+ INC (i)
+ UNTIL nsym = NulSym ;
+ RETURN NulSym
+END ComponentFindVar ;
+
+
+(*
+ ComponentCreateFieldList - builds a list of fields accessed by the component var.
+ Each item in the list will be a field of incremental levels
+ though a nested record. It is not a list of fields
+ at the same level.
+
+ foo = RECORD
+ v: RECORD
+ x, y: CARDINAL ;
+ END ;
+ w: CARDINAL ;
+ END ;
+
+ { v, x } for example and not { v, w }
+*)
+
+PROCEDURE ComponentCreateFieldList (sym: CARDINAL) : List ;
+VAR
+ lst: List ;
+BEGIN
+ InitList (lst) ;
+ IF IsVar (sym) AND IsComponent (sym)
+ THEN
+ ComponentBuildFieldList (lst, sym)
+ END ;
+ RETURN lst
+END ComponentCreateFieldList ;
+
+
+PROCEDURE ComponentBuildFieldList (lst: List; sym: CARDINAL) ;
+VAR
+ i, nsym: CARDINAL ;
+BEGIN
+ i := 1 ;
+ REPEAT
+ nsym := GetNth (sym, i) ;
+ IF nsym # NulSym
+ THEN
+ IF IsComponent (nsym)
+ THEN
+ ComponentBuildFieldList (lst, nsym)
+ ELSIF IsRecordField (nsym)
+ THEN
+ IncludeItemIntoList (lst, nsym)
+ END ;
+ INC (i)
+ END
+ UNTIL nsym = NulSym
+END ComponentBuildFieldList ;
+
+
+(*
+ SetVarComponentInitialized -
+*)
+
+PROCEDURE SetVarComponentInitialized (sym: CARDINAL) ;
+VAR
+ i, n,
+ fsym,
+ vsym: CARDINAL ;
+ lst : List ;
+BEGIN
+ vsym := ComponentFindVar (sym) ;
+ IF vsym # NulSym
+ THEN
+ IF Debugging
+ THEN
+ printf0 ("*************** vsym is: ") ;
+ PrintSym (vsym)
+ END ;
+ (* Build list accessing the field. *)
+ lst := ComponentCreateFieldList (sym) ;
+ IF Debugging
+ THEN
+ printf2 ("sym = %d, vsym = %d, fields:", sym, vsym)
+ END ;
+ (* Now mark this field in the record variable as initialized. *)
+ IF PutVarFieldInitialized (vsym, RightValue, lst)
+ THEN
+ IF Debugging
+ THEN
+ i := 1 ;
+ n := NoOfItemsInList (lst) ;
+ WHILE i <= n DO
+ fsym := GetItemFromList (lst, i) ;
+ printf1 (" %d", fsym) ;
+ INC (i)
+ END ;
+ printf0 (" is initialized\n")
+ END
+ ELSIF Debugging
+ THEN
+ printf0 (" vsym is not a var\n")
+ END ;
+ KillList (lst)
+ END
+END SetVarComponentInitialized ;
+
+
+(*
+ GetVarComponentInitialized -
+*)
+
+PROCEDURE GetVarComponentInitialized (sym: CARDINAL) : BOOLEAN ;
+VAR
+ init: BOOLEAN ;
+ vsym: CARDINAL ;
+ lst : List ;
+BEGIN
+ init := FALSE ;
+ vsym := ComponentFindVar (sym) ;
+ IF vsym # NulSym
+ THEN
+ IF IsExempt (vsym)
+ THEN
+ init := TRUE
+ ELSE
+ (* Create list representing how the field is accessed. *)
+ lst := ComponentCreateFieldList (sym) ;
+ (* Now obtain the mark indicating whether this field was initialized. *)
+ init := GetVarFieldInitialized (vsym, RightValue, lst) ;
+ KillList (lst)
+ END
+ END ;
+ RETURN init
+END GetVarComponentInitialized ;
+
+
+(*
+ Trace -
+*)
+
+PROCEDURE Trace (message: ARRAY OF CHAR; sym: CARDINAL) ;
+BEGIN
+ IF Debugging
+ THEN
+ printf1 (message, sym) ;
+ printf0 ("\n")
+ END
+END Trace ;
+
+
+(*
+ SetVarInitialized - if the variable has a left mode and can be dereferenced
+ then set the left and right initialization state.
+*)
+
+PROCEDURE SetVarInitialized (sym: CARDINAL; canDereference: BOOLEAN) ;
+BEGIN
+ IF IsVar (sym)
+ THEN
+ IF IsComponent (sym)
+ THEN
+ Trace ("SetVarInitialized sym %d is a component and calling SetVarComponentInitialized", sym);
+ SetVarComponentInitialized (sym)
+ ELSIF (GetMode (sym) = LeftValue) AND canDereference
+ THEN
+ Trace ("SetVarInitialized sym %d is LeftValue and canDeference and calling PutVarInitialized LeftValue and RightValue", sym);
+ PutVarInitialized (sym, LeftValue) ;
+ PutVarInitialized (sym, RightValue)
+ ELSE
+ Trace ("SetVarInitialized sym %d calling PutVarInitialized with its mode", sym);
+ PutVarInitialized (sym, GetMode (sym))
+ END ;
+ IF Debugging
+ THEN
+ PrintSym (sym)
+ END
+ END
+END SetVarInitialized ;
+
+
+(*
+ doGetVarInitialized -
+*)
+
+PROCEDURE doGetVarInitialized (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+ IF IsVar (sym)
+ THEN
+ IF IsUnbounded (GetSType (sym))
+ THEN
+ RETURN TRUE
+ ELSIF IsComponent (sym)
+ THEN
+ RETURN GetVarComponentInitialized (sym)
+ END ;
+ RETURN VarCheckReadInit (sym, GetMode (sym))
+ END ;
+ RETURN IsConst (sym) AND IsConstString (sym)
+END doGetVarInitialized ;
+
+
+(*
+ GetVarInitialized -
+*)
+
+PROCEDURE GetVarInitialized (sym: CARDINAL) : BOOLEAN ;
+VAR
+ init: BOOLEAN ;
+BEGIN
+ init := doGetVarInitialized (sym) ;
+ IF Debugging
+ THEN
+ IF init
+ THEN
+ Trace ("GetVarInitialized (sym = %d) returning TRUE", sym)
+ ELSE
+ Trace ("GetVarInitialized (sym = %d) returning FALSE", sym)
+ END
+ END ;
+ RETURN init
+END GetVarInitialized ;
+
+
+(*
+ IsExempt - returns TRUE if sym is a global variable or a parameter or
+ a variable with a variant record type.
+*)
+
+PROCEDURE IsExempt (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN (sym # NulSym) AND IsVar (sym) AND
+ (IsGlobalVar (sym) OR IsVarAParam (sym) OR
+ ContainsVariant (GetSType (sym)) OR
+ IsArray (GetSType (sym)) OR IsSet (GetSType (sym)) OR
+ IsUnbounded (GetSType (sym)))
+END IsExempt ;
+
+
+(*
+ CheckBinary -
+*)
+
+PROCEDURE CheckBinary (procSym,
+ op1tok, op1,
+ op2tok, op2,
+ op3tok, op3: CARDINAL) ;
+BEGIN
+ CheckDeferredRecordAccess (procSym, op2tok, op2, FALSE) ;
+ CheckDeferredRecordAccess (procSym, op3tok, op3, FALSE) ;
+ SetVarInitialized (op1, FALSE)
+END CheckBinary ;
+
+
+(*
+ CheckUnary -
+*)
+
+PROCEDURE CheckUnary (procSym,
+ lhstok, lhs,
+ rhstok, rhs: CARDINAL) ;
+BEGIN
+ CheckDeferredRecordAccess (procSym, rhstok, rhs, FALSE) ;
+ SetVarInitialized (lhs, FALSE)
+END CheckUnary ;
+
+
+(*
+ CheckXIndr -
+*)
+
+PROCEDURE CheckXIndr (procSym, lhstok, lhs, type, rhstok, rhs: CARDINAL) ;
+VAR
+ lst : List ;
+ vsym: CARDINAL ;
+BEGIN
+ CheckDeferredRecordAccess (procSym, rhstok, rhs, FALSE) ;
+ CheckDeferredRecordAccess (procSym, lhstok, lhs, FALSE) ;
+ (* Now see if we know what lhs is pointing to and set fields if necessary. *)
+ vsym := getAlias (lhs) ;
+ IF (vsym # lhs) AND (GetSType (vsym) = type)
+ THEN
+ IF IsRecord (type)
+ THEN
+ (* Set all fields of vsym as initialized. *)
+ SetVarInitialized (vsym, FALSE)
+ ELSE
+ (* Set only the field assigned in vsym as initialized. *)
+ lst := ComponentCreateFieldList (rhs) ;
+ IF PutVarFieldInitialized (vsym, RightValue, lst)
+ THEN
+ END ;
+ KillList (lst)
+ END
+ END
+END CheckXIndr ;
+
+
+(*
+ CheckIndrX -
+*)
+
+PROCEDURE CheckIndrX (procSym, lhstok, lhs, type, rhstok, rhs: CARDINAL) ;
+BEGIN
+ CheckDeferredRecordAccess (procSym, rhstok, rhs, FALSE) ;
+ CheckDeferredRecordAccess (procSym, rhstok, rhs, TRUE) ;
+ SetVarInitialized (lhs, FALSE)
+END CheckIndrX ;
+
+
+(*
+ CheckRecordField -
+*)
+
+PROCEDURE CheckRecordField (procSym, op1tok, op1, op2tok, op2: CARDINAL) ;
+BEGIN
+ PutVarInitialized (op1, LeftValue)
+END CheckRecordField ;
+
+
+(*
+ CheckBecomes -
+*)
+
+PROCEDURE CheckBecomes (procSym, destok, des, exprtok, expr: CARDINAL) ;
+VAR
+ lst : List ;
+ vsym: CARDINAL ;
+BEGIN
+ CheckDeferredRecordAccess (procSym, exprtok, expr, FALSE) ;
+ SetupAlias (des, expr) ;
+ SetVarInitialized (des, FALSE) ;
+ (* Now see if we know what lhs is pointing to and set fields if necessary. *)
+ IF IsComponent (des)
+ THEN
+ vsym := ComponentFindVar (des) ;
+ (* Set only the field assigned in vsym as initialized. *)
+ lst := ComponentCreateFieldList (des) ;
+ IF PutVarFieldInitialized (vsym, RightValue, lst)
+ THEN
+ END ;
+ KillList (lst)
+ END
+END CheckBecomes ;
+
+
+(*
+ CheckComparison -
+*)
+
+PROCEDURE CheckComparison (procSym, op1tok, op1, op2tok, op2: CARDINAL) ;
+BEGIN
+ CheckDeferredRecordAccess (procSym, op1tok, op1, FALSE) ;
+ CheckDeferredRecordAccess (procSym, op2tok, op2, FALSE)
+END CheckComparison ;
+
+
+(*
+ CheckAddr -
+*)
+
+PROCEDURE CheckAddr (procSym, op1tok, op1, op3tok, op3: CARDINAL) ;
+BEGIN
+ SetVarInitialized (op1, GetVarInitialized (op3)) ;
+ SetupAlias (op1, op3)
+END CheckAddr ;
+
+
+(*
+ DefaultTokPos -
+*)
+
+PROCEDURE DefaultTokPos (preferredPos, defaultPos: CARDINAL) : CARDINAL ;
+BEGIN
+ IF preferredPos = UnknownTokenNo
+ THEN
+ RETURN defaultPos
+ END ;
+ RETURN preferredPos
+END DefaultTokPos ;
+
+
+(*
+ stop -
+*)
+
+PROCEDURE stop ;
+END stop ;
+
+
+(*
+ CheckReadBeforeInitQuad -
+*)
+
+PROCEDURE CheckReadBeforeInitQuad (procSym: CARDINAL; quad: CARDINAL) : BOOLEAN ;
+VAR
+ op : QuadOperator ;
+ op1, op2, op3 : CARDINAL ;
+ op1tok, op2tok, op3tok, qtok: CARDINAL ;
+ overflowChecking : BOOLEAN ;
+BEGIN
+ IF quad = 3140
+ THEN
+ stop
+ END ;
+ IF Debugging
+ THEN
+ printf1 ("CheckReadBeforeInitQuad (quad %d)\n", quad) ;
+ DumpAliases ;
+ ForeachLocalSymDo (procSym, PrintSym) ;
+ printf0 ("***********************************\n")
+ END ;
+ GetQuadOtok (quad, qtok, op, op1, op2, op3, overflowChecking,
+ op1tok, op2tok, op3tok) ;
+ op1tok := DefaultTokPos (op1tok, qtok) ;
+ op2tok := DefaultTokPos (op2tok, qtok) ;
+ op3tok := DefaultTokPos (op3tok, qtok) ;
+ CASE op OF
+
+ (* Jumps, calls and branches. *)
+ IfInOp,
+ IfNotInOp,
+ IfEquOp,
+ IfNotEquOp,
+ IfLessOp,
+ IfLessEquOp,
+ IfGreOp,
+ IfGreEquOp : CheckComparison (procSym, op1tok, op1, op2tok, op2) |
+ TryOp,
+ ReturnOp,
+ CallOp,
+ KillLocalVarOp,
+ RetryOp,
+ GotoOp : RETURN TRUE | (* End of basic block. *)
+
+ (* Variable references. *)
+
+ InclOp,
+ ExclOp : CheckDeferredRecordAccess (procSym, op1tok, op1, FALSE) ;
+ CheckDeferredRecordAccess (procSym, op1tok, op1, TRUE) ;
+ CheckDeferredRecordAccess (procSym, op3tok, op3, FALSE) |
+ NegateOp : CheckUnary (procSym, op1tok, op1, op3tok, op3) |
+ BecomesOp : CheckBecomes (procSym, op1tok, op1, op3tok, op3) |
+ UnboundedOp,
+ FunctValueOp,
+ HighOp,
+ SizeOp : SetVarInitialized (op1, FALSE) |
+ AddrOp : CheckAddr (procSym, op1tok, op1, op3tok, op3) |
+ ReturnValueOp : SetVarInitialized (op1, FALSE) |
+ NewLocalVarOp : |
+ ParamOp : CheckDeferredRecordAccess (procSym, op2tok, op2, FALSE) ;
+ CheckDeferredRecordAccess (procSym, op3tok, op3, FALSE) ;
+ IF (op1 > 0) AND (op1 <= NoOfParam (op2)) AND
+ IsVarParam (op2, op1)
+ THEN
+ SetVarInitialized (op3, TRUE)
+ END |
+ ArrayOp : CheckDeferredRecordAccess (procSym, op3tok, op3, FALSE) ;
+ SetVarInitialized (op1, TRUE) |
+ RecordFieldOp : CheckRecordField (procSym, op1tok, op1, op2tok, op2) |
+ LogicalShiftOp,
+ LogicalRotateOp,
+ LogicalOrOp,
+ LogicalAndOp,
+ LogicalXorOp,
+ CoerceOp,
+ ConvertOp,
+ CastOp,
+ AddOp,
+ ArithAddOp,
+ SubOp,
+ MultOp,
+ DivM2Op,
+ ModM2Op,
+ ModFloorOp,
+ DivCeilOp,
+ ModCeilOp,
+ DivFloorOp,
+ ModTruncOp,
+ DivTruncOp : CheckBinary (procSym,
+ op1tok, op1, op2tok, op2, op3tok, op3) |
+ XIndrOp : CheckXIndr (procSym, op1tok, op1, op2, op3tok, op3) |
+ IndrXOp : CheckIndrX (procSym, op1tok, op1, op2, op3tok, op3) |
+ RangeCheckOp : |
+ SaveExceptionOp : SetVarInitialized (op1, FALSE) |
+ RestoreExceptionOp: CheckDeferredRecordAccess (procSym, op1tok, op1, FALSE)
+
+ ELSE
+ END ;
+ RETURN FALSE
+END CheckReadBeforeInitQuad ;
+
+
+(*
+ FilterCheckReadBeforeInitQuad -
+*)
+
+PROCEDURE FilterCheckReadBeforeInitQuad (procSym: CARDINAL; start: CARDINAL) : BOOLEAN ;
+VAR
+ Op : QuadOperator ;
+ Op1, Op2, Op3: CARDINAL ;
+BEGIN
+ GetQuad (start, Op, Op1, Op2, Op3) ;
+ IF (Op # RangeCheckOp) AND (Op # StatementNoteOp)
+ THEN
+ RETURN CheckReadBeforeInitQuad (procSym, start)
+ END ;
+ RETURN FALSE
+END FilterCheckReadBeforeInitQuad ;
+
+
+(*
+ CheckReadBeforeInitFirstBasicBlock -
+*)
+
+PROCEDURE CheckReadBeforeInitFirstBasicBlock (procSym: CARDINAL;
+ start, end: CARDINAL) ;
+BEGIN
+ ForeachLocalSymDo (procSym, SetVarUninitialized) ;
+ LOOP
+ IF FilterCheckReadBeforeInitQuad (procSym, start) OR (start = end)
+ THEN
+ RETURN
+ END ;
+ start := GetNextQuad (start)
+ END
+END CheckReadBeforeInitFirstBasicBlock ;
+
+
+(*
+ VariableAnalysis - checks to see whether a variable is:
+
+ read before it has been initialized
+*)
+
+PROCEDURE VariableAnalysis (Start, End: CARDINAL) ;
+VAR
+ Op : QuadOperator ;
+ Op1, Op2, Op3: CARDINAL ;
+BEGIN
+ IF UninitVariableChecking
+ THEN
+ GetQuad (Start, Op, Op1, Op2, Op3) ;
+ CASE Op OF
+
+ NewLocalVarOp: initBlock ;
+ CheckReadBeforeInitFirstBasicBlock (Op3, Start, End) ;
+ killBlock
+
+ ELSE
+ END
+ END
+END VariableAnalysis ;
+
+
+(*
+ DumpAlias -
+*)
+
+PROCEDURE DumpAlias (aliasIndex: CARDINAL) ;
+VAR
+ sa: symAlias ;
+BEGIN
+ sa := Indexing.GetIndice (aliasArray, aliasIndex) ;
+ printf2 ("keySym = %d: alias = %d\n", sa^.keySym, sa^.alias) ;
+END DumpAlias ;
+
+
+(*
+ DumpAliases -
+*)
+
+PROCEDURE DumpAliases ;
+VAR
+ i, n: CARDINAL ;
+BEGIN
+ IF Debugging
+ THEN
+ i := 1 ;
+ n := Indexing.HighIndice (aliasArray) ;
+ WHILE i <= n DO
+ DumpAlias (i) ;
+ INC (i)
+ END
+ END
+END DumpAliases ;
+
+
+(*
+ newAlias -
+*)
+
+PROCEDURE newAlias () : symAlias ;
+VAR
+ sa: symAlias ;
+BEGIN
+ IF freeList = NIL
+ THEN
+ NEW (sa)
+ ELSE
+ sa := freeList ;
+ freeList := freeList^.next
+ END ;
+ RETURN sa
+END newAlias ;
+
+
+(*
+ initAlias -
+*)
+
+PROCEDURE initAlias (sym: CARDINAL) : symAlias ;
+VAR
+ sa: symAlias ;
+BEGIN
+ sa := newAlias () ;
+ WITH sa^ DO
+ keySym := sym ;
+ alias := NulSym ;
+ next := NIL
+ END ;
+ RETURN sa
+END initAlias ;
+
+
+(*
+ killAlias -
+*)
+
+PROCEDURE killAlias (sa: symAlias) ;
+BEGIN
+ sa^.next := freeList ;
+ freeList := sa
+END killAlias ;
+
+
+(*
+ initBlock -
+*)
+
+PROCEDURE initBlock ;
+BEGIN
+ aliasArray := Indexing.InitIndex (1) ;
+END initBlock ;
+
+
+(*
+ killBlock -
+*)
+
+PROCEDURE killBlock ;
+VAR
+ i, n: CARDINAL ;
+BEGIN
+ i := 1 ;
+ n := Indexing.HighIndice (aliasArray) ;
+ WHILE i <= n DO
+ killAlias (Indexing.GetIndice (aliasArray, i)) ;
+ INC (i)
+ END ;
+ aliasArray := Indexing.KillIndex (aliasArray)
+END killBlock ;
+
+
+(*
+ addAlias -
+*)
+
+PROCEDURE addAlias (sym: CARDINAL; aliased: CARDINAL) ;
+VAR
+ i, n: CARDINAL ;
+ sa : symAlias ;
+BEGIN
+ i := 1 ;
+ n := Indexing.HighIndice (aliasArray) ;
+ WHILE i <= n DO
+ sa := Indexing.GetIndice (aliasArray, i) ;
+ IF sa^.keySym = sym
+ THEN
+ sa^.alias := aliased ;
+ RETURN
+ END ;
+ INC (i)
+ END ;
+ sa := initAlias (sym) ;
+ Indexing.IncludeIndiceIntoIndex (aliasArray, sa) ;
+ sa^.alias := aliased
+END addAlias ;
+
+
+(*
+ lookupAlias -
+*)
+
+PROCEDURE lookupAlias (sym: CARDINAL) : symAlias ;
+VAR
+ i, n: CARDINAL ;
+ sa : symAlias ;
+BEGIN
+ i := 1 ;
+ n := Indexing.HighIndice (aliasArray) ;
+ WHILE i <= n DO
+ sa := Indexing.GetIndice (aliasArray, i) ;
+ IF sa^.keySym = sym
+ THEN
+ RETURN sa
+ END ;
+ INC (i)
+ END ;
+ RETURN NIL
+END lookupAlias ;
+
+
+(*
+ doGetAlias -
+*)
+
+PROCEDURE doGetAlias (sym: CARDINAL) : CARDINAL ;
+VAR
+ sa: symAlias ;
+BEGIN
+ sa := lookupAlias (sym) ;
+ IF (sa # NIL) AND (sa^.alias # NulSym)
+ THEN
+ RETURN sa^.alias
+ END ;
+ RETURN NulSym
+END doGetAlias ;
+
+
+(*
+ getAlias - attempts to looks up an alias which is not a temporary variable.
+*)
+
+PROCEDURE getAlias (sym: CARDINAL) : CARDINAL ;
+VAR
+ type,
+ nsym: CARDINAL ;
+BEGIN
+ nsym := sym ;
+ REPEAT
+ sym := nsym ;
+ type := GetSType (sym) ;
+ IF (IsTemporary (sym) AND (GetMode (sym) = LeftValue)) OR
+ ((type # NulSym) AND IsReallyPointer (type))
+ THEN
+ nsym := doGetAlias (sym)
+ ELSE
+ RETURN sym
+ END
+ UNTIL nsym = NulSym ;
+ RETURN sym
+END getAlias ;
+
+
+(*
+ SetupAlias -
+*)
+
+PROCEDURE SetupAlias (des, exp: CARDINAL) ;
+BEGIN
+ IF IsVar (exp) AND
+ ((GetMode (des) = LeftValue) OR IsReallyPointer (GetSType (des)))
+ THEN
+ addAlias (des, exp) ;
+ DumpAliases
+ END
+END SetupAlias ;
+
+
+(*
+ init -
+*)
+
+PROCEDURE init ;
+BEGIN
+ freeList := NIL
+END init ;
+
+
+BEGIN
+ init
+END M2SymInit.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index 5249952e22f..c861cffc0fa 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -355,7 +355,10 @@ EXPORT QUALIFIED NulSym,
PopOffset,
PopSumOfParamSize,
DisplayTrees,
- DebugLineNumbers ;
+ DebugLineNumbers,
+ VarCheckReadInit, VarInitState, PutVarInitialized,
+ PutVarFieldInitialized, GetVarFieldInitialized,
+ PrintInitialized ;
(*
@@ -3558,4 +3561,51 @@ PROCEDURE IsModuleBuiltin (sym: CARDINAL) : BOOLEAN ;
PROCEDURE PutModuleBuiltin (sym: CARDINAL; value: BOOLEAN) ;
+(*
+ VarCheckReadInit - returns TRUE if sym has been initialized.
+*)
+
+PROCEDURE VarCheckReadInit (sym: CARDINAL; mode: ModeOfAddr) : BOOLEAN ;
+
+
+(*
+ VarInitState - initializes the init state for variable sym.
+*)
+
+PROCEDURE VarInitState (sym: CARDINAL) ;
+
+
+(*
+ PutVarInitialized - set sym as initialized.
+*)
+
+PROCEDURE PutVarInitialized (sym: CARDINAL; mode: ModeOfAddr) ;
+
+
+(*
+ PutVarFieldInitialized - records that field has been initialized with
+ variable sym. TRUE is returned if the field
+ is detected and changed to initialized.
+*)
+
+PROCEDURE PutVarFieldInitialized (sym: CARDINAL; mode: ModeOfAddr;
+ fieldlist: List) : BOOLEAN ;
+
+
+(*
+ GetVarFieldInitialized - return TRUE if fieldlist has been initialized
+ within variable sym.
+*)
+
+PROCEDURE GetVarFieldInitialized (sym: CARDINAL; mode: ModeOfAddr;
+ fieldlist: List) : BOOLEAN ;
+
+
+(*
+ PrintInitialized - display variable sym initialization state.
+*)
+
+PROCEDURE PrintInitialized (sym: CARDINAL) ;
+
+
END SymbolTable.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 4119c033e42..fdf7b36360c 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -87,6 +87,10 @@ FROM M2Comp IMPORT CompilingDefinitionModule,
FROM FormatStrings IMPORT HandleEscape ;
FROM M2Scaffold IMPORT DeclareArgEnvParams ;
+FROM M2SymInit IMPORT InitDesc, InitSymInit, GetInitialized, ConfigSymInit,
+ SetInitialized, SetFieldInitialized, GetFieldInitialized,
+ PrintSymInit ;
+
IMPORT Indexing ;
@@ -110,6 +114,8 @@ CONST
TYPE
LRLists = ARRAY [RightValue..LeftValue] OF List ;
+ LRInitDesc = ARRAY [RightValue..LeftValue] OF InitDesc ;
+
TypeOfSymbol = (RecordSym, VarientSym, DummySym,
VarSym, EnumerationSym, SubrangeSym, ArraySym,
ConstStringSym, ConstVarSym, ConstLitSym,
@@ -510,6 +516,7 @@ TYPE
IsWritten : BOOLEAN ; (* Is variable written to? *)
IsSSA : BOOLEAN ; (* Is variable a SSA? *)
IsConst : BOOLEAN ; (* Is variable read/only? *)
+ InitState : LRInitDesc ; (* Initialization state. *)
At : Where ; (* Where was sym declared/used *)
ReadUsageList, (* list of var read quads *)
WriteUsageList: LRLists ; (* list of var write quads *)
@@ -4249,7 +4256,9 @@ BEGIN
InitList(ReadUsageList[RightValue]) ;
InitList(WriteUsageList[RightValue]) ;
InitList(ReadUsageList[LeftValue]) ;
- InitList(WriteUsageList[LeftValue])
+ InitList(WriteUsageList[LeftValue]) ;
+ InitState[LeftValue] := InitSymInit () ;
+ InitState[RightValue] := InitSymInit ()
END
END ;
(* Add Var to Procedure or Module variable list. *)
@@ -6597,7 +6606,9 @@ BEGIN
WITH pSym^ DO
CASE SymbolType OF
- VarSym : Var.Type := VarType |
+ VarSym : Var.Type := VarType ;
+ ConfigSymInit (Var.InitState[LeftValue], Sym) ;
+ ConfigSymInit (Var.InitState[RightValue], Sym) |
ConstVarSym: ConstVar.Type := VarType
ELSE
@@ -7833,7 +7844,7 @@ BEGIN
IsHiddenTypeDeclared(CurrentModule) AND
(TypeName#NulName)
THEN
- (* Check to see whether we are declaring a HiddenType. *)
+ (* Check to see whether we are declaring a HiddenType. *)
pSym := GetPsym(CurrentModule) ;
WITH pSym^ DO
CASE SymbolType OF
@@ -14344,6 +14355,162 @@ BEGIN
END GetDefaultRecordFieldAlignment ;
+(*
+ VarCheckReadInit - returns TRUE if sym has been initialized.
+*)
+
+PROCEDURE VarCheckReadInit (sym: CARDINAL; mode: ModeOfAddr) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsVar (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym: RETURN GetInitialized (Var.InitState[mode])
+
+ ELSE
+ END
+ END
+ END ;
+ RETURN FALSE
+END VarCheckReadInit ;
+
+
+(*
+ VarInitState - initializes the init state for variable sym.
+*)
+
+PROCEDURE VarInitState (sym: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsVar (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym: ConfigSymInit (Var.InitState[LeftValue], sym) ;
+ ConfigSymInit (Var.InitState[RightValue], sym)
+
+ ELSE
+ END
+ END
+ END
+END VarInitState ;
+
+
+(*
+ PutVarInitialized - set sym as initialized.
+*)
+
+PROCEDURE PutVarInitialized (sym: CARDINAL; mode: ModeOfAddr) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsVar (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym: WITH Var DO
+ SetInitialized (InitState[mode])
+ END
+
+ ELSE
+ END
+ END
+ END
+END PutVarInitialized ;
+
+
+(*
+ PutVarFieldInitialized - records that field has been initialized with
+ variable sym. TRUE is returned if the field
+ is detected and changed to initialized.
+*)
+
+PROCEDURE PutVarFieldInitialized (sym: CARDINAL; mode: ModeOfAddr;
+ fieldlist: List) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsVar (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym: WITH Var DO
+ RETURN SetFieldInitialized (InitState[mode], fieldlist)
+ END
+
+ ELSE
+ END
+ END
+ END ;
+ RETURN FALSE
+END PutVarFieldInitialized ;
+
+
+(*
+ GetVarFieldInitialized - return TRUE if fieldlist has been initialized
+ within variable sym.
+*)
+
+PROCEDURE GetVarFieldInitialized (sym: CARDINAL; mode: ModeOfAddr;
+ fieldlist: List) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsVar (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym: WITH Var DO
+ RETURN GetFieldInitialized (InitState[mode], fieldlist)
+ END
+
+ ELSE
+ END
+ END
+ END ;
+ RETURN FALSE
+END GetVarFieldInitialized ;
+
+
+(*
+ PrintInitialized - display variable sym initialization state.
+*)
+
+PROCEDURE PrintInitialized (sym: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsVar (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym: printf0 ("LeftMode init: ") ;
+ PrintSymInit (Var.InitState[LeftValue]) ;
+ printf0 ("RightMode init: ") ;
+ PrintSymInit (Var.InitState[RightValue])
+
+ ELSE
+ END
+ END
+ END
+END PrintInitialized ;
+
+
(*
DumpSymbols - display all symbol numbers and their type.
*)
diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h
index 767b617282a..e203fce43da 100644
--- a/gcc/m2/gm2-gcc/m2options.h
+++ b/gcc/m2/gm2-gcc/m2options.h
@@ -136,6 +136,8 @@ EXTERN void M2Options_SetM2Prefix (const char *arg);
EXTERN char *M2Options_GetM2Prefix (void);
EXTERN void M2Options_SetM2PathName (const char *arg);
EXTERN char *M2Options_GetM2PathName (void);
+EXTERN void M2Options_SetUninitVariableChecking (bool value);
+
#undef EXTERN
#endif /* m2options_h. */
diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc
index fe52393d34d..ae999a3c4d1 100644
--- a/gcc/m2/gm2-lang.cc
+++ b/gcc/m2/gm2-lang.cc
@@ -469,6 +469,9 @@ gm2_langhook_handle_option (
case OPT_Wunused_parameter:
M2Options_SetUnusedParameterChecking (value);
return 1;
+ case OPT_Wuninit_variable_checking:
+ M2Options_SetUninitVariableChecking (value);
+ return 1;
case OPT_fm2_strict_type:
M2Options_SetStrictTypeChecking (value);
return 1;
diff --git a/gcc/m2/lang.opt b/gcc/m2/lang.opt
index 7a0edb71c50..6dbdf9d3110 100644
--- a/gcc/m2/lang.opt
+++ b/gcc/m2/lang.opt
@@ -293,6 +293,10 @@ Wunused-parameter
Modula-2
; Documented in c.opt
+Wuninit-variable-checking
+Modula-2
+turns on compile time analysis in the first basic block of a procedure detecting access to uninitialized data.
+
B
Modula-2
; Documented in c.opt
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/switches-uninit-variable-checking-fail.exp b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/switches-uninit-variable-checking-fail.exp
new file mode 100644
index 00000000000..36b36d26374
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/switches-uninit-variable-checking-fail.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2023 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/switches/uninit-variable-checking/fail" -Wuninit-variable-checking
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testinit.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testinit.mod
new file mode 100644
index 00000000000..cc5b60b609e
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testinit.mod
@@ -0,0 +1,17 @@
+MODULE testinit ;
+
+
+PROCEDURE test ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ (* p := 6 ; *)
+ IF p = 6
+ THEN
+ END
+END test ;
+
+
+BEGIN
+ test
+END testinit.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge.mod
new file mode 100644
index 00000000000..8503c173b2e
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge.mod
@@ -0,0 +1,27 @@
+MODULE testlarge ;
+
+TYPE
+ color = RECORD
+ r, g, b: CARDINAL ;
+ END ;
+
+ pixel = RECORD
+ fg, bg: color ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ p: pixel ;
+BEGIN
+ p.fg.r := 1 ;
+ p.fg.g := 2 ;
+ (* p.fg.b := 3 ; *)
+ p.bg := p.fg ; (* this should result in a warning. *)
+ IF p.bg.b = 6
+ THEN
+ END
+END test ;
+
+BEGIN
+ test
+END testlarge.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge2.mod
new file mode 100644
index 00000000000..803f5ca6b60
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testlarge2.mod
@@ -0,0 +1,24 @@
+MODULE testlarge2 ;
+
+TYPE
+ color = RECORD
+ r, g, b: CARDINAL ;
+ END ;
+
+ pixel = RECORD
+ fg, bg: color ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ p: pixel ;
+BEGIN
+ p.fg.r := 1 ;
+ p.fg.g := 2 ;
+ p.fg.g := 3 ; (* Deliberate typo should be p.fg.b. *)
+ p.bg := p.fg ; (* This should result in a warning. *)
+END test ;
+
+BEGIN
+ test
+END testlarge2.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit.mod
new file mode 100644
index 00000000000..15bd1df3ec9
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit.mod
@@ -0,0 +1,31 @@
+MODULE testrecinit ;
+
+
+TYPE
+ color = RECORD
+ r, g, b: CARDINAL ;
+ END ;
+
+ pixel = RECORD
+ fg, bg: color ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ p: pixel ;
+BEGIN
+ p.fg.r := 1 ;
+ p.fg.g := 2 ;
+ p.fg.b := 3 ;
+ p.bg.r := 4 ;
+ p.bg.g := 5 ;
+ (* p.bg.b := 6 ; *)
+ (* forget to initialize p.bg.b *)
+ IF p.bg.b = 6 (* should catch error. *)
+ THEN
+ END
+END test ;
+
+BEGIN
+ test
+END testrecinit.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit2.mod
new file mode 100644
index 00000000000..decce3bcd2c
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit2.mod
@@ -0,0 +1,25 @@
+MODULE testrecinit ;
+
+
+TYPE
+ color = RECORD
+ r, g, b: CARDINAL ;
+ END ;
+
+ pixel = RECORD
+ fg, bg: color ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ p: pixel ;
+BEGIN
+ p.fg.r := 1 ;
+ IF p.fg.g = 6 (* should catch error. *)
+ THEN
+ END
+END test ;
+
+BEGIN
+ test
+END testrecinit.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit5.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit5.mod
new file mode 100644
index 00000000000..c67620a7923
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testrecinit5.mod
@@ -0,0 +1,25 @@
+MODULE testrecinit5 ;
+
+
+TYPE
+ color = RECORD
+ r, g, b: CARDINAL ;
+ END ;
+
+ pixel = RECORD
+ fg, bg: color ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ p: pixel ;
+BEGIN
+ (* p.bg.b := 6 ; *)
+ IF p.bg.b = 6
+ THEN
+ END
+END test ;
+
+BEGIN
+ test
+END testrecinit5.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec.mod
new file mode 100644
index 00000000000..ce974730d16
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec.mod
@@ -0,0 +1,22 @@
+MODULE testsmallrec ;
+
+
+TYPE
+ vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ v: vec ;
+BEGIN
+ (* v.x := 1 ; *)
+ v.y := 2 ;
+ IF v.x = 1 (* This line should be the cause of a warning. *)
+ THEN
+ END
+END test ;
+
+BEGIN
+ test
+END testsmallrec.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec2.mod
new file mode 100644
index 00000000000..c0be5d92d5f
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallrec2.mod
@@ -0,0 +1,24 @@
+MODULE testsmallrec2 ;
+
+
+TYPE
+ vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ v: vec ;
+BEGIN
+ (* v.x := 1 ; *)
+ v.y := 2 ;
+ WITH v DO
+ IF x = 1
+ THEN
+ END
+ END
+END test ;
+
+BEGIN
+ test
+END testsmallrec2.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallvec.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallvec.mod
new file mode 100644
index 00000000000..1e55bd13336
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testsmallvec.mod
@@ -0,0 +1,20 @@
+MODULE testsmallvec ;
+
+TYPE
+ vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ v: vec ;
+BEGIN
+ IF v.x = 2
+ THEN
+ END
+END test ;
+
+
+BEGIN
+ test
+END testsmallvec.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testvarinit.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testvarinit.mod
new file mode 100644
index 00000000000..8f188eb41db
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testvarinit.mod
@@ -0,0 +1,17 @@
+MODULE testvarinit ;
+
+
+PROCEDURE test ;
+VAR
+ x: CARDINAL ;
+BEGIN
+ (* x := 1 ; *)
+ IF x = 1
+ THEN
+ END
+END test ;
+
+
+BEGIN
+ test
+END testvarinit.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithnoptr.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithnoptr.mod
new file mode 100644
index 00000000000..3836470f171
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithnoptr.mod
@@ -0,0 +1,29 @@
+MODULE testwithnoptr ;
+
+TYPE
+ Vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ p: Vec ;
+BEGIN
+ WITH p DO
+ x := 1 ;
+ x := 2 (* deliberate typo - should be y *)
+ END ;
+ IF p.y = 2
+ THEN
+ END
+END test ;
+
+
+BEGIN
+ test
+END testwithnoptr.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr.mod
new file mode 100644
index 00000000000..063ddc46138
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr.mod
@@ -0,0 +1,34 @@
+MODULE testwithptr ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ p: PtrToVec ;
+ v: Vec ;
+BEGIN
+ p := ADR (v) ;
+ WITH p^ DO
+ x := 1 ;
+ x := 2 (* deliberate typo - should be y *)
+ END ;
+ IF p^.y = 2
+ THEN
+ END
+END test ;
+
+
+BEGIN
+ test
+END testwithptr.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr2.mod
new file mode 100644
index 00000000000..176b830e680
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr2.mod
@@ -0,0 +1,30 @@
+MODULE testwithptr2 ;
+
+TYPE
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ p: PtrToVec ;
+BEGIN
+ WITH p^ DO
+ x := 1 ;
+ x := 2 (* deliberate typo - should be y *)
+ END ;
+ IF p^.y = 2
+ THEN
+ END
+END test ;
+
+
+BEGIN
+ test
+END testwithptr2.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr3.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr3.mod
new file mode 100644
index 00000000000..b442a626304
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/fail/testwithptr3.mod
@@ -0,0 +1,21 @@
+MODULE testwithptr3 ;
+
+TYPE
+ ptr = POINTER TO vec ;
+ vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+
+PROCEDURE test ;
+VAR
+ p: ptr ;
+BEGIN
+ WITH p^ DO
+
+ END
+END test ;
+
+BEGIN
+ test
+END testwithptr3.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/switches-uninit-variable-checking-pass.exp b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/switches-uninit-variable-checking-pass.exp
new file mode 100644
index 00000000000..078daeb533b
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/switches-uninit-variable-checking-pass.exp
@@ -0,0 +1,37 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2023 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/switches/pedantic-params/pass" -Wuninit-variable-checking
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture $testcase
+}
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testrecinit3.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testrecinit3.mod
new file mode 100644
index 00000000000..872e875d76e
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testrecinit3.mod
@@ -0,0 +1,30 @@
+MODULE testrecinit3 ;
+
+
+TYPE
+ color = RECORD
+ r, g, b: CARDINAL ;
+ END ;
+
+ pixel = RECORD
+ fg, bg: color ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ p: pixel ;
+BEGIN
+ p.fg.r := 1 ;
+ p.fg.g := 2 ;
+ p.fg.b := 3 ;
+ p.bg.r := 4 ;
+ p.bg.g := 5 ;
+ p.bg.b := 6 ;
+ IF p.bg.b = 6
+ THEN
+ END
+END test ;
+
+BEGIN
+ test
+END testrecinit3.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testrecinit5.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testrecinit5.mod
new file mode 100644
index 00000000000..ea15c57fb5f
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testrecinit5.mod
@@ -0,0 +1,25 @@
+MODULE testrecinit5 ;
+
+
+TYPE
+ color = RECORD
+ r, g, b: CARDINAL ;
+ END ;
+
+ pixel = RECORD
+ fg, bg: color ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ p: pixel ;
+BEGIN
+ p.bg.b := 6 ;
+ IF p.bg.b = 6
+ THEN
+ END
+END test ;
+
+BEGIN
+ test
+END testrecinit5.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec.mod
new file mode 100644
index 00000000000..37d855c51f6
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec.mod
@@ -0,0 +1,22 @@
+MODULE testsmallrec ;
+
+
+TYPE
+ vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ v: vec ;
+BEGIN
+ v.x := 1 ;
+ v.y := 2 ;
+ IF v.x = 1
+ THEN
+ END
+END test ;
+
+BEGIN
+ test
+END testsmallrec.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec2.mod
new file mode 100644
index 00000000000..095d72e85af
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testsmallrec2.mod
@@ -0,0 +1,24 @@
+MODULE testsmallrec2 ;
+
+
+TYPE
+ vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+PROCEDURE test ;
+VAR
+ v: vec ;
+BEGIN
+ v.x := 1 ;
+ v.y := 2 ;
+ WITH v DO
+ IF x = 1
+ THEN
+ END
+ END
+END test ;
+
+BEGIN
+ test
+END testsmallrec2.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testvarinit.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testvarinit.mod
new file mode 100644
index 00000000000..8229bef849d
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testvarinit.mod
@@ -0,0 +1,17 @@
+MODULE testvarinit ;
+
+
+PROCEDURE test ;
+VAR
+ x: CARDINAL ;
+BEGIN
+ x := 1 ;
+ IF x = 1
+ THEN
+ END
+END test ;
+
+
+BEGIN
+ test
+END testvarinit.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr.mod
new file mode 100644
index 00000000000..90d6373c2af
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr.mod
@@ -0,0 +1,34 @@
+MODULE testwithptr ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ p: PtrToVec ;
+ v: Vec ;
+BEGIN
+ p := ADR (v) ;
+ WITH p^ DO
+ x := 1 ;
+ y := 2
+ END ;
+ IF p^.y = 2
+ THEN
+ END
+END test ;
+
+
+BEGIN
+ test
+END testwithptr.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr2.mod
new file mode 100644
index 00000000000..bb0c7b520c5
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr2.mod
@@ -0,0 +1,31 @@
+MODULE testwithptr2 ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ p: PtrToVec ;
+ v: Vec ;
+BEGIN
+ p := ADR (v) ;
+ p^ := Vec {1, 2} ;
+ IF p^.y = 2
+ THEN
+ END
+END test ;
+
+
+BEGIN
+ test
+END testwithptr2.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr3.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr3.mod
new file mode 100644
index 00000000000..71ffe1fda07
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/testwithptr3.mod
@@ -0,0 +1,31 @@
+MODULE testwithptr3 ;
+
+FROM SYSTEM IMPORT ADR ;
+
+TYPE
+ PtrToVec = POINTER TO Vec ;
+ Vec = RECORD
+ x, y: CARDINAL ;
+ END ;
+
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ p: PtrToVec ;
+ v: Vec ;
+BEGIN
+ p := ADR (v) ;
+ v := Vec {1, 2} ;
+ IF p^.y = 2
+ THEN
+ END
+END test ;
+
+
+BEGIN
+ test
+END testwithptr3.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-07-30 1:19 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-07-30 1:19 [gcc r13-7650] PR modula2/110125 variables reported as uninitialized when set inside WITH Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).