[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.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

4 files changed, 161 insertions, 38 deletions

diff --git a/gcc/m2/gm2-compiler/M2SymInit.mod b/gcc/m2/gm2-compiler/M2SymInit.mod
index 81d1e6b..b629ed8 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 98a51ea..71f6b1c 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 2cfa0d4..9579a42 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 1768966..aabaef4 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -443,7 +443,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 *)
@@ -453,7 +453,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 *)
@@ -10296,6 +10299,7 @@ BEGIN
             Type := ParamType ;
             IsUnbounded := isUnbounded ;
             ShadowVar := NulSym ;
+            HeapVar := NulSym ;  (* Will contain a pointer value.  *)
             InitWhereDeclaredTok(tok, At)
          END
       END ;
@@ -10659,6 +10663,83 @@ 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.
 *)