Checking Ranges
Turbo Pascal checks if values are within limits. If the value is constant it is immediately checked for lower and upper limit. If it is not constant and range checking is enabled, Turbo Pascal will generate range checking code. Botl limits will be stored in code and compiler procedure will be called to check range in run-time.
Procedure TExpression.CheckRange (TypeDef: PTypeDefinition);
begin
Case TypeDef^.BaseType of
btInteger..btEnumeration: CheckOrdinalRange (TypeDef);
btSet: Case it32Bytes in TypeDef^.DataType of
False: LoadSetAndPopPointer (TypeDef^.DataType);
True: ExpandSetToStackFrameAndPushPointer (32);
end;
end;
end;
Procedure TExpression.CheckOrdinalRange (TypePtr: PTypeDefinition);
Var TempInt: LongRec;
UpperLimit, LowerLimit: LongInt;
ConstantOffset, ProgramCodeBlock: Word;
PointerToLimits: Pointer;
begin
If Location = elConstant then
begin
If not IsConstantInRange (Value.LongRec, TypePtr) then Error (ConstantOutOfRange);
DataType := TypePtr^.DataType + LowestDataType;
Exit;
end;
If not (RangeChecking in StatementCompilerSwitches) or (TypePtr^.BaseType = btBoolean) then
begin
ExtendInteger (TypePtr^.DataType + LowestDataType);
Exit;
end;
TempInt.Long := 0; { Lowest possible value }
If itSigned in DataType then { Negative }
begin
TempInt.Long := $FFFFFF80;
If it16Bit in DataType then
begin
TempInt.Long := $FFFF8000;
If it32Bit in DataType then TempInt.Long := $80000000;
end;
end;
If IsConstantInRange (TempInt, TypePtr) then
begin { Check highest possible value }
TempInt.Long := $0000007F;
If itUnsigned in DataType then TempInt.Long := $000000FF;
If it16Bit in DataType then
begin
TempInt.WordL := TempInt.WordL shl 8 or $FF;
If it32Bit in DataType then
begin
TempInt.WordH := TempInt.WordL;
TempInt.WordL := $FFFF;
end;
end;
If IsConstantInRange (TempInt, TypePtr) then
begin
ExtendInteger (TypePtr^.DataType + LowestDataType);
Exit;
end;
end;
LowerLimit := POrdinalTypeDefinition (TypePtr)^.LowerLimit;
UpperLimit := POrdinalTypeDefinition (TypePtr)^.UpperLimit;
PointerToLimits := @LowerLimit;
ConstantOffset := StoreConstantToCodeBlock (8, PointerToLimits, ProgramCodeBlock);
ExtendInteger ([it32Bit, it16Bit, itSigned]);
Calculate;
LoadExpressionToRegisters (urAX);
GenerateInstruction_Byte (MOV_DI_Immediate);
GenerateReference (SymbolTable [stMain].Segment, ProgramCodeBlock, ConstantOffset, [rfConstant, rfOffset]);
GenerateInstruction_CALL_FAR (SysProc_RangeCheck);
EndIntermediateCodeSubroutine;
end;
Each ordinal type definition contains lower and upper limit. This function checks them.
Function IsConstantInRange (Int: LongRec; TypePtr: PTypeDefinition): Boolean;
begin
IsConstantInRange := False;
If Int.Long <; POrdinalTypeDefinition (TypePtr)^.LowerLimit then Exit;
If Int.Long > POrdinalTypeDefinition (TypePtr)^.UpperLimit then Exit;
IsConstantInRange := True;
end;
If overflow flag is set this procedure reports error otherwise it stores new integer to expression Value
and sets lowest integer type.
Procedure TExpression.CheckOrdinalOverflowAndStore (Int: LongInt; Overflow: Boolean);
begin
If Overflow then Error (OverflowInArithmeticOperation);
Value.LongInt := Int;
LowestIntegerType (Int, DataType);
end;
This procedure loads constant set into Value
or pops set pointer if set is on stack frame. Location is either elConstant
or elMemory
.
Procedure TExpression.LoadSetAndPopPointer (TypeDefDataType: TIntegerTypeSet);
begin
LoadConstantSmallSetIntoValue;
If it32Bytes in DataType then
begin
DataType := TypeDefDataType;
If Location = elStackFrame then PopPointerAndConvertToMemory (Self);
end else ExtendInteger (TypeDefDataType);
end;