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,
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
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)
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 ;
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 ;
(*
- 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 ;
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 *)
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 *)
Type := ParamType ;
IsUnbounded := isUnbounded ;
ShadowVar := NulSym ;
+ HeapVar := NulSym ; (* Will contain a pointer value. *)
InitWhereDeclaredTok(tok, At)
END
END ;
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.
projects / thirdparty / gcc.git / commitdiff
