unit poly_2xm1;

interface

uses fpu_types;

const
  HIPOWER = 11;

const
  lterms: array64_10 = (
    ($0000000000000000),
    ($f5fdeffc162c7543),
    ($1c6b08d704a0bfa6),
    ($0276556df749cc21),
    ($002bb0ffcf14f6b8),
    ($0002861225ef751c),
    ($00001ffcbfcd5422),
    ($00000162c005d5f1),
    ($0000000da96ccb1b),
    ($0000000078d1b897),
    ($000000000422b029));

const
  hiterm: Xsig = (lsw: $c8a39194; midw: $d1cf79ab; msw: $b17217f7);

const
  shiftterm0: Xsig = (lsw: 0; midw: 0; msw: 0);

const
  shiftterm1: Xsig = (lsw: $9837f051; midw: $8db8a96f; msw: $46ad2318);

const
  shiftterm2: Xsig = (lsw: $b504f333; midw: $f9de6484; msw: $597d89b3);

const
  shiftterm3: Xsig = (lsw: $d744fcca; midw: $d69d6af4; msw: $39a68bb9);

const
  shiftterm: array[0..3] of PXsig =
    (@shiftterm0, @shiftterm1, @shiftterm2, @shiftterm3);


implementation

uses Service_fpu, Math, fpu_system, polynom_xsig, mul_Xsig, shr_Xsig_unit,
  div_xsig_unit, round_Xsig_unit, reg_round, fpu_tags;

function poly_2xm1 (sign: u_char; arg: PFPU_REG; res: PFPU_REG): intg;
  var
    exponent, shift: s32;
    Xll: u64;
    accumulator, Denom, argSignif: Xsig;
    tag: u_char;
  begin

    exponent := exponent16(arg);

{$ifdef PARANOID}
  if ( exponent >= 0 )    	(* Don't want a |number| >= 1.0 *)
    begin
      (* Number negative, too large, or not Valid. *)
      EXCEPTION(EX_INTERNAL|$127);
      return 1;
    end;
{$endif}(* PARANOID *)

    argSignif.lsw := 0;
    Xll := significand(arg)^;
    pu64(@argSignif.msw)^ := Xll;

    if (exponent = -1) then
      begin
      shift := ifthen(argSignif.msw and $40000000 <> 0, 3, 2);
      (* subtract 0.5 or 0.75 *)
      exponent := exponent - 2;
      pu64(@argSignif.msw)^ := pu64(@argSignif.msw)^ shl 2;
      Xll := Xll shl 2;
      end
    else
      if (exponent = -2) then
        begin
        shift := 1;
        (* subtract 0.25 *)
        Dec(exponent);
        pu64(@argSignif.msw)^ := pu64(@argSignif.msw)^ shl 1;
        Xll := Xll shl 1;
        end
      else
        shift := 0;

    if (exponent < -2) then
      begin
      (* Shift the argument right by the required places. *)
      if (FPU_shrx(@Xll, -2 - exponent) >= $8000) then
        Inc(Xll);  (* round up *)
      end;

    accumulator.msw  := 0;
    accumulator.midw := 0;
    accumulator.lsw  := 0;
    polynomial_Xsig(@accumulator, @Xll, lterms, HIPOWER - 1);
    mul_Xsig_Xsig(@accumulator, @argSignif);
    shr_Xsig(@accumulator, 3);

    mul_Xsig_Xsig(@argSignif, @hiterm);   (* The leading term *)
    add_two_Xsig(@accumulator, @argSignif, @exponent);

    if (shift) <> 0 then
      begin
      (* The argument is large, use the identity:
   f(x+a) := f(a) * (f(x) + 1) - 1;
   *)
      shr_Xsig(@accumulator, -exponent);
      accumulator.msw := accumulator.msw or $8000;      (* add 1.0 *)
      mul_Xsig_Xsig(@accumulator, shiftterm[shift]);
      accumulator.msw := accumulator.msw and $3fffffff;      (* subtract 1.0 *)
      exponent := 1;
      end;

    if (sign <> SIGN_POS) then
      begin
      (* The argument is negative, use the identity:
       f(-x) := -f(x) / (1 + f(x))
   *)
      Denom.lsw := accumulator.lsw;
      pu64(@Denom.msw)^ := pu64(@accumulator.msw)^;
      if (exponent < 0) then
        shr_Xsig(@Denom, -exponent)
      else
        if (exponent > 0) then
          begin
          (* exponent must be 1 here *)
          pu64(@Denom.msw)^ := pu64(@Denom.msw)^ shl 1;
          if (Denom.lsw and $8000) <> 0 then
            pu64(@Denom.msw)^ := pu64(@Denom.msw)^ or 1;
          Denom.lsw := (Denom.lsw) shl 1;
          end;
      Denom.msw := Denom.msw or $8000;      (* add 1.0 *)
      div_Xsig(@accumulator, @Denom, @accumulator);
      end;

    (* Convert to 64 bit signed-compatible *)
    exponent := exponent + round_Xsig(@accumulator);

    Result := longint(st(0));
    significand(st(0))^ := pu64(@accumulator)^;
    setexponent16(PFPU_REG(Result), exponent);

    tag := FPU_round(PFPU_REG(Result), 1, 0, FULL_PRECISION, sign);

    setsign(PFPU_REG(Result), sign);
    FPU_settag0(tag);

    Result := 0;

  end;

end.
