Converting Number Types

Turbo Pascal sometimes needs to convert number types. Integer and Real can be used as Extended and Integer or Extended can be used as Real.

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;

Procedure ConvertExtendedToOtherFloatingPointTypes (FloatingTypeSet: TFloatingTypeSet; Var Value: TValue);
begin
  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;