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.
  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.
  LoadConstantSmallSetIntoValue;
  If it32Bytes in DataType then
    begin
      DataType := TypeDefDataType;
      If Location = elStackFrame then PopPointerAndConvertToMemory (Self);
    end else ExtendInteger (TypeDefDataType);
end;

                                                                                                                             {
 
 
 
© 2017 Turbo Pascal | Privacy Policy