From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1499) id 522E43858D39; Sun, 30 Jul 2023 10:01:11 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 522E43858D39 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1690711271; bh=CbfNZFnzXaHguBWovkpz8H7uw+Uqin0vfEfWv6Y5DEY=; h=From:To:Subject:Date:From; b=fmwpIP8F8NEk1tX7dYp3glDfyy+rNuKjeOH3TO034U9GbnUzFNn38TI71NO5aVPs3 mJ3m2q6CyKaQ34b5o/17vogznI4TqYYasP85etRqw0ZA2TsNUm02v4DPTPwe4XOD77 i0NqJJExRnZjnwTT8zEGDmL5bieHV41wWBkXWSZ4= MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Content-Type: text/plain; charset="utf-8" From: Gaius Mulley To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-7652] modula2: Uninitialized variable static analysis improvements X-Act-Checkin: gcc X-Git-Author: Gaius Mulley X-Git-Refname: refs/heads/releases/gcc-13 X-Git-Oldrev: 824a37d0bfa9f5c232bb1c929c63a2d498263d27 X-Git-Newrev: d8a0dcd146dd95e2b6b85cf82c445214d364cf3b Message-Id: <20230730100111.522E43858D39@sourceware.org> Date: Sun, 30 Jul 2023 10:01:11 +0000 (GMT) List-Id: https://gcc.gnu.org/g:d8a0dcd146dd95e2b6b85cf82c445214d364cf3b commit r13-7652-gd8a0dcd146dd95e2b6b85cf82c445214d364cf3b Author: Gaius Mulley Date: Sun Jul 30 11:00:24 2023 +0100 modula2: Uninitialized variable static analysis improvements This patch fixes many limitations of the uninitialized static analysis. NEW is understood, local variable pointers and non var parameters will be tracked. gcc/ChangeLog: * doc/gm2.texi (Semantic checking): Change example testwithptr to testnew6. gcc/m2/ChangeLog: * Make-lang.in: Minor formatting change. * gm2-compiler/M2GCCDeclare.mod (DeclareUnboundedProcedureParameters): Rename local variables. (WalkUnboundedProcedureParameters): Rename local variables. (DoVariableDeclaration): Avoid declaration of a variable if it is on the heap (used by static analysis only). * gm2-compiler/M2GenGCC.mod: Formatting. * gm2-compiler/M2Quads.def (GetQuadTrash): New procedure function. * gm2-compiler/M2Quads.mod (GetQuadTrash): New procedure function. (QuadFrame): Add Trash field. (BuildRealFuncProcCall): Detect ALLOCATE and DEALLOCATE and create a heap variable for parameter 1 saving it as the trashed variable for static analysis. (GenQuadOTrash): New procedure. (DisplayQuadRange): Bugfix. Write the scope number. * gm2-compiler/M2SymInit.mod: Rewritten to separate LValue equivalence from LValue to RValue pairings. Comprehensive detection of variant record implemented. Allow dereferencing of pointers through LValue/RValue chains. * gm2-compiler/SymbolTable.def (PutVarHeap): New procedure. (IsVarHeap): New procedure function. (ForeachParamSymDo): New procedure. * gm2-compiler/SymbolTable.mod (PutVarHeap): New procedure. (IsVarHeap): New procedure function. (ForeachParamSymDo): New procedure. (MakeVariableForParam): Reformatted. (CheckForUnknownInModule): Reformatted. (SymVar): Add field Heap. (MakeVar): Assign Heap to FALSE. gcc/testsuite/ChangeLog: * gm2/switches/uninit-variable-checking/pass/assignparam.mod: New test. * gm2/switches/uninit-variable-checking/pass/tiny.mod: New test. * gm2/switches/uninit-variable-checking/procedures/fail/switches-uninit-variable-checking-procedures-fail.exp: New test. * gm2/switches/uninit-variable-checking/procedures/fail/testnew.mod: New test. * gm2/switches/uninit-variable-checking/procedures/fail/testnew2.mod: New test. * gm2/switches/uninit-variable-checking/procedures/fail/testnew3.mod: New test. * gm2/switches/uninit-variable-checking/procedures/fail/testnew4.mod: New test. * gm2/switches/uninit-variable-checking/procedures/fail/testnew5.mod: New test. * gm2/switches/uninit-variable-checking/procedures/fail/testnew6.mod: New test. * gm2/switches/uninit-variable-checking/procedures/fail/testptrptr.mod: New test. * gm2/switches/uninit-variable-checking/procedures/pass/assignparam2.mod: New test. * gm2/switches/uninit-variable-checking/procedures/pass/switches-uninit-variable-checking-procedures-pass.exp: New test. * gm2/switches/uninit-variable-checking/procedures/pass/testnew5.mod: New test. * gm2/switches/uninit-variable-checking/procedures/pass/testnew6.mod: New test. * gm2/switches/uninit-variable-checking/procedures/pass/testparamlvalue.mod: New test. * gm2/switches/uninit-variable-checking/procedures/pass/testparamrvalue.mod: New test. * gm2/switches/uninit-variable-checking/procedures/pass/testproc.mod: New test. * gm2/switches/uninit-variable-checking/procedures/pass/testptrptr.mod: New test. (cherry picked from commit b80e3c468e373cc6fd4e41a5879dbca95a40ac8c) Signed-off-by: Gaius Mulley Diff: --- gcc/doc/gm2.texi | 25 +- gcc/m2/Make-lang.in | 3 +- gcc/m2/gm2-compiler/M2GCCDeclare.mod | 44 +- gcc/m2/gm2-compiler/M2GenGCC.mod | 4 +- gcc/m2/gm2-compiler/M2Quads.def | 10 +- gcc/m2/gm2-compiler/M2Quads.mod | 70 ++- gcc/m2/gm2-compiler/M2SymInit.mod | 520 ++++++++++++++++----- gcc/m2/gm2-compiler/SymbolTable.def | 25 + gcc/m2/gm2-compiler/SymbolTable.mod | 87 +++- .../uninit-variable-checking/pass/assignparam.mod | 31 ++ .../uninit-variable-checking/pass/tiny.mod | 13 + ...es-uninit-variable-checking-procedures-fail.exp | 37 ++ .../procedures/fail/testnew.mod | 31 ++ .../procedures/fail/testnew2.mod | 31 ++ .../procedures/fail/testnew3.mod | 34 ++ .../procedures/fail/testnew4.mod | 34 ++ .../procedures/fail/testnew5.mod | 31 ++ .../procedures/fail/testnew6.mod | 27 ++ .../procedures/fail/testptrptr.mod | 32 ++ .../procedures/pass/assignparam2.mod | 31 ++ ...es-uninit-variable-checking-procedures-pass.exp | 37 ++ .../procedures/pass/testnew5.mod | 27 ++ .../procedures/pass/testnew6.mod | 27 ++ .../procedures/pass/testparamlvalue.mod | 26 ++ .../procedures/pass/testparamrvalue.mod | 26 ++ .../procedures/pass/testproc.mod | 15 + .../procedures/pass/testptrptr.mod | 29 ++ 27 files changed, 1140 insertions(+), 167 deletions(-) diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi index 8d5d95f9fc7..9f7f8ce6e99 100644 --- a/gcc/doc/gm2.texi +++ b/gcc/doc/gm2.texi @@ -1471,7 +1471,7 @@ 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. +not an array or set or a variant record or var parameter. The following example detects whether a sub component within a record is uninitialized. @@ -1551,22 +1551,20 @@ access expression before it has been initialized @end example @example -MODULE testwithptr ; +MODULE testnew6 ; -FROM SYSTEM IMPORT ADR ; +FROM Storage IMPORT ALLOCATE ; TYPE - PtrToVec = POINTER TO Vec ; - Vec = RECORD - x, y: CARDINAL ; - END ; + PtrToVec = POINTER TO RECORD + x, y: INTEGER ; + END ; PROCEDURE test ; VAR p: PtrToVec ; - v: Vec ; BEGIN - p := ADR (v) ; + NEW (p) ; WITH p^ DO x := 1 ; x := 2 (* Deliberate typo, user meant y. *) @@ -1576,16 +1574,17 @@ BEGIN END END test ; + BEGIN test -END testwithptr. +END testnew6. @end example @example -gm2 -c -Wuninit-variable-checking testwithptr.mod -testwithptr.mod:26:9: warning: In procedure ‘test’: attempting to +$ gm2 -g -c -Wuninit-variable-checking testnew6.mod +testnew6.mod:19:9: warning: In procedure ‘test’: attempting to access expression before it has been initialized - 26 | IF p^.y = 2 + 19 | IF p^.y = 2 | ~~^~ @end example diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in index 8b2c022c7f3..56af973e6f1 100644 --- a/gcc/m2/Make-lang.in +++ b/gcc/m2/Make-lang.in @@ -462,7 +462,8 @@ GM2_G=-g -fm2-g GM2_CPP= # GM2_DEBUG_STRMEM=-fcpp GM2_DEBUG_STRMEM= -GM2_FLAGS=-Wunused-variable -Wuninit-variable-checking -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 \ diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod index eaa3255f623..92de4b4b2e6 100644 --- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod +++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod @@ -95,7 +95,7 @@ FROM SymbolTable IMPORT NulSym, IsProcedureReachable, IsParameter, IsConstLit, IsDummy, IsVarAParam, IsProcedureVariable, IsGnuAsm, IsGnuAsmVolatile, IsObject, IsTuple, - IsError, IsHiddenType, + IsError, IsHiddenType, IsVarHeap, IsComponent, IsPublic, IsExtern, IsCtor, GetMainModule, GetBaseModule, GetModule, GetLocalSym, PutModuleFinallyFunction, @@ -2118,7 +2118,8 @@ END WalkTypeInfo ; PROCEDURE DeclareUnboundedProcedureParameters (sym: WORD) ; VAR - son, type, + param, + type, p, i : CARDINAL ; location : location_t ; BEGIN @@ -2129,8 +2130,8 @@ BEGIN WHILE i>0 DO IF IsUnboundedParam(sym, i) THEN - son := GetNthParam(sym, i) ; - type := GetSType(son) ; + param := GetNthParam(sym, i) ; + type := GetSType(param) ; TraverseDependants(type) ; IF GccKnowsAbout(type) THEN @@ -2138,8 +2139,8 @@ BEGIN BuildTypeDeclaration(location, Mod2Gcc(type)) END ELSE - son := GetNth(sym, i) ; - type := GetSType(son) ; + param := GetNth(sym, i) ; + type := GetSType(param) ; TraverseDependants(type) END ; DEC(i) @@ -2154,31 +2155,24 @@ END DeclareUnboundedProcedureParameters ; PROCEDURE WalkUnboundedProcedureParameters (sym: WORD) ; VAR - son, + param, type, p, i: CARDINAL ; BEGIN - IF IsProcedure(sym) + IF IsProcedure (sym) THEN - p := NoOfParam(sym) ; + p := NoOfParam (sym) ; i := p ; WHILE i>0 DO - IF IsUnboundedParam(sym, i) + IF IsUnboundedParam (sym, i) THEN - son := GetNthParam(sym, i) ; - type := GetSType(son) ; - WalkTypeInfo(type) ; -(* - type := GetUnboundedRecordType(type) ; - Assert(IsRecord(type)) ; - RecordNotPacked(type) (* which is never packed. *) -*) + param := GetNthParam (sym, i) ELSE - son := GetNth(sym, i) ; - type := GetSType(son) ; - WalkTypeInfo(type) + param := GetNth (sym, i) END ; - DEC(i) + type := GetSType (param) ; + WalkTypeInfo (type) ; + DEC (i) END END END WalkUnboundedProcedureParameters ; @@ -3173,7 +3167,7 @@ VAR varType : CARDINAL ; location: location_t ; BEGIN - IF IsComponent (var) + IF IsComponent (var) OR IsVarHeap (var) THEN RETURN END ; @@ -3909,6 +3903,10 @@ BEGIN THEN printf0('component ') END ; + IF IsVarHeap (sym) + THEN + printf0('heap ') + END ; printf0 ('\n') ; PrintInitialized (sym) ; IncludeType(l, sym) diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod index 0955106dbb6..d701543df76 100644 --- a/gcc/m2/gm2-compiler/M2GenGCC.mod +++ b/gcc/m2/gm2-compiler/M2GenGCC.mod @@ -1362,7 +1362,9 @@ BEGIN (* now assign param.Addr := ADR(NewArray) *) BuildAssignmentStatement (location, - BuildComponentRef (location, Mod2Gcc (param), Mod2Gcc (GetUnboundedAddressOffset (UnboundedType))), + BuildComponentRef (location, + Mod2Gcc (param), + Mod2Gcc (GetUnboundedAddressOffset (UnboundedType))), NewArray) END MakeCopyUse ; diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def index cd011baf549..3a4059513cd 100644 --- a/gcc/m2/gm2-compiler/M2Quads.def +++ b/gcc/m2/gm2-compiler/M2Quads.def @@ -145,7 +145,8 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile, IsAutoPushOn, PushAutoOn, PushAutoOff, PopAuto, PushInConstExpression, PopInConstExpression, IsInConstExpression, - MustCheckOverflow, BuildAsmElement, BuildAsmTrash ; + MustCheckOverflow, BuildAsmElement, BuildAsmTrash, + GetQuadTrash ; TYPE @@ -2771,4 +2772,11 @@ PROCEDURE BuildAsmElement (input, output: BOOLEAN) ; PROCEDURE BuildAsmTrash ; +(* + GetQuadTrash - return the symbol associated with the trashed operand. +*) + +PROCEDURE GetQuadTrash (quad: CARDINAL) : CARDINAL ; + + END M2Quads. diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 5ed22528763..db5513d6787 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -85,6 +85,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown, PutPriority, GetPriority, PutProcedureBegin, PutProcedureEnd, PutVarConst, IsVarConst, + PutVarHeap, IsVarParam, IsProcedure, IsPointer, IsParameter, IsUnboundedParam, IsEnumeration, IsDefinitionForC, IsVarAParam, IsVarient, IsLegal, @@ -290,6 +291,7 @@ TYPE Operand1 : CARDINAL ; Operand2 : CARDINAL ; Operand3 : CARDINAL ; + Trash : CARDINAL ; Next : CARDINAL ; (* Next quadruple. *) LineNo : CARDINAL ; (* Line No of source text. *) TokenNo : CARDINAL ; (* Token No of source text. *) @@ -1481,6 +1483,7 @@ BEGIN Operand1 := 0 ; Operand2 := 0 ; Operand3 := 0 ; + Trash := 0 ; op1pos := UnknownTokenNo ; op2pos := UnknownTokenNo ; op3pos := UnknownTokenNo @@ -5174,17 +5177,24 @@ END BuildRealProcedureCall ; PROCEDURE BuildRealFuncProcCall (tokno: CARDINAL; IsFunc, IsForC: BOOLEAN) ; VAR + AllocateProc, + DeallocateProc, ForcedFunc, ParamConstant : BOOLEAN ; + trash, resulttok, paramtok, proctok, NoOfParameters, i, pi, + ParamType, + Param1, (* Used to remember first param for allocate/deallocate. *) ReturnVar, ProcSym, Proc : CARDINAL ; BEGIN + Param1 := NulSym ; + ParamType := NulSym ; CheckProcedureParameters (IsForC) ; PopT (NoOfParameters) ; PushT (NoOfParameters) ; (* Restore stack to original state. *) @@ -5197,6 +5207,8 @@ BEGIN paramtok := proctok ; ProcSym := SkipConst (ProcSym) ; ForcedFunc := FALSE ; + AllocateProc := FALSE ; + DeallocateProc := FALSE ; IF IsVar (ProcSym) THEN (* Procedure Variable ? *) @@ -5204,7 +5216,9 @@ BEGIN ParamConstant := FALSE ELSE Proc := ProcSym ; - ParamConstant := IsProcedureBuiltin (Proc) + ParamConstant := IsProcedureBuiltin (Proc) ; + AllocateProc := GetSymName (Proc) = MakeKey('ALLOCATE') ; + DeallocateProc := GetSymName (Proc) = MakeKey('DEALLOCATE') END ; IF IsFunc THEN @@ -5229,6 +5243,10 @@ BEGIN ForcedFunc := TRUE END END ; + IF AllocateProc OR DeallocateProc + THEN + Param1 := OperandT (NoOfParameters+1) (* Remember this before manipulating. *) + END ; ManipulateParameters (IsForC) ; CheckParameterOrdinals ; PopT(NoOfParameters) ; @@ -5244,7 +5262,21 @@ BEGIN pi := 1 ; (* stack index referencing stacked parameter, i *) WHILE i>0 DO paramtok := OperandTtok (pi) ; - GenQuadO (paramtok, ParamOp, i, Proc, OperandT (pi), TRUE) ; + IF (AllocateProc OR DeallocateProc) AND (i = 1) AND (Param1 # NulSym) + THEN + ParamType := GetItemPointedTo (Param1) ; + IF ParamType = NulSym + THEN + GenQuadO (paramtok, ParamOp, i, Proc, OperandT (pi), TRUE) + ELSE + trash := MakeTemporary (paramtok, RightValue) ; + PutVar (trash, ParamType) ; + PutVarHeap (trash, TRUE) ; + GenQuadOTrash (paramtok, ParamOp, i, Proc, OperandT (pi), TRUE, trash) + END + ELSE + GenQuadO (paramtok, ParamOp, i, Proc, OperandT (pi), TRUE) + END ; IF NOT IsConst (OperandT (pi)) THEN ParamConstant := FALSE @@ -6787,7 +6819,7 @@ BEGIN THEN RETURN GetItemPointedTo (GetSType (Sym)) ELSE - InternalError ('expecting a pointer or variable symbol') + RETURN NulSym END END GetItemPointedTo ; @@ -13079,6 +13111,19 @@ END MakeOp ; PROCEDURE GenQuadO (TokPos: CARDINAL; Operation: QuadOperator; Op1, Op2, Op3: CARDINAL; overflow: BOOLEAN) ; +BEGIN + GenQuadOTrash (TokPos, Operation, Op1, Op2, Op3, overflow, NulSym) +END GenQuadO ; + + +(* + GenQuadOTrash - generate a quadruple with Operation, Op1, Op2, Op3, overflow. +*) + +PROCEDURE GenQuadOTrash (TokPos: CARDINAL; + Operation: QuadOperator; + Op1, Op2, Op3: CARDINAL; + overflow: BOOLEAN; trash: CARDINAL) ; VAR f: QuadFrame ; BEGIN @@ -13093,6 +13138,7 @@ BEGIN PutQuadO (NextQuad, Operation, Op1, Op2, Op3, overflow) ; f := GetQF (NextQuad) ; WITH f^ DO + Trash := trash ; Next := 0 ; LineNo := GetLineNo () ; IF TokPos = UnknownTokenNo @@ -13109,7 +13155,21 @@ BEGIN (* DisplayQuad(NextQuad) ; *) NewQuad (NextQuad) END -END GenQuadO ; +END GenQuadOTrash ; + + +(* + GetQuadTrash - return the symbol associated with the trashed operand. +*) + +PROCEDURE GetQuadTrash (quad: CARDINAL) : CARDINAL ; +VAR + f: QuadFrame ; +BEGIN + f := GetQF (quad) ; + LastQuadNo := quad ; + RETURN f^.Trash +END GetQuadTrash ; (* @@ -13194,7 +13254,7 @@ PROCEDURE DisplayQuadRange (scope: CARDINAL; start, end: CARDINAL) ; VAR f: QuadFrame ; BEGIN - printf0 ('Quadruples for scope: ') ; WriteOperand (scope) ; printf0 ('\n') ; + printf1 ('Quadruples for scope: %d\n', scope) ; WHILE (start <= end) AND (start # 0) DO DisplayQuad (start) ; f := GetQF (start) ; diff --git a/gcc/m2/gm2-compiler/M2SymInit.mod b/gcc/m2/gm2-compiler/M2SymInit.mod index a5457ecbebd..f617c40d1d0 100644 --- a/gcc/m2/gm2-compiler/M2SymInit.mod +++ b/gcc/m2/gm2-compiler/M2SymInit.mod @@ -25,7 +25,7 @@ FROM Storage IMPORT ALLOCATE, DEALLOCATE ; FROM M2Debug IMPORT Assert ; FROM M2Printf IMPORT printf0, printf1, printf2, printf3, printf4 ; FROM libc IMPORT printf ; -FROM NameKey IMPORT Name, NulName, KeyToCharStar ; +FROM NameKey IMPORT Name, NulName, KeyToCharStar, MakeKey ; FROM M2Options IMPORT UninitVariableChecking, UninitVariableConditionalChecking, CompilerDebugging ; @@ -41,6 +41,7 @@ FROM M2BasicBlock IMPORT BasicBlock, ForeachBasicBlockDo ; IMPORT Indexing ; +FROM Indexing IMPORT Index ; FROM Lists IMPORT List, InitList, GetItemFromList, PutItemIntoList, IsItemInList, IncludeItemIntoList, NoOfItemsInList, @@ -52,15 +53,19 @@ FROM SymbolTable IMPORT NulSym, ModeOfAddr, IsVar, IsRecord, GetSType, VarCheckReadInit, VarInitState, PutVarInitialized, PutVarFieldInitialized, GetVarFieldInitialized, IsConst, IsConstString, NoOfParam, IsVarParam, - ForeachLocalSymDo, IsTemporary, ModeOfAddr, + ForeachLocalSymDo, ForeachParamSymDo, + IsTemporary, ModeOfAddr, IsReallyPointer, IsUnbounded, IsVarient, IsFieldVarient, GetVarient, - IsVarArrayRef ; + IsVarArrayRef, GetSymName, + IsType, IsPointer, + GetParameterShadowVar, IsParameter, GetLType ; FROM M2Quads IMPORT QuadOperator, GetQuadOtok, GetQuad, GetNextQuad, IsNewLocalVar, IsReturn, IsKillLocalVar, IsConditional, IsUnConditional, IsBackReference, IsCall, IsGoto, - GetM2OperatorDesc, Opposite, DisplayQuadRange ; + GetM2OperatorDesc, Opposite, DisplayQuadRange, + GetQuadTrash ; FROM M2Printf IMPORT printf0, printf1, printf2 ; FROM M2GCCDeclare IMPORT PrintSym ; @@ -104,21 +109,24 @@ TYPE (* Does it end with a conditional? *) endCond, (* Does it form part of a loop? *) - topOfLoop: BOOLEAN ; + topOfLoop : BOOLEAN ; + trashQuad, indexBB, nextQuad, condQuad, nextBB, - condBB : CARDINAL ; - next : bbEntry ; + condBB : CARDINAL ; + next : bbEntry ; END ; VAR - aliasArray: Indexing.Index ; - freeList : symAlias ; - bbArray : Indexing.Index ; - bbFreeList: bbEntry ; - errorList : List ; (* Ensure that we only generate one set of warnings per token. *) + IndirectArray, + LArray : Indexing.Index ; + freeList : symAlias ; + bbArray : Indexing.Index ; + bbFreeList : bbEntry ; + ignoreList, + errorList : List ; (* Ensure that we only generate one set of warnings per token. *) (* @@ -418,10 +426,10 @@ END IsLocalVar ; RecordFieldContainsVarient - *) -PROCEDURE RecordFieldContainsVarient (sym: CARDINAL) : BOOLEAN ; +PROCEDURE RecordFieldContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ; BEGIN Assert (IsRecordField (sym)) ; - IF ContainsVariant (GetSType (sym)) + IF doContainsVariant (GetSType (sym), visited) THEN RETURN TRUE END ; @@ -430,37 +438,125 @@ END RecordFieldContainsVarient ; (* - ContainsVariant - returns TRUE if type sym contains a variant record. + RecordContainsVarient - *) -PROCEDURE ContainsVariant (sym: CARDINAL) : BOOLEAN ; +PROCEDURE RecordContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ; VAR i, fieldsym, fieldtype: CARDINAL ; BEGIN - IF IsRecord (sym) - THEN - i := 1 ; - REPEAT - fieldsym := GetNth (sym, i) ; - IF fieldsym # NulSym + Assert (IsRecord (sym)) ; + i := 1 ; + REPEAT + fieldsym := GetNth (sym, i) ; + IF fieldsym # NulSym + THEN + IF IsRecordField (fieldsym) THEN - IF IsRecordField (fieldsym) - THEN - IF RecordFieldContainsVarient (fieldsym) - THEN - RETURN TRUE - END - ELSIF IsVarient (fieldsym) + IF RecordFieldContainsVarient (fieldsym, visited) THEN RETURN TRUE - END ; - INC (i) - END - UNTIL fieldsym = NulSym + END + ELSIF IsVarient (fieldsym) + THEN + RETURN TRUE + END ; + INC (i) + END + UNTIL fieldsym = NulSym ; + RETURN FALSE +END RecordContainsVarient ; + + +(* + VarContainsVarient - +*) + +PROCEDURE VarContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ; +BEGIN + Assert (IsVar (sym)) ; + RETURN doContainsVariant (GetSType (sym), visited) +END VarContainsVarient ; + + +(* + TypeContainsVarient - +*) + +PROCEDURE TypeContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ; +BEGIN + Assert (IsType (sym)) ; + RETURN doContainsVariant (GetSType (sym), visited) +END TypeContainsVarient ; + + +(* + ArrayContainsVarient - +*) + +PROCEDURE ArrayContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ; +BEGIN + Assert (IsArray (sym)) ; + RETURN doContainsVariant (GetSType (sym), visited) +END ArrayContainsVarient ; + + +(* + PointerContainsVarient - +*) + +PROCEDURE PointerContainsVarient (sym: CARDINAL; visited: List) : BOOLEAN ; +BEGIN + Assert (IsPointer (sym)) ; + RETURN doContainsVariant (GetSType (sym), visited) +END PointerContainsVarient ; + + +(* + doContainsVariant - +*) + +PROCEDURE doContainsVariant (sym: CARDINAL; visited: List) : BOOLEAN ; +BEGIN + IF (sym # NulSym) AND (NOT IsItemInList (visited, sym)) + THEN + IncludeItemIntoList (visited, sym) ; + IF IsVar (sym) + THEN + RETURN VarContainsVarient (sym, visited) + ELSIF IsRecord (sym) + THEN + RETURN RecordContainsVarient (sym, visited) + ELSIF IsPointer (sym) + THEN + RETURN PointerContainsVarient (sym, visited) + ELSIF IsArray (sym) + THEN + RETURN ArrayContainsVarient (sym, visited) + ELSIF IsType (sym) + THEN + RETURN TypeContainsVarient (sym, visited) + END END ; RETURN FALSE +END doContainsVariant ; + + +(* + ContainsVariant - returns TRUE if type sym contains a variant record. +*) + +PROCEDURE ContainsVariant (sym: CARDINAL) : BOOLEAN ; +VAR + visited: List ; + result : BOOLEAN ; +BEGIN + InitList (visited) ; + result := doContainsVariant (sym, visited) ; + KillList (visited) ; + RETURN result END ContainsVariant ; @@ -656,9 +752,12 @@ END CheckDeferredRecordAccess ; PROCEDURE SetVarUninitialized (sym: CARDINAL) ; BEGIN - IF IsVar (sym) AND (NOT IsUnbounded (GetSType (sym))) AND (NOT IsVarAParam (sym)) + IF IsVar (sym) THEN - VarInitState (sym) + IF NOT IsUnbounded (GetSType (sym)) + THEN + VarInitState (sym) + END END END SetVarUninitialized ; @@ -667,19 +766,21 @@ END SetVarUninitialized ; ComponentFindVar - *) -PROCEDURE ComponentFindVar (sym: CARDINAL) : CARDINAL ; +PROCEDURE ComponentFindVar (sym: CARDINAL; VAR lvalue: BOOLEAN) : CARDINAL ; VAR nsym, i : CARDINAL ; BEGIN i := 1 ; REPEAT - nsym := getAlias (GetNth (sym, i)) ; + nsym := GetNth (sym, i) ; + lvalue := GetMode (nsym) = LeftValue ; + nsym := getLAlias (nsym) ; IF (nsym # NulSym) AND IsVar (nsym) THEN IF (nsym # sym) AND IsComponent (nsym) THEN - RETURN ComponentFindVar (nsym) + RETURN ComponentFindVar (nsym, lvalue) ELSE RETURN nsym END @@ -741,18 +842,35 @@ BEGIN END ComponentBuildFieldList ; +(* + deRefComponent - +*) + +PROCEDURE deRefComponent (component: CARDINAL; lvalue: BOOLEAN) : CARDINAL ; +BEGIN + IF lvalue + THEN + RETURN getContent (component) + ELSE + RETURN component + END +END deRefComponent ; + + (* SetVarComponentInitialized - *) PROCEDURE SetVarComponentInitialized (sym: CARDINAL) ; VAR + lvalue: BOOLEAN ; i, n, fsym, - vsym: CARDINAL ; - lst : List ; + vsym : CARDINAL ; + lst : List ; BEGIN - vsym := ComponentFindVar (sym) ; + vsym := ComponentFindVar (sym, lvalue) ; + vsym := deRefComponent (vsym, lvalue) ; IF vsym # NulSym THEN IF Debugging @@ -795,26 +913,34 @@ END SetVarComponentInitialized ; PROCEDURE GetVarComponentInitialized (sym: CARDINAL) : BOOLEAN ; VAR - init: BOOLEAN ; - vsym: CARDINAL ; - lst : List ; -BEGIN - init := FALSE ; - vsym := ComponentFindVar (sym) ; - IF vsym # NulSym + lvalue, + init : BOOLEAN ; + component, + vsym : CARDINAL ; + lst : List ; +BEGIN + component := ComponentFindVar (sym, lvalue) ; + IF IsItemInList (ignoreList, component) OR IsExempt (component) THEN - IF IsExempt (vsym) + RETURN TRUE + ELSE + init := FALSE ; + vsym := deRefComponent (component, lvalue) ; + IF vsym # NulSym 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 + 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 END GetVarComponentInitialized ; @@ -841,6 +967,7 @@ PROCEDURE SetVarInitialized (sym: CARDINAL; canDereference: BOOLEAN) ; BEGIN IF IsVar (sym) THEN + RemoveItemFromList (ignoreList, sym) ; IF IsComponent (sym) THEN Trace ("SetVarInitialized sym %d is a component and calling SetVarComponentInitialized", sym); @@ -913,10 +1040,12 @@ END GetVarInitialized ; PROCEDURE IsExempt (sym: CARDINAL) : BOOLEAN ; BEGIN RETURN (sym # NulSym) AND IsVar (sym) AND - (IsGlobalVar (sym) OR IsVarAParam (sym) OR - ContainsVariant (GetSType (sym)) OR + (IsGlobalVar (sym) 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)) + IsUnbounded (GetSType (sym)) OR IsVarArrayRef (sym) OR + IsItemInList (ignoreList, sym)) END IsExempt ; @@ -964,8 +1093,8 @@ 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 := getAlias (lhs) ; - IF (vsym # lhs) AND (GetSType (vsym) = type) + vsym := getContent (getLAlias (lhs)) ; + IF (vsym # NulSym) AND (vsym # lhs) AND (GetSType (vsym) = type) THEN IF IsRecord (type) THEN @@ -990,10 +1119,20 @@ END CheckXIndr ; PROCEDURE CheckIndrX (procSym, lhstok, lhs, type, rhstok, rhs: CARDINAL; warning: BOOLEAN; lst: List; i: CARDINAL) ; +VAR + content: CARDINAL ; BEGIN CheckDeferredRecordAccess (procSym, rhstok, rhs, FALSE, warning, lst, i) ; - CheckDeferredRecordAccess (procSym, rhstok, rhs, TRUE, warning, lst, i) ; - SetVarInitialized (lhs, IsVarAParam (rhs)) + content := getContent (getLAlias (rhs)) ; + IF content = NulSym + THEN + 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)) + END END CheckIndrX ; @@ -1014,22 +1153,27 @@ END CheckRecordField ; PROCEDURE CheckBecomes (procSym, destok, des, exprtok, expr: CARDINAL; warning: BOOLEAN; bblst: List; i: CARDINAL) ; VAR - lst : List ; - vsym: CARDINAL ; + lvalue: BOOLEAN ; + lst : List ; + vsym : CARDINAL ; BEGIN CheckDeferredRecordAccess (procSym, exprtok, expr, FALSE, warning, bblst, i) ; - SetupAlias (des, expr) ; + SetupLAlias (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) + vsym := ComponentFindVar (des, lvalue) ; + vsym := deRefComponent (vsym, lvalue) ; + IF vsym # NulSym THEN - END ; - KillList (lst) + (* Set only the field assigned in vsym as initialized. *) + lst := ComponentCreateFieldList (des) ; + IF PutVarFieldInitialized (vsym, RightValue, lst) + THEN + END ; + KillList (lst) + END END END CheckBecomes ; @@ -1050,10 +1194,10 @@ END CheckComparison ; CheckAddr - *) -PROCEDURE CheckAddr (procSym, op1tok, op1, op3tok, op3: CARDINAL) ; +PROCEDURE CheckAddr (procSym, ptrtok, ptr, contenttok, content: CARDINAL) ; BEGIN - SetVarInitialized (op1, GetVarInitialized (op3)) ; - SetupAlias (op1, op3) + SetVarInitialized (ptr, GetVarInitialized (content)) ; + SetupIndr (ptr, content) END CheckAddr ; @@ -1366,6 +1510,64 @@ BEGIN END DumpBBSequence ; +(* + trashParam - +*) + +PROCEDURE trashParam (trashQuad: CARDINAL) ; +VAR + op : QuadOperator ; + op1, op2, op3: CARDINAL ; + heapSym, ptr : CARDINAL ; +BEGIN + IF trashQuad # 0 + THEN + GetQuad (trashQuad, op, op1, op2, op3) ; + heapSym := GetQuadTrash (trashQuad) ; + IF Debugging + THEN + printf1 ("heapSym = %d\n", heapSym) + END ; + IF heapSym # NulSym + THEN + SetVarInitialized (op3, FALSE) ; + ptr := getContent (getLAlias (op3)) ; + IF ptr # NulSym + THEN + SetupIndr (ptr, heapSym) ; + SetVarInitialized (ptr, FALSE) + END +(* + vsym := getLAlias (op3) ; + VarInitState (vsym) ; + VarInitState (heapSym) ; + PutVarInitialized (vsym, GetMode (vsym)) ; + PutVarInitialized (heapSym, LeftValue) ; + SetupLAlias (vsym, heapSym) +*) + END + END ; + DumpAliases +END trashParam ; + + +(* + SetVarLRInitialized - +*) + +PROCEDURE SetVarLRInitialized (param: CARDINAL) ; +VAR + sym: CARDINAL ; +BEGIN + Assert (IsParameter (param)) ; + sym := GetParameterShadowVar (param) ; + IF sym # NulSym + THEN + IncludeItemIntoList (ignoreList, sym) + END +END SetVarLRInitialized ; + + (* TestBBSequence - *) @@ -1381,20 +1583,26 @@ BEGIN THEN DumpBBSequence (procSym, lst) END ; - ForeachLocalSymDo (procSym, SetVarUninitialized) ; initBlock ; + ForeachLocalSymDo (procSym, SetVarUninitialized) ; + ForeachParamSymDo (procSym, SetVarLRInitialized) ; n := NoOfItemsInList (lst) ; i := 1 ; warning := TRUE ; WHILE i <= n DO bbi := GetItemFromList (lst, i) ; bbPtr := Indexing.GetIndice (bbArray, bbi) ; - CheckReadBeforeInitFirstBasicBlock (procSym, bbPtr^.start, bbPtr^.end, warning, lst, i) ; + CheckReadBeforeInitFirstBasicBlock (procSym, + bbPtr^.start, bbPtr^.end, + warning, lst, i) ; IF bbPtr^.endCond THEN (* Check to see if we are moving into an conditional block in which case we will issue a note. *) warning := FALSE + ELSIF bbPtr^.endCall AND (bbPtr^.trashQuad # 0) + THEN + trashParam (bbPtr^.trashQuad) END ; INC (i) END ; @@ -1422,7 +1630,7 @@ BEGIN ELSE duplst := DuplicateList (lst) ; IncludeItemIntoList (duplst, i) ; - IF iPtr^.endCall + IF iPtr^.endCall AND (iPtr^.trashQuad = 0) THEN TestBBSequence (procSym, duplst) ELSIF iPtr^.endGoto @@ -1570,6 +1778,45 @@ BEGIN END NewEntry ; +(* + IsAllocate - return TRUE is sym is ALLOCATE. +*) + +PROCEDURE IsAllocate (sym: CARDINAL) : BOOLEAN ; +BEGIN + RETURN IsProcedure (sym) AND (GetSymName (sym) = MakeKey('ALLOCATE')) +END IsAllocate ; + + +(* + DetectTrash - +*) + +PROCEDURE DetectTrash (bbPtr: bbEntry) ; +VAR + i : CARDINAL ; + op : QuadOperator ; + op1, op2, op3: CARDINAL ; +BEGIN + IF bbPtr^.endCall + THEN + i := bbPtr^.start ; + LOOP + GetQuad (i, op, op1, op2, op3) ; + IF (op = ParamOp) AND (op1 = 1) AND IsAllocate (op2) + THEN + bbPtr^.trashQuad := i + END ; + IF i = bbPtr^.end + THEN + RETURN + END ; + i := GetNextQuad (i) + END + END +END DetectTrash ; + + (* AppendEntry - *) @@ -1589,6 +1836,7 @@ BEGIN endGoto := IsGoto (End) ; endCond := IsConditional (End) ; topOfLoop := IsBackReference (Start) ; + trashQuad := 0 ; indexBB := high + 1 ; nextQuad := 0 ; condQuad := 0 ; @@ -1596,6 +1844,7 @@ BEGIN condBB := 0 ; next := NIL END ; + DetectTrash (bbPtr) ; Indexing.PutIndice (bbArray, high + 1, bbPtr) END AppendEntry ; @@ -1604,31 +1853,44 @@ END AppendEntry ; DumpAlias - *) -PROCEDURE DumpAlias (aliasIndex: CARDINAL) ; +PROCEDURE DumpAlias (array: Index; aliasIndex: CARDINAL) ; VAR sa: symAlias ; BEGIN - sa := Indexing.GetIndice (aliasArray, aliasIndex) ; - printf2 ("keySym = %d: alias = %d\n", sa^.keySym, sa^.alias) ; + sa := Indexing.GetIndice (array, aliasIndex) ; + printf2 ("keySym = %d: alias = %d\n", sa^.keySym, sa^.alias) END DumpAlias ; (* - DumpAliases - + doDumpAliases - *) -PROCEDURE DumpAliases ; +PROCEDURE doDumpAliases (array: Index) ; VAR i, n: CARDINAL ; +BEGIN + i := 1 ; + n := Indexing.HighIndice (array) ; + WHILE i <= n DO + DumpAlias (array, i) ; + INC (i) + END +END doDumpAliases ; + + +(* + DumpAliases - +*) + +PROCEDURE DumpAliases ; BEGIN IF Debugging THEN - i := 1 ; - n := Indexing.HighIndice (aliasArray) ; - WHILE i <= n DO - DumpAlias (i) ; - INC (i) - END + printf0 ("LArray\n") ; + doDumpAliases (LArray) ; + printf0 ("IndirectArray\n") ; + doDumpAliases (IndirectArray) END END DumpAliases ; @@ -1687,7 +1949,9 @@ END killAlias ; PROCEDURE initBlock ; BEGIN - aliasArray := Indexing.InitIndex (1) ; + LArray := Indexing.InitIndex (1) ; + IndirectArray := Indexing.InitIndex (1) ; + InitList (ignoreList) END initBlock ; @@ -1696,32 +1960,40 @@ END initBlock ; *) PROCEDURE killBlock ; +BEGIN + doKillBlock (LArray) ; + doKillBlock (IndirectArray) ; + KillList (ignoreList) +END killBlock ; + + +PROCEDURE doKillBlock (VAR array: Index) ; VAR i, n: CARDINAL ; BEGIN i := 1 ; - n := Indexing.HighIndice (aliasArray) ; + n := Indexing.HighIndice (array) ; WHILE i <= n DO - killAlias (Indexing.GetIndice (aliasArray, i)) ; + killAlias (Indexing.GetIndice (array, i)) ; INC (i) END ; - aliasArray := Indexing.KillIndex (aliasArray) -END killBlock ; + array := Indexing.KillIndex (array) +END doKillBlock ; (* addAlias - *) -PROCEDURE addAlias (sym: CARDINAL; aliased: CARDINAL) ; +PROCEDURE addAlias (array: Index; sym: CARDINAL; aliased: CARDINAL) ; VAR i, n: CARDINAL ; sa : symAlias ; BEGIN i := 1 ; - n := Indexing.HighIndice (aliasArray) ; + n := Indexing.HighIndice (array) ; WHILE i <= n DO - sa := Indexing.GetIndice (aliasArray, i) ; + sa := Indexing.GetIndice (array, i) ; IF sa^.keySym = sym THEN sa^.alias := aliased ; @@ -1730,7 +2002,7 @@ BEGIN INC (i) END ; sa := initAlias (sym) ; - Indexing.IncludeIndiceIntoIndex (aliasArray, sa) ; + Indexing.IncludeIndiceIntoIndex (array, sa) ; sa^.alias := aliased END addAlias ; @@ -1739,15 +2011,15 @@ END addAlias ; lookupAlias - *) -PROCEDURE lookupAlias (sym: CARDINAL) : symAlias ; +PROCEDURE lookupAlias (array: Index; sym: CARDINAL) : symAlias ; VAR i, n: CARDINAL ; sa : symAlias ; BEGIN i := 1 ; - n := Indexing.HighIndice (aliasArray) ; + n := Indexing.HighIndice (array) ; WHILE i <= n DO - sa := Indexing.GetIndice (aliasArray, i) ; + sa := Indexing.GetIndice (array, i) ; IF sa^.keySym = sym THEN RETURN sa @@ -1762,11 +2034,11 @@ END lookupAlias ; doGetAlias - *) -PROCEDURE doGetAlias (sym: CARDINAL) : CARDINAL ; +PROCEDURE doGetAlias (array: Index; sym: CARDINAL) : CARDINAL ; VAR sa: symAlias ; BEGIN - sa := lookupAlias (sym) ; + sa := lookupAlias (array, sym) ; IF (sa # NIL) AND (sa^.alias # NulSym) THEN RETURN sa^.alias @@ -1776,10 +2048,10 @@ END doGetAlias ; (* - getAlias - attempts to looks up an alias which is not a temporary variable. + getLAlias - attempts to looks up an alias which is not a temporary variable. *) -PROCEDURE getAlias (sym: CARDINAL) : CARDINAL ; +PROCEDURE getLAlias (sym: CARDINAL) : CARDINAL ; VAR type, nsym: CARDINAL ; @@ -1791,28 +2063,48 @@ BEGIN IF (IsTemporary (sym) AND (GetMode (sym) = LeftValue)) OR ((type # NulSym) AND IsReallyPointer (type)) THEN - nsym := doGetAlias (sym) + nsym := doGetAlias (LArray, sym) ELSE RETURN sym END UNTIL nsym = NulSym ; RETURN sym -END getAlias ; +END getLAlias ; (* - SetupAlias - + SetupLAlias - *) -PROCEDURE SetupAlias (des, exp: CARDINAL) ; +PROCEDURE SetupLAlias (des, exp: CARDINAL) ; BEGIN IF IsVar (exp) AND ((GetMode (des) = LeftValue) OR IsReallyPointer (GetSType (des))) THEN - addAlias (des, exp) ; + addAlias (LArray, des, exp) ; DumpAliases END -END SetupAlias ; +END SetupLAlias ; + + +(* + SetupIndr - +*) + +PROCEDURE SetupIndr (ptr, content: CARDINAL) ; +BEGIN + addAlias (IndirectArray, ptr, content) ; +END SetupIndr ; + + +(* + getContent - +*) + +PROCEDURE getContent (ptr: CARDINAL) : CARDINAL ; +BEGIN + RETURN doGetAlias (IndirectArray, ptr) +END getContent ; (* diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def index 8c4feed7055..2cfa0d49ac9 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.def +++ b/gcc/m2/gm2-compiler/SymbolTable.def @@ -92,6 +92,8 @@ EXPORT QUALIFIED NulSym, ForeachModuleDo, ForeachInnerModuleDo, ForeachLocalSymDo, + ForeachParamSymDo, + ForeachFieldEnumerationDo, GetModule, GetCurrentModule, @@ -204,6 +206,7 @@ EXPORT QUALIFIED NulSym, PutVariableSSA, IsVariableSSA, PutPublic, IsPublic, PutCtor, IsCtor, PutExtern, IsExtern, PutMonoName, IsMonoName, + PutVarHeap, IsVarHeap, IsDefImp, IsModule, @@ -694,6 +697,20 @@ PROCEDURE MakeModuleCtor (moduleTok, beginTok, finallyTok: CARDINAL; PROCEDURE PutModuleCtorExtern (tok: CARDINAL; sym: CARDINAL; external: BOOLEAN) ; +(* + PutVarHeap - assigns ArrayRef field with value. +*) + +PROCEDURE PutVarHeap (sym: CARDINAL; value: BOOLEAN) ; + + +(* + IsVarHeap - returns ArrayRef field value. +*) + +PROCEDURE IsVarHeap (sym: CARDINAL) : BOOLEAN ; + + (* MakeVar - creates a variable sym with VarName. It returns the symbol index. @@ -2398,6 +2415,14 @@ PROCEDURE SanityCheckConstants ; PROCEDURE ForeachLocalSymDo (Sym: CARDINAL; P: PerformOperation) ; +(* + ForeachParamSymDo - foreach parameter symbol in procedure, Sym, + perform the procedure, P. +*) + +PROCEDURE ForeachParamSymDo (Sym: CARDINAL; P: PerformOperation) ; + + (* ForeachFieldEnumerationDo - for each field in enumeration, Sym, do procedure, P. diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod index df417fe8fdb..b5149a831f2 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.mod +++ b/gcc/m2/gm2-compiler/SymbolTable.mod @@ -518,6 +518,7 @@ TYPE IsConst : BOOLEAN ; (* Is variable read/only? *) ArrayRef : BOOLEAN ; (* Is variable used to point *) (* to an array? *) + Heap : BOOLEAN ; (* Is var on the heap? *) InitState : LRInitDesc ; (* Initialization state. *) At : Where ; (* Where was sym declared/used *) ReadUsageList, (* list of var read quads *) @@ -4254,6 +4255,7 @@ BEGIN IsSSA := FALSE ; IsConst := FALSE ; ArrayRef := FALSE ; + Heap := FALSE ; InitWhereDeclaredTok(tok, At) ; InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *) InitList(ReadUsageList[RightValue]) ; @@ -6849,6 +6851,48 @@ BEGIN END IsVarArrayRef ; +(* + PutVarHeap - assigns ArrayRef field with value. +*) + +PROCEDURE PutVarHeap (sym: CARDINAL; value: BOOLEAN) ; +VAR + pSym: PtrToSymbol ; +BEGIN + pSym := GetPsym(sym) ; + WITH pSym^ DO + CASE SymbolType OF + + VarSym: Var.Heap := value + + ELSE + InternalError ('expecting VarSym') + END + END +END PutVarHeap ; + + +(* + IsVarHeap - returns ArrayRef field value. +*) + +PROCEDURE IsVarHeap (sym: CARDINAL) : BOOLEAN ; +VAR + pSym: PtrToSymbol ; +BEGIN + pSym := GetPsym(sym) ; + WITH pSym^ DO + CASE SymbolType OF + + VarSym: RETURN (Var.Heap) + + ELSE + InternalError ('expecting VarSym') + END + END +END IsVarHeap ; + + (* PutFieldRecord - places a field, FieldName and FieldType into a record, Sym. VarSym is a optional varient symbol which can be returned @@ -8943,6 +8987,31 @@ BEGIN END ForeachLocalSymDo ; +(* + ForeachParamSymDo - foreach parameter symbol in procedure, Sym, + perform the procedure, P. Each symbol + looked up will be VarParam or Param + (not the shadow variable). +*) + +PROCEDURE ForeachParamSymDo (Sym: CARDINAL; P: PerformOperation) ; +VAR + param: CARDINAL ; + p, i : CARDINAL ; +BEGIN + IF IsProcedure (Sym) + THEN + p := NoOfParam (Sym) ; + i := p ; + WHILE i>0 DO + param := GetNthParam (Sym, i) ; + P (param) ; + DEC(i) + END + END +END ForeachParamSymDo ; + + (* CheckForUnknownInModule - checks for any unknown symbols in the current module. @@ -10016,31 +10085,31 @@ VAR pSym : PtrToSymbol ; VariableSym: CARDINAL ; BEGIN - VariableSym := MakeVar(tok, ParamName) ; - pSym := GetPsym(VariableSym) ; + VariableSym := MakeVar (tok, ParamName) ; + pSym := GetPsym (VariableSym) ; WITH pSym^ DO CASE SymbolType OF ErrorSym: RETURN( NulSym ) | - VarSym : Var.IsParam := TRUE (* Variable is really a parameter *) + VarSym : Var.IsParam := TRUE (* Variable is really a parameter. *) ELSE InternalError ('expecting a Var symbol') END END ; - (* Note that the parameter is now treated as a local variable *) - PutVar(VariableSym, GetType(GetNthParam(ProcSym, no))) ; - PutDeclared(tok, VariableSym) ; + (* Note that the parameter is now treated as a local variable. *) + PutVar (VariableSym, GetType(GetNthParam(ProcSym, no))) ; + PutDeclared (tok, VariableSym) ; (* Normal VAR parameters have LeftValue, however Unbounded VAR parameters have RightValue. Non VAR parameters always have RightValue. *) - IF IsVarParam(ProcSym, no) AND (NOT IsUnboundedParam(ProcSym, no)) + IF IsVarParam (ProcSym, no) AND (NOT IsUnboundedParam (ProcSym, no)) THEN - PutMode(VariableSym, LeftValue) + PutMode (VariableSym, LeftValue) ELSE - PutMode(VariableSym, RightValue) + PutMode (VariableSym, RightValue) END ; RETURN( VariableSym ) END MakeVariableForParam ; diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/assignparam.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/assignparam.mod new file mode 100644 index 00000000000..9344ad0bb03 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/assignparam.mod @@ -0,0 +1,31 @@ +MODULE assignparam ; + +FROM SYSTEM IMPORT ADR ; + +TYPE + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: INTEGER ; + END ; + + +PROCEDURE test (p: PtrToVec) ; +VAR + s: PtrToVec ; + v: Vec ; +BEGIN + s := ADR (v) ; + s^ := p^ ; + IF s^.x = 1 + THEN + END +END test ; + + +VAR + q: PtrToVec ; + w: Vec ; +BEGIN + q := ADR (w) ; + test (q) +END assignparam. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/tiny.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/tiny.mod new file mode 100644 index 00000000000..668e09c03d3 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/pass/tiny.mod @@ -0,0 +1,13 @@ +MODULE tiny ; + + +PROCEDURE test ; +VAR + p: CARDINAL ; +BEGIN + p := 1 +END test ; + +BEGIN + test +END tiny. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/switches-uninit-variable-checking-procedures-fail.exp b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/switches-uninit-variable-checking-procedures-fail.exp new file mode 100644 index 00000000000..6d22f36a6bd --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/switches-uninit-variable-checking-procedures-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 +# . + +# 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/procedures/fail" -Wuninit-variable-checking=all + +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/procedures/fail/testnew.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew.mod new file mode 100644 index 00000000000..f0abe0a1312 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew.mod @@ -0,0 +1,31 @@ +MODULE testnew ; + +FROM Storage IMPORT ALLOCATE ; + +TYPE + ptr = POINTER TO RECORD + a, b: CARDINAL ; + END ; + +(* + test - +*) + +PROCEDURE test (p: ptr) ; +BEGIN + NEW (p) ; + WITH p^ DO + a := 1 ; + (* user forgets to assign b. *) + IF b = 2 + THEN + END + END +END test ; + + +VAR + n: ptr ; +BEGIN + test (n) +END testnew. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew2.mod new file mode 100644 index 00000000000..4511302c98a --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew2.mod @@ -0,0 +1,31 @@ +MODULE testnew2 ; + +FROM Storage IMPORT ALLOCATE ; + +TYPE + ptr = POINTER TO RECORD + a, b: CARDINAL ; + END ; + +(* + test - +*) + +PROCEDURE test ; +VAR + p: ptr ; +BEGIN + NEW (p) ; + WITH p^ DO + a := 1 ; + (* user forgets to assign b. *) + IF b = 2 + THEN + END + END +END test ; + + +BEGIN + test +END testnew2. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew3.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew3.mod new file mode 100644 index 00000000000..bb8ceba884a --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew3.mod @@ -0,0 +1,34 @@ +MODULE testnew3 ; + +FROM Storage IMPORT ALLOCATE ; +FROM SYSTEM IMPORT ADR ; + +TYPE + ptr = POINTER TO rec ; + rec = RECORD + a, b: CARDINAL ; + END ; + +(* + test - +*) + +PROCEDURE test ; +VAR + p: ptr ; + r: rec ; +BEGIN + p := ADR (r) ; + WITH p^ DO + a := 1 ; + (* user forgets to assign b. *) + IF b = 2 + THEN + END + END +END test ; + + +BEGIN + test +END testnew3. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew4.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew4.mod new file mode 100644 index 00000000000..5c65ba8888c --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew4.mod @@ -0,0 +1,34 @@ +MODULE testnew4 ; + +FROM Storage IMPORT ALLOCATE ; +FROM SYSTEM IMPORT ADR ; + +TYPE + ptr = POINTER TO rec ; + rec = RECORD + a, b: CARDINAL ; + END ; + +(* + test - +*) + +PROCEDURE test ; +VAR + p: ptr ; + r: rec ; +BEGIN + p := ADR (r) ; + WITH p^ DO + a := 1 ; + (* user forgets to assign b. *) + IF b = 2 + THEN + END + END +END test ; + + +BEGIN + test +END testnew4. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew5.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew5.mod new file mode 100644 index 00000000000..7cad3c222da --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew5.mod @@ -0,0 +1,31 @@ +MODULE testnew5 ; + +FROM Storage IMPORT ALLOCATE ; + +TYPE + ptr = POINTER TO RECORD + a, b: CARDINAL ; + END ; + +(* + test - +*) + +PROCEDURE test (p: ptr) ; +BEGIN + NEW (p) ; + WITH p^ DO + a := 1 ; + (* user forgets to assign b. *) + IF b = 2 + THEN + END + END +END test ; + + +VAR + n: ptr ; +BEGIN + test (n) +END testnew5. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew6.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew6.mod new file mode 100644 index 00000000000..f77a8d8eb33 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testnew6.mod @@ -0,0 +1,27 @@ +MODULE testnew6 ; + +FROM Storage IMPORT ALLOCATE ; + +TYPE + PtrToVec = POINTER TO RECORD + x, y: INTEGER ; + END ; + +PROCEDURE test ; +VAR + p: PtrToVec ; +BEGIN + NEW (p) ; + WITH p^ DO + x := 1 ; + x := 2 (* Deliberate typo, user meant y. *) + END ; + IF p^.y = 2 + THEN + END +END test ; + + +BEGIN + test +END testnew6. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testptrptr.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testptrptr.mod new file mode 100644 index 00000000000..77503640e49 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/fail/testptrptr.mod @@ -0,0 +1,32 @@ +MODULE testptrptr ; + +FROM SYSTEM IMPORT ADR ; + +TYPE + PtrToPtrToVec = POINTER TO PtrToVec ; + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: INTEGER ; + END ; + + +PROCEDURE test ; +VAR + vec: Vec ; + ptr: PtrToVec ; + ptrptr: PtrToPtrToVec ; +BEGIN + ptr := ADR (vec) ; + ptrptr := ADR (ptr) ; + WITH ptrptr^^ DO + x := 1 ; + IF y = 2 (* error here. *) + THEN + END + END +END test ; + + +BEGIN + test +END testptrptr. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/assignparam2.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/assignparam2.mod new file mode 100644 index 00000000000..4a51efa0b47 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/assignparam2.mod @@ -0,0 +1,31 @@ +MODULE assignparam2 ; + +FROM SYSTEM IMPORT ADR ; +FROM Storage IMPORT ALLOCATE ; + +TYPE + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: INTEGER ; + END ; + + +PROCEDURE test (p: PtrToVec) ; +VAR + s: PtrToVec ; +BEGIN + NEW (s) ; + s^ := p^ ; + IF s^.x = 1 + THEN + END +END test ; + + +VAR + q: PtrToVec ; + w: Vec ; +BEGIN + q := ADR (w) ; + test (q) +END assignparam2. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/switches-uninit-variable-checking-procedures-pass.exp b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/switches-uninit-variable-checking-procedures-pass.exp new file mode 100644 index 00000000000..ad1e971fd1b --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/switches-uninit-variable-checking-procedures-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 +# . + +# 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/procedures/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/procedures/pass/testnew5.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testnew5.mod new file mode 100644 index 00000000000..1cdca608394 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testnew5.mod @@ -0,0 +1,27 @@ +MODULE testnew5 ; + +FROM Storage IMPORT ALLOCATE ; + +TYPE + ptr = POINTER TO RECORD + a, b: CARDINAL ; + END ; + +(* + test - +*) + +PROCEDURE test (VAR p: ptr) ; +BEGIN + NEW (p) ; + WITH p^ DO + a := 1 ; + END +END test ; + + +VAR + n: ptr ; +BEGIN + test (n) +END testnew5. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testnew6.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testnew6.mod new file mode 100644 index 00000000000..b3a40188874 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testnew6.mod @@ -0,0 +1,27 @@ +MODULE testnew6 ; + +FROM Storage IMPORT ALLOCATE ; + +TYPE + ptr = POINTER TO RECORD + a, b: CARDINAL ; + END ; + +(* + test - +*) + +PROCEDURE test (p: ptr) ; +BEGIN + NEW (p) ; + WITH p^ DO + a := 1 ; + END +END test ; + + +VAR + n: ptr ; +BEGIN + test (n) +END testnew6. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamlvalue.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamlvalue.mod new file mode 100644 index 00000000000..a783fbfcf2f --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamlvalue.mod @@ -0,0 +1,26 @@ +MODULE testparamlvalue ; + +FROM SYSTEM IMPORT ADR ; + +TYPE + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: INTEGER ; + END ; + + +PROCEDURE test (VAR p: PtrToVec) ; +BEGIN + IF p^.x = 1 + THEN + END +END test ; + + +VAR + q: PtrToVec ; + v: Vec ; +BEGIN + q := ADR (v) ; + test (q) +END testparamlvalue. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamrvalue.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamrvalue.mod new file mode 100644 index 00000000000..eb9d0e92ad7 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testparamrvalue.mod @@ -0,0 +1,26 @@ +MODULE testparamrvalue ; + +FROM SYSTEM IMPORT ADR ; + +TYPE + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: INTEGER ; + END ; + + +PROCEDURE test (p: PtrToVec) ; +BEGIN + IF p^.x = 1 + THEN + END +END test ; + + +VAR + q: PtrToVec ; + v: Vec ; +BEGIN + q := ADR (v) ; + test (q) +END testparamrvalue. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testproc.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testproc.mod new file mode 100644 index 00000000000..647b2ff9d0e --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testproc.mod @@ -0,0 +1,15 @@ +MODULE testproc ; + + +PROCEDURE test (i: INTEGER) ; +BEGIN + IF i = 3 + THEN + + END +END test ; + + +BEGIN + test (3) +END testproc. diff --git a/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testptrptr.mod b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testptrptr.mod new file mode 100644 index 00000000000..f8c5b651034 --- /dev/null +++ b/gcc/testsuite/gm2/switches/uninit-variable-checking/procedures/pass/testptrptr.mod @@ -0,0 +1,29 @@ +MODULE testptrptr ; + +FROM SYSTEM IMPORT ADR ; + +TYPE + PtrToPtrToVec = POINTER TO PtrToVec ; + PtrToVec = POINTER TO Vec ; + Vec = RECORD + x, y: INTEGER ; + END ; + + +PROCEDURE test ; +VAR + vec: Vec ; + ptr: PtrToVec ; + ptrptr: PtrToPtrToVec ; +BEGIN + ptr := ADR (vec) ; + ptrptr := ADR (ptr) ; + WITH ptrptr^^ DO + x := 1 + END +END test ; + + +BEGIN + test +END testptrptr.