Dimension : CARDINAL ;
ReadWrite : CARDINAL ;
name : CARDINAL ;
+ RangeDep : CARDINAL ;
Annotation: String ;
tokenno : CARDINAL ;
END ;
proctok,
paramtok : CARDINAL ;
n1, n2 : Name ;
+ ParamCheckId,
Dim,
Actual,
FormalI,
s := InitString ('actual') ;
WarnStringAt (s, paramtok)
END ;
-
- BuildRange (InitTypesParameterCheck (paramtok, Proc, i, FormalI, Actual)) ;
+ ParamCheckId := InitTypesParameterCheck (paramtok, Proc, i, FormalI, Actual, 0) ;
+ BuildRange (ParamCheckId) ;
+ (* Store the ParamCheckId on the quad stack so that any dependant checks
+ can be cancelled if the type check above detects an error. *)
+ PutRangeDep (pi, ParamCheckId) ;
IF IsConst(Actual)
THEN
IF IsVarParamAny (Proc, i)
(* Allow string literals to be passed to ARRAY [0..n] OF CHAR. *)
ELSIF (GetStringLength(paramtok, Actual) = 1) (* If = 1 then it maybe treated as a char. *)
THEN
- CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL)
+ CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL, ParamCheckId)
ELSIF NOT IsUnboundedParamAny (Proc, i)
THEN
IF IsForC AND (GetSType(FormalI)=Address)
END
END
ELSE
- CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL)
+ CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL, ParamCheckId)
END
ELSE
IF IsForC AND UsesVarArgs(Proc)
CheckProcTypeAndProcedure - checks the ProcType with the call.
*)
-PROCEDURE CheckProcTypeAndProcedure (tokno: CARDINAL; ProcType: CARDINAL; call: CARDINAL) ;
+PROCEDURE CheckProcTypeAndProcedure (tokno: CARDINAL; ProcType: CARDINAL;
+ call: CARDINAL; ParamCheckId: CARDINAL) ;
VAR
n1, n2 : Name ;
i, n, t : CARDINAL ;
END ;
BuildRange (InitTypesParameterCheck (tokno, CheckedProcedure, i,
GetParam (CheckedProcedure, i),
- GetParam (ProcType, i))) ;
- (* CheckParameter(tokpos, GetParam(CheckedProcedure, i), 0, GetParam(ProcType, i), call, i, TypeList) ; *)
+ GetParam (ProcType, i), ParamCheckId)) ;
INC(i)
END
END
PROCEDURE CheckParameter (tokpos: CARDINAL;
Actual, Dimension, Formal, ProcSym: CARDINAL;
- i: CARDINAL; TypeList: List) ;
+ i: CARDINAL; TypeList: List; ParamCheckId: CARDINAL) ;
VAR
NewList : BOOLEAN ;
ActualType, FormalType: CARDINAL ;
END
END ;
(* now to check each parameter of the proc type *)
- CheckProcTypeAndProcedure (tokpos, FormalType, Actual)
+ CheckProcTypeAndProcedure (tokpos, FormalType, Actual, ParamCheckId)
ELSIF (ActualType#FormalType) AND (ActualType#NulSym)
THEN
IF IsUnknown(FormalType)
THEN
IF NOT IsSet (GetDType (FormalI))
THEN
- (* tell code generator to test runtime values of assignment so ensure we
- catch overflow and underflow *)
- BuildRange (InitParameterRangeCheck (tokno, Proc, i, FormalI, Actual))
+ (* Tell the code generator to test the runtime values of the assignment
+ so ensure we catch overflow and underflow. *)
+ BuildRange (InitParameterRangeCheck (tokno, Proc, i, FormalI, Actual,
+ OperandRangeDep (pi)))
END
END
END ;
ReadWrite := NulSym ;
tokenno := tok ;
Annotation := KillString (Annotation) ;
- Annotation := InitString ('%1s(%1d)|%2s(%2d)||boolean var|type')
+ Annotation := InitString ('%1s(%1d)|%2s(%2d)||boolean var|type') ;
+ RangeDep := 0
END
END ConvertBooleanToVariable ;
FalseExit := False ;
BooleanOp := TRUE ;
tokenno := tokno ;
- Annotation := NIL
+ Annotation := NIL ;
+ RangeDep := 0
END ;
PushAddress (BoolStack, f) ;
Annotate ('<q%1d>|<q%2d>||true quad|false quad')
END OperandTok ;
+(*
+ OperandRangeDep - return the range dependant associated with the quad stack.
+*)
+
+PROCEDURE OperandRangeDep (pos: CARDINAL) : CARDINAL ;
+VAR
+ f: BoolFrame ;
+BEGIN
+ Assert (NOT IsBoolean (pos)) ;
+ f := PeepAddress (BoolStack, pos) ;
+ RETURN f^.RangeDep
+END OperandRangeDep ;
+
+
+(*
+ PutRangeDep - assigns the quad stack pos RangeDep to dep.
+*)
+
+PROCEDURE PutRangeDep (pos: CARDINAL; dep: CARDINAL) ;
+VAR
+ f: BoolFrame ;
+BEGIN
+ Assert (NOT IsBoolean (pos)) ;
+ f := PeepAddress (BoolStack, pos) ;
+ f^.RangeDep := dep
+END PutRangeDep ;
+
+
(*
BuildCodeOn - generates a quadruple declaring that code should be
emmitted from henceforth.
TokenToLineNo, TokenToColumnNo, TokenToLocation, MakeVirtual2Tok ;
FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
FROM M2GCCDeclare IMPORT TryDeclareConstant, DeclareConstructor ;
FROM M2Quads IMPORT QuadOperator, PutQuad, SubQuad, WriteOperand ;
FROM SymbolConversion IMPORT GccKnowsAbout, Mod2Gcc ;
errorReported : BOOLEAN ; (* error message reported yet? *)
strict : BOOLEAN ; (* is it a comparison expression? *)
isin : BOOLEAN ; (* expression created by IN operator? *)
+ cancelled : BOOLEAN ; (* Has this range been cancelled? *)
+ dependantid : CARDINAL ; (* The associated dependant range test. *)
END ;
expr2tok := UnknownTokenNo ;
byconsttok := UnknownTokenNo ;
incrementquad := 0 ;
- errorReported := FALSE
+ errorReported := FALSE ;
+ cancelled := FALSE ;
+ dependantid := 0
END ;
PutIndice(RangeIndex, r, p)
END ;
*)
PROCEDURE PutRangeParam (tokno: CARDINAL; p: Range; t: TypeOfRange; proc: CARDINAL;
- i: CARDINAL; formal, actual: CARDINAL) : Range ;
+ paramno: CARDINAL; formal, actual: CARDINAL;
+ depRangeId: CARDINAL) : Range ;
BEGIN
WITH p^ DO
type := t ;
desLowestType := NulSym ;
exprLowestType := NulSym ;
procedure := proc ;
- paramNo := i ;
+ paramNo := paramno ;
isLeftValue := FALSE ;
tokenNo := tokno ;
strict := FALSE ;
- isin := FALSE
+ isin := FALSE ;
+ dependantid := depRangeId
END ;
RETURN p
END PutRangeParam ;
and, e, are parameter compatible.
*)
-PROCEDURE InitTypesParameterCheck (tokno: CARDINAL; proc: CARDINAL; i: CARDINAL;
- formal, actual: CARDINAL) : CARDINAL ;
+PROCEDURE InitTypesParameterCheck (tokno: CARDINAL;
+ proc: CARDINAL; paramno: CARDINAL;
+ formal, actual: CARDINAL;
+ depRangeId: CARDINAL) : CARDINAL ;
VAR
r: CARDINAL ;
BEGIN
r := InitRange () ;
- Assert (PutRangeParam (tokno, GetIndice (RangeIndex, r), typeparam, proc, i, formal, actual) # NIL) ;
+ Assert (PutRangeParam (tokno, GetIndice (RangeIndex, r), typeparam, proc,
+ paramno, formal, actual, depRangeId) # NIL) ;
RETURN r
END InitTypesParameterCheck ;
*)
PROCEDURE PutRangeParamAssign (tokno: CARDINAL; p: Range; t: TypeOfRange; proc: CARDINAL;
- i: CARDINAL; formal, actual: CARDINAL) : Range ;
+ i: CARDINAL; formal, actual: CARDINAL; parentRangeId: CARDINAL) : Range ;
BEGIN
WITH p^ DO
type := t ;
paramNo := i ;
dimension := i ;
isLeftValue := FALSE ;
- tokenNo := tokno
+ tokenNo := tokno ;
+ dependantid := parentRangeId
END ;
RETURN( p )
END PutRangeParamAssign ;
are parameter compatible.
*)
-PROCEDURE InitParameterRangeCheck (tokno: CARDINAL; proc: CARDINAL; i: CARDINAL;
- formal, actual: CARDINAL) : CARDINAL ;
+PROCEDURE InitParameterRangeCheck (tokno: CARDINAL; proc: CARDINAL; paramno: CARDINAL;
+ formal, actual: CARDINAL; parentRangeId: CARDINAL) : CARDINAL ;
VAR
r: CARDINAL ;
BEGIN
r := InitRange () ;
- Assert (PutRangeParamAssign (tokno, GetIndice (RangeIndex, r), paramassign, proc, i, formal, actual) # NIL) ;
+ Assert (PutRangeParamAssign (tokno, GetIndice (RangeIndex, r), paramassign, proc,
+ paramno, formal, actual, parentRangeId) # NIL) ;
RETURN r
END InitParameterRangeCheck ;
END FoldAssignment ;
+(*
+ CheckCancelled - check to see if the range has been cancelled and if so remove quad.
+*)
+
+PROCEDURE CheckCancelled (range: CARDINAL; quad: CARDINAL) ;
+BEGIN
+ IF IsCancelled (range)
+ THEN
+ SubQuad (quad)
+ END
+END CheckCancelled ;
+
+
+(*
+ IsCancelled - return the cancelled flag associated with range.
+*)
+
+PROCEDURE IsCancelled (range: CARDINAL) : BOOLEAN ;
+VAR
+ p: Range ;
+BEGIN
+ p := GetIndice (RangeIndex, range) ;
+ WITH p^ DO
+ IF cancelled
+ THEN
+ RETURN TRUE
+ END ;
+ IF (dependantid # 0) AND IsCancelled (dependantid)
+ THEN
+ cancelled := TRUE
+ END ;
+ RETURN cancelled
+ END
+END IsCancelled ;
+
+
+(*
+ Cancel - set the cancelled flag in range.
+*)
+
+PROCEDURE Cancel (range: CARDINAL) ;
+VAR
+ p: Range ;
+BEGIN
+ IF range # 0
+ THEN
+ p := GetIndice (RangeIndex, range) ;
+ WITH p^ DO
+ IF NOT cancelled
+ THEN
+ cancelled := TRUE ;
+ Cancel (dependantid)
+ END
+ END
+ END
+END Cancel ;
+
+
(*
FoldParameterAssign -
*)
The quad is removed if the check succeeds.
*)
-PROCEDURE FoldTypeParam (q: CARDINAL; tokenNo: CARDINAL; formal, actual, procedure: CARDINAL; paramNo: CARDINAL) ;
+PROCEDURE FoldTypeParam (q: CARDINAL; tokenNo: CARDINAL;
+ formal, actual, procedure: CARDINAL;
+ paramNo: CARDINAL;
+ depRangeId: CARDINAL) ;
VAR
compatible: BOOLEAN ;
BEGIN
IF compatible
THEN
SubQuad(q)
+ ELSE
+ Cancel (depRangeId)
END
END FoldTypeParam ;
CASE type OF
typeassign: FoldTypeAssign(q, tokenNo, des, expr, r) |
- typeparam: FoldTypeParam(q, tokenNo, des, expr, procedure, paramNo) |
+ typeparam: FoldTypeParam(q, tokenNo, des, expr, procedure, paramNo, r) |
typeexpr: FoldTypeExpr(q, tokenNo, des, expr, strict, isin, r)
ELSE
(*
- FoldRangeCheck - attempts to resolve the range check, r.
+ FoldRangeCheck - attempts to resolve the range check.
If it evaluates to true then
it is replaced by an ErrorOp
elsif it evaluates to false then
it is left alone
*)
-PROCEDURE FoldRangeCheck (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+PROCEDURE FoldRangeCheck (tokenno: CARDINAL; quad: CARDINAL; range: CARDINAL) ;
+BEGIN
+ IF IsCancelled (range)
+ THEN
+ SubQuad (quad)
+ ELSE
+ FoldRangeCheckLower (tokenno, quad, range)
+ END
+END FoldRangeCheck ;
+
+
+(*
+ FoldRangeCheckLower - call the appropriate Fold procedure depending upon the type
+ of range.
+*)
+
+PROCEDURE FoldRangeCheckLower (tokenno: CARDINAL; quad: CARDINAL; range: CARDINAL) ;
VAR
p: Range ;
BEGIN
- p := GetIndice(RangeIndex, r) ;
+ p := GetIndice(RangeIndex, range) ;
WITH p^ DO
CASE type OF
- assignment : FoldAssignment(tokenno, q, r) |
- returnassignment : FoldReturn(tokenno, q, r) |
+ assignment : FoldAssignment(tokenno, quad, range) |
+ returnassignment : FoldReturn(tokenno, quad, range) |
(* subrangeassignment : | unused currently *)
- inc : FoldInc(tokenno, q, r) |
- dec : FoldDec(tokenno, q, r) |
- incl : FoldIncl(tokenno, q, r) |
- excl : FoldExcl(tokenno, q, r) |
- shift : FoldShift(tokenno, q, r) |
- rotate : FoldRotate(tokenno, q, r) |
- typeassign : FoldTypeCheck(tokenno, q, r) |
- typeparam : FoldTypeCheck(tokenno, q, r) |
- typeexpr : FoldTypeCheck(tokenno, q, r) |
- paramassign : FoldParameterAssign(tokenno, q, r) |
- staticarraysubscript : FoldStaticArraySubscript(tokenno, q, r) |
- dynamicarraysubscript: FoldDynamicArraySubscript(tokenno, q, r) |
- forloopbegin : FoldForLoopBegin(tokenno, q, r) |
- forloopto : FoldForLoopTo(tokenno, q, r) |
+ inc : FoldInc(tokenno, quad, range) |
+ dec : FoldDec(tokenno, quad, range) |
+ incl : FoldIncl(tokenno, quad, range) |
+ excl : FoldExcl(tokenno, quad, range) |
+ shift : FoldShift(tokenno, quad, range) |
+ rotate : FoldRotate(tokenno, quad, range) |
+ typeassign : FoldTypeCheck(tokenno, quad, range) |
+ typeparam : FoldTypeCheck(tokenno, quad, range) |
+ typeexpr : FoldTypeCheck(tokenno, quad, range) |
+ paramassign : FoldParameterAssign(tokenno, quad, range) |
+ staticarraysubscript : FoldStaticArraySubscript(tokenno, quad, range) |
+ dynamicarraysubscript: FoldDynamicArraySubscript(tokenno, quad, range) |
+ forloopbegin : FoldForLoopBegin(tokenno, quad, range) |
+ forloopto : FoldForLoopTo(tokenno, quad, range) |
forloopend : RETURN (* unable to fold anything at this point, des, will be variable *) |
- pointernil : FoldNil(tokenno, q, r) |
+ pointernil : FoldNil(tokenno, quad, range) |
noreturn : RETURN (* nothing to fold *) |
noelse : RETURN (* nothing to fold *) |
- casebounds : FoldCaseBounds(tokenno, q, r) |
- wholenonposdiv : FoldNonPosDiv(tokenno, q, r) |
- wholenonposmod : FoldNonPosMod(tokenno, q, r) |
- wholezerodiv : FoldZeroDiv(tokenno, q, r) |
- wholezerorem : FoldZeroRem(tokenno, q, r) |
- none : SubQuad(q)
+ casebounds : FoldCaseBounds(tokenno, quad, range) |
+ wholenonposdiv : FoldNonPosDiv(tokenno, quad, range) |
+ wholenonposmod : FoldNonPosMod(tokenno, quad, range) |
+ wholezerodiv : FoldZeroDiv(tokenno, quad, range) |
+ wholezerorem : FoldZeroRem(tokenno, quad, range) |
+ none : SubQuad(quad)
ELSE
InternalError ('unexpected case')
END
END
-END FoldRangeCheck ;
+END FoldRangeCheckLower ;
(*
BEGIN
p := GetIndice(RangeIndex, r) ;
WITH p^ DO
+ WriteString ('range ') ;
+ WriteCard (r, 0) ;
+ WriteString (' ') ;
+ IF cancelled
+ THEN
+ WriteString ('cancelled ')
+ END ;
+ IF dependantid # 0
+ THEN
+ WriteString ('dep ') ;
+ WriteCard (dependantid, 0) ;
+ WriteString (' ')
+ END ;
CASE type OF
assignment : WriteString('assignment (') ; WriteOperand(des) ; WriteString(', ') ; WriteOperand(expr) |
projects / thirdparty / gcc.git / commitdiff
