Converting Number Types

Turbo Pascal sometimes needs to convert number types. This is because Integer and Real expressions can be used as Extended values and Integer or Extended expressions can be used where Real values are expected.
Procedure TExpression.ConvertIntegerToExtended;
Var OpCode: Byte;
begin
  If TypeDefPtr^.BaseType <> btInteger then Exit;
  Case Location of
    elConstant: begin
                  Value.Extended := Value.LongInt;
                  DataType := [fpExtended];
                  TypeDefPtr := Ptr (SystemUnitSegment, Extended_TypeOffset);
                  Exit;
                end;
    elMemory: If it32Bit in DataType then OpCode := FILD_32Bit else
                If DataType = [it16Bit] then OpCode := FILD_16Bit else
                  begin
                    ExtendInteger ([it32Bit, it16Bit, itSigned]);
                    StoreIntegerToStackFrame;
                    OpCode := FILD_32Bit;
                  end;
    else begin
           ExtendInteger ([it32Bit, it16Bit, itSigned]);
           StoreIntegerToStackFrame;
           OpCode := FILD_32Bit;
         end;
  end;
  Calculate;
  GenerateFPUInstructionWithExpressionInMemory (OpCode, $00);
  EndIntermediateCodeSubroutine;
  Location := elStackFrame;
  DataType := [fpExtended];
  TypeDefPtr := Ptr (SystemUnitSegment, Extended_TypeOffset);
end;
Procedure TExpression.ConvertRealToExtended;
begin
  If TypeDefPtr^.BaseType = btReal then
    begin
      Calculate;
      LoadRealExpressionToRegisterSet (rAX_BX_DX);
      GenerateInstruction_CALL_FAR (SysProc_FRealExt);
      EndIntermediateCodeSubroutine;
      Location := elStackFrame;
      DataType := [itUnsigned];
      UsedRegisters := [urBX, urDX, urCX, urAX];
      TypeDefPtr := Ptr (SystemUnitSegment, Extended_TypeOffset);
    end;
end;
Procedure TExpression.ConvertIntegerToReal;
begin
  If TypeDefPtr^.BaseType = btInteger then
    begin
      If Location = elConstant then Value.Real := Value.LongInt else
        begin
          ExtendInteger ([it32Bit, it16Bit, itSigned]);
          Calculate;
          LoadExpressionToRegisters (urDX_AX);
          GenerateInstruction_CALL_FAR (SysProc_RFloat);
          EndIntermediateCodeSubroutine;
          Location := elRegister;
          UsedRegisters := [urBX, urDX, urCX, urAX];
        end;
      DataType := [it16Bit];
      TypeDefPtr := Ptr (SystemUnitSegment, Real_TypeOffset);
    end;
end;
Procedure TExpression.ConvertExtendedToReal;
begin
  If TypeDefPtr^.BaseType = btExtended then
    begin
      Case Location of
        elConstant: begin
                      If Value.Extended > 1.701E38 then Error (ConstantOutOfRange);
                      Value.Real := Value.Extended;
                    end;
      else begin
             LoadExpressionToFPU;
             Calculate;
             GenerateInstruction_CALL_FAR (SysProc_FExtReal);
             EndIntermediateCodeSubroutine;
             Location := elRegister;
             UsedRegisters := [urBX, urDX, urCX, urAX];
           end;
      end;
      DataType := [it16Bit]; { fpDouble ? }
      TypeDefPtr := Ptr (SystemUnitSegment, Real_TypeOffset);
    end;
end;
  Case Byte (FloatingTypeSet) of
    fptExtended: Exit;
    fptSingle: begin
                 Value.Single := Value.Extended;
                 If Value.W12 and $7F80 = $7F80 then Error (ConstantOutOfRange);
               end;
    fptDouble: begin
                 Value.Double := Value.Extended;
                 If Value.W16 and $7FF0 = $7FF0 then Error (ConstantOutOfRange);
               end;
    else begin
          Value.Comp := Value.Extended;
          If (Value.W16 = $8000) and (Value.Word or Value.W12 or Value.W14 = 0) then
            Error (ConstantOutOfRange);
         end;
  end;
end;

                                                                                                                             {
 
 
 
© 2017 Turbo Pascal | Privacy Policy