public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-7657] modula2: Implement limited VAR parameter static analysis
@ 2023-07-30 19:10 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-07-30 19:10 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:4151276fa8406bc3bab51c64066016f5d906837a
commit r13-7657-g4151276fa8406bc3bab51c64066016f5d906837a
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Sun Jul 30 20:09:35 2023 +0100
modula2: Implement limited VAR parameter static analysis
This patch implements limited VAR parameter static analysis for pointer
parameters.
gcc/m2/ChangeLog:
* gm2-compiler/M2SymInit.mod (IsExempt): Remove parameter exemption.
(CheckIndrX): Call SetupLAlias between lhs and content.
(trashParam): Re-write.
(SetVarLRInitialized): Indicate shadow and heap are initialized.
Call SetupIndr between shadow and heap.
* gm2-compiler/P2SymBuild.mod: Import
PutProcedureParameterHeapVars.
(EndBuildProcedure): Call PutProcedureParameterHeapVars.
* gm2-compiler/SymbolTable.def (GetParameterHeapVar): New
procedure function.
(PutProcedureParameterHeapVars): New procedure function.
* gm2-compiler/SymbolTable.mod (MakeParameterHeapVar): New
procedure function.
(GetParameterHeapVar): New procedure function.
(PuttParameterHeapVar): New procedure function.
(PutProcedureParameterHeapVars): New procedure.
(VarParam): HeapVar new record field.
(PutVarParam): HeapVar assigned to NulSym.
gcc/testsuite/ChangeLog:
* gm2/switches/uninit-variable-checking/procedures/fail/testdispose3.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/fail/testdispose4.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/pass/testdispose3.mod: New test.
* gm2/switches/uninit-variable-checking/procedures/pass/testdispose4.mod: New test.
(cherry picked from commit 083e7857a9ebf187b9116c74f6acf161f593bad9)
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2SymInit.mod | 94 ++++++++++++++--------
gcc/m2/gm2-compiler/P2SymBuild.mod | 2 +
gcc/m2/gm2-compiler/SymbolTable.def | 18 ++++-
gcc/m2/gm2-compiler/SymbolTable.mod | 85 ++++++++++++++++++-
.../procedures/fail/testdispose3.mod | 24 ++++++
.../procedures/fail/testdispose4.mod | 22 +++++
.../procedures/pass/testdispose3.mod | 23 ++++++
.../procedures/pass/testdispose4.mod | 22 +++++
8 files changed, 252 insertions(+), 38 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2SymInit.mod b/gcc/m2/gm2-compiler/M2SymInit.mod
index 81d1e6baf50..b629ed87ed7 100644
--- a/gcc/m2/gm2-compiler/M2SymInit.mod
+++ b/gcc/m2/gm2-compiler/M2SymInit.mod
@@ -60,7 +60,8 @@ FROM SymbolTable IMPORT NulSym, ModeOfAddr, IsVar, IsRecord, GetSType,
IsVarient, IsFieldVarient, GetVarient,
IsVarArrayRef, GetSymName,
IsType, IsPointer,
- GetParameterShadowVar, IsParameter, GetLType ;
+ GetParameterShadowVar, IsParameter, GetLType,
+ GetParameterHeapVar ;
FROM M2Quads IMPORT QuadOperator, GetQuadOtok, GetQuad, GetNextQuad,
IsNewLocalVar, IsReturn, IsKillLocalVar, IsConditional,
@@ -1052,7 +1053,7 @@ PROCEDURE IsExempt (sym: CARDINAL) : BOOLEAN ;
BEGIN
RETURN (sym # NulSym) AND IsVar (sym) AND
(IsGlobalVar (sym) OR
- (IsVarAParam (sym) AND (GetMode (sym) = LeftValue)) OR
+ (* (IsVarAParam (sym) AND (GetMode (sym) = LeftValue)) OR *)
ContainsVariant (sym) OR
IsArray (GetSType (sym)) OR IsSet (GetSType (sym)) OR
IsUnbounded (GetSType (sym)) OR IsVarArrayRef (sym) OR
@@ -1098,23 +1099,27 @@ PROCEDURE CheckXIndr (procSym, lhstok, lhs, type,
rhstok, rhs: CARDINAL; warning: BOOLEAN;
bblst: List; i: CARDINAL) ;
VAR
- lst : List ;
- vsym: CARDINAL ;
+ lst : List ;
+ content: CARDINAL ;
BEGIN
CheckDeferredRecordAccess (procSym, rhstok, rhs, FALSE, warning, bblst, i) ;
CheckDeferredRecordAccess (procSym, lhstok, lhs, FALSE, warning, bblst, i) ;
(* Now see if we know what lhs is pointing to and set fields if necessary. *)
- vsym := getContent (getLAlias (lhs), lhs, lhstok) ;
- IF (vsym # NulSym) AND (vsym # lhs) AND (GetSType (vsym) = type)
+ content := getContent (getLAlias (lhs), lhs, lhstok) ;
+ IF (content # NulSym) AND (content # lhs) AND (GetSType (content) = type)
THEN
+ IF IsReallyPointer (rhs)
+ THEN
+ SetupLAlias (content, rhs)
+ END ;
IF IsRecord (type)
THEN
- (* Set all fields of vsym as initialized. *)
- SetVarInitialized (vsym, FALSE, lhstok)
+ (* Set all fields of content as initialized. *)
+ SetVarInitialized (content, FALSE, lhstok)
ELSE
(* Set only the field assigned in vsym as initialized. *)
lst := ComponentCreateFieldList (rhs) ;
- IF PutVarFieldInitialized (vsym, RightValue, lst)
+ IF PutVarFieldInitialized (content, RightValue, lst)
THEN
END ;
KillList (lst)
@@ -1140,9 +1145,11 @@ BEGIN
IncludeItemIntoList (ignoreList, lhs)
ELSE
CheckDeferredRecordAccess (procSym, rhstok, content, TRUE, warning, lst, i) ;
- (* SetVarInitialized (lhs, IsVarAParam (rhs)) -- was -- *)
- (* SetVarInitialized (lhs, FALSE) -- was -- *)
- SetVarInitialized (lhs, VarCheckReadInit (content, RightValue), lhstok)
+ SetVarInitialized (lhs, VarCheckReadInit (content, RightValue), lhstok) ;
+ IF IsReallyPointer (content)
+ THEN
+ SetupLAlias (lhs, content)
+ END
END
END CheckIndrX ;
@@ -1527,34 +1534,36 @@ END DumpBBSequence ;
PROCEDURE trashParam (trashQuad: CARDINAL) ;
VAR
- op : QuadOperator ;
- op1, op2, op3 : CARDINAL ;
- op1tok, op2tok, op3tok, qtok: CARDINAL ;
- overflowChecking : BOOLEAN ;
- heapSym, ptr : CARDINAL ;
+ op : QuadOperator ;
+ op1, proc, param, paramValue : CARDINAL ;
+ op1tok, op2tok, paramtok, qtok: CARDINAL ;
+ overflowChecking : BOOLEAN ;
+ heapValue, ptrToHeap : CARDINAL ;
BEGIN
IF trashQuad # 0
THEN
- GetQuadOtok (trashQuad, qtok, op, op1, op2, op3, overflowChecking,
- op1tok, op2tok, op3tok) ;
- heapSym := GetQuadTrash (trashQuad) ;
+ GetQuadOtok (trashQuad, qtok, op, op1, proc, param, overflowChecking,
+ op1tok, op2tok, paramtok) ;
+ heapValue := GetQuadTrash (trashQuad) ;
IF Debugging
THEN
- printf1 ("heapSym = %d\n", heapSym)
+ printf1 ("heapValue = %d\n", heapValue)
END ;
- IF heapSym # NulSym
+ IF heapValue # NulSym
THEN
- SetVarInitialized (op3, FALSE, op3tok) ;
- ptr := getContent (getLAlias (op3), op3, op3tok) ;
- IF ptr # NulSym
+ SetVarInitialized (param, FALSE, paramtok) ;
+ paramValue := getLAlias (param) ;
+ ptrToHeap := getContent (paramValue, param, paramtok) ;
+ IF ptrToHeap # NulSym
THEN
- IF IsDeallocate (op2)
+ IF IsDeallocate (proc)
THEN
- SetupLAlias (ptr, Nil)
+ SetupLAlias (ptrToHeap, Nil) ;
+ SetVarInitialized (ptrToHeap, FALSE, paramtok)
ELSE
- SetupIndr (ptr, heapSym)
- END ;
- SetVarInitialized (ptr, FALSE, op3tok)
+ SetupIndr (ptrToHeap, heapValue) ;
+ SetVarInitialized (ptrToHeap, TRUE, paramtok)
+ END
END
END
END ;
@@ -1563,18 +1572,33 @@ END trashParam ;
(*
- SetVarLRInitialized -
+ SetVarLRInitialized - this sets up an alias between the parameter
+ value and the pointer for the case:
+
+ procedure foo (var shadow: PtrToType) ;
+
+ which allows shadow to be statically analyzed
+ once it is re-assigned.
*)
PROCEDURE SetVarLRInitialized (param: CARDINAL) ;
VAR
- sym: CARDINAL ;
+ heap,
+ shadow: CARDINAL ;
BEGIN
Assert (IsParameter (param)) ;
- sym := GetParameterShadowVar (param) ;
- IF sym # NulSym
+ shadow := GetParameterShadowVar (param) ;
+ IF shadow # NulSym
+ THEN
+ IncludeItemIntoList (ignoreList, shadow)
+ END ;
+ heap := GetParameterHeapVar (param) ;
+ IF (shadow # NulSym) AND (heap # NulSym)
THEN
- IncludeItemIntoList (ignoreList, sym)
+ PutVarInitialized (shadow, GetMode (shadow)) ;
+ PutVarInitialized (heap, GetMode (heap)) ;
+ SetupIndr (shadow, heap) ;
+ IncludeItemIntoList (ignoreList, heap)
END
END SetVarLRInitialized ;
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod
index 98a51ea2ca1..71f6b1c82c6 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -109,6 +109,7 @@ FROM SymbolTable IMPORT NulSym,
ParametersDefinedInImplementation,
ProcedureParametersDefined,
PutProcedureNoReturn,
+ PutProcedureParameterHeapVars,
CheckForUnImplementedExports,
CheckForUndeclaredExports,
IsHiddenTypeDeclared,
@@ -1377,6 +1378,7 @@ BEGIN
THEN
WriteFormat2('end procedure name does not match beginning %a name %a', NameStart, NameEnd)
END ;
+ PutProcedureParameterHeapVars (ProcSym) ;
EndScope ;
M2Error.LeaveErrorScope
END EndBuildProcedure ;
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index 2cfa0d49ac9..9579a42ca0a 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -362,7 +362,8 @@ EXPORT QUALIFIED NulSym,
DebugLineNumbers,
VarCheckReadInit, VarInitState, PutVarInitialized,
PutVarFieldInitialized, GetVarFieldInitialized,
- PrintInitialized ;
+ PrintInitialized,
+ GetParameterHeapVar, PutProcedureParameterHeapVars ;
(*
@@ -3648,4 +3649,19 @@ PROCEDURE GetVarFieldInitialized (sym: CARDINAL; mode: ModeOfAddr;
PROCEDURE PrintInitialized (sym: CARDINAL) ;
+(*
+ GetParameterHeapVar - return the heap variable associated with the
+ parameter or NulSym.
+*)
+
+PROCEDURE GetParameterHeapVar (ParSym: CARDINAL) : CARDINAL ;
+
+
+(*
+ PutProcedureParameterHeapVars - creates heap variables for parameter sym.
+*)
+
+PROCEDURE PutProcedureParameterHeapVars (sym: CARDINAL) ;
+
+
END SymbolTable.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index b5149a831f2..64dfddecd8c 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -435,7 +435,7 @@ TYPE
name : Name ; (* Index into name array, name *)
(* of param. *)
Type : CARDINAL ; (* Index to the type of param. *)
- IsUnbounded : BOOLEAN ; (* ARRAY OF Type? *)
+ IsUnbounded : BOOLEAN ; (* Is it an ARRAY OF Type? *)
ShadowVar : CARDINAL ; (* The local variable used to *)
(* shadow this parameter. *)
At : Where ; (* Where was sym declared/used *)
@@ -445,7 +445,10 @@ TYPE
name : Name ; (* Index into name array, name *)
(* of param. *)
Type : CARDINAL ;(* Index to the type of param. *)
- IsUnbounded : BOOLEAN ; (* ARRAY OF Type? *)
+ IsUnbounded : BOOLEAN ; (* Is it an ARRAY OF Type? *)
+ HeapVar : CARDINAL ;(* The pointer value on heap. *)
+ (* Only used by static *)
+ (* analysis. *)
ShadowVar : CARDINAL ;(* The local variable used to *)
(* shadow this parameter. *)
At : Where ; (* Where was sym declared/used *)
@@ -10196,6 +10199,7 @@ BEGIN
Type := ParamType ;
IsUnbounded := isUnbounded ;
ShadowVar := NulSym ;
+ HeapVar := NulSym ; (* Will contain a pointer value. *)
InitWhereDeclaredTok(tok, At)
END
END ;
@@ -10558,6 +10562,83 @@ BEGIN
END GetOptArgInit ;
+(*
+ MakeParameterHeapVar - create a heap variable if sym is a pointer.
+*)
+
+PROCEDURE MakeParameterHeapVar (tok: CARDINAL; type: CARDINAL; mode: ModeOfAddr) : CARDINAL ;
+VAR
+ heapvar: CARDINAL ;
+BEGIN
+ heapvar := NulSym ;
+ type := SkipType (type) ;
+ IF IsPointer (type)
+ THEN
+ heapvar := MakeTemporary (tok, mode) ;
+ PutVar (heapvar, type) ;
+ PutVarHeap (heapvar, TRUE)
+ END ;
+ RETURN heapvar
+END MakeParameterHeapVar ;
+
+
+(*
+ GetParameterHeapVar - return the heap variable associated with the
+ parameter or NulSym.
+*)
+
+PROCEDURE GetParameterHeapVar (ParSym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (ParSym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ParamSym : RETURN NulSym | (* Only VarParam has the pointer. *)
+ VarParamSym: RETURN VarParam.HeapVar
+
+ ELSE
+ InternalError ('expecting Param or VarParam symbol')
+ END
+ END
+END GetParameterHeapVar ;
+
+
+(*
+ PutParameterHeapVar - creates a heap variable associated with parameter sym.
+*)
+
+PROCEDURE PutParameterHeapVar (sym: CARDINAL) ;
+VAR
+ pSym : PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ParamSym : | (* Nothing to do for the non var parameter. *)
+ VarParamSym: VarParam.HeapVar := MakeParameterHeapVar (GetDeclaredMod (sym),
+ VarParam.Type, LeftValue)
+
+ ELSE
+ InternalError ('Param or VarParam symbol expected')
+ END
+ END
+END PutParameterHeapVar ;
+
+
+(*
+ PutProcedureParameterHeapVars - creates heap variables for parameter sym.
+*)
+
+PROCEDURE PutProcedureParameterHeapVars (sym: CARDINAL) ;
+BEGIN
+ Assert (IsProcedure (sym)) ;
+ ForeachParamSymDo (sym, PutParameterHeapVar)
+END PutProcedureParameterHeapVars ;
+
+
(*
NoOfVariables - returns the number of variables in scope. The scope maybe
a procedure, module or defimp scope.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testdispose3.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testdispose3.mod
new file mode 100644
index 00000000000..54633446ba9
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testdispose3.mod
@@ -0,0 +1,24 @@
+MODULE testdispose3 ;
+
+FROM Storage IMPORT DEALLOCATE ;
+
+TYPE
+ PtrToVec = POINTER TO RECORD
+ x, y: INTEGER ;
+ END ;
+
+
+PROCEDURE test (VAR ptr: PtrToVec) ;
+BEGIN
+ DISPOSE (ptr) ;
+ IF ptr^.x = 1
+ THEN
+ END
+END test ;
+
+
+VAR
+ p: PtrToVec ;
+BEGIN
+ test (p)
+END testdispose3.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testdispose4.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testdispose4.mod
new file mode 100644
index 00000000000..c0b36d6bd1c
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testdispose4.mod
@@ -0,0 +1,22 @@
+MODULE testdispose4 ;
+
+FROM Storage IMPORT DEALLOCATE ;
+
+TYPE
+ PtrToCard = POINTER TO CARDINAL ;
+
+
+PROCEDURE test (VAR ptr: PtrToCard) ;
+BEGIN
+ DISPOSE (ptr) ;
+ IF ptr^ = 1
+ THEN
+ END
+END test ;
+
+
+VAR
+ p: PtrToCard ;
+BEGIN
+ test (p)
+END testdispose4.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testdispose3.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testdispose3.mod
new file mode 100644
index 00000000000..f826457a3c0
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testdispose3.mod
@@ -0,0 +1,23 @@
+MODULE testdispose3 ;
+
+FROM Storage IMPORT DEALLOCATE ;
+
+TYPE
+ PtrToVec = POINTER TO RECORD
+ x, y: INTEGER ;
+ END ;
+
+
+PROCEDURE test (VAR ptr: PtrToVec) ;
+BEGIN
+ IF ptr^.x = 1
+ THEN
+ END
+END test ;
+
+
+VAR
+ p: PtrToVec ;
+BEGIN
+ test (p)
+END testdispose3.
diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testdispose4.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testdispose4.mod
new file mode 100644
index 00000000000..70bc3f51bae
--- /dev/null
+++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testdispose4.mod
@@ -0,0 +1,22 @@
+MODULE testdispose4 ;
+
+FROM Storage IMPORT ALLOCATE ;
+
+TYPE
+ PtrToCard = POINTER TO CARDINAL ;
+
+
+PROCEDURE test (VAR ptr: PtrToCard) ;
+BEGIN
+ IF ptr^ = 1
+ THEN
+ END
+END test ;
+
+
+VAR
+ p: PtrToCard ;
+BEGIN
+ NEW (p) ;
+ test (p)
+END testdispose4.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-07-30 19:10 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-07-30 19:10 [gcc r13-7657] modula2: Implement limited VAR parameter static analysis 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).