unit reg_divide;

interface

uses service_fpu, fpu_types;

function FPU_div (flags: intg; rm: PFPU_REG; control_w: intg): intg;

implementation

uses errors, fpu_system, reg_convert, Math, fpu_tags;

(*
  Divide one register by another and put the result into a third register.
bbd: arg2 used to be an int, see comments on FPU_sub.
  *)
function FPU_div (flags: intg; rm: PFPU_REG; control_w: intg): intg;
  var
    x, y: FPU_REG;
    a, b, st0_ptr, st_ptr: PFPU_REG;
    dest: PFPU_REG;
    taga, tagb, signa, signb, sign, saved_sign: u_char;
    tag, deststnr: intg;
    rmint: intg;
    P: PFPU_REG;
  begin
    rmint := bx_ptr_equiv_t(rm);

    if (flags and DEST_RM) <> 0 then
      deststnr := rmint
    else
      deststnr := 0;

    if (flags and REV) <> 0 then
      begin
      b := st(0);
      st0_ptr := b;
      tagb := FPU_gettag0();
      if (flags and LOADED) <> 0 then
        begin
        a := rm;
        taga := flags and $0f;
        end
      else
        begin
        a := st(rmint);
        st_ptr := a;
        taga := FPU_gettagi(rmint);
        end;
      end
    else
      begin
      a := st(0);
      st0_ptr := a;
      taga := FPU_gettag0();
      if (flags and LOADED) <> 0 then
        begin
        b := rm;
        tagb := flags and $0f;
        end
      else
        begin
        b := st(rmint);
        st_ptr := b;
        tagb := FPU_gettagi(rmint);
        end;
      end;

    signa := getsign(a);
    signb := getsign(b);

    sign := signa xor signb;

    dest := st(deststnr);
    saved_sign := getsign(dest);

    if ((taga or tagb) = 0) then
      begin
      (* Both regs Valid, this should be the most common case. *)
      reg_copy(a, @x);
      reg_copy(b, @y);
      setpositive(@x);
      setpositive(@y);
      tag := FPU_u_div(@x, @y, dest, control_w, sign);

      if (tag < 0) then
        begin
        Result := tag;
        Exit;
        end;

      FPU_settagi(deststnr, tag);
      Result := tag;
      Exit;
      end;

    if (taga = TAG_Special) then
      taga := FPU_Special(a);
    if (tagb = TAG_Special) then
      tagb := FPU_Special(b);

    if (((taga = TAG_Valid) and (tagb = TW_Denormal)) or
      ((taga = TW_Denormal) and (tagb = TAG_Valid)) or
      ((taga = TW_Denormal) and (tagb = TW_Denormal))) then
      begin
      if (denormal_operand() < 0) then
        begin
        Result := FPU_Exception_c;
        Exit;
        end;

      FPU_to_exp16(a, @x);
      FPU_to_exp16(b, @y);
      tag := FPU_u_div(@x, @y, dest, control_w, sign);
      if (tag < 0) then
        begin
        Result := tag;
        Exit;
        end;

      FPU_settagi(deststnr, tag);
      Result := tag;
      Exit;
      end
    else
      if ((taga <= TW_Denormal) and (tagb <= TW_Denormal)) then
        begin
        if (tagb <> TAG_Zero) then
          begin
          (* Want to find Zero/Valid *)
          if (tagb = TW_Denormal) then
            begin
            if (denormal_operand() < 0) then
              begin
              Result := FPU_Exception_c;
              Exit;
              end;
            end;

          (* The result is zero. *)
          FPU_copy_to_regi(@CONST_Z, TAG_Zero, deststnr);
          setsign(dest, sign);
          Result := TAG_Zero;
          Exit;
          end;
        (* We have an exception condition, either 0/0 or Valid/Zero. *)
        if (taga = TAG_Zero) then
          begin
          (* 0/0 *)
          Result := arith_invalid(deststnr);
          Exit;
          end;
        (* Valid/Zero *)
        Result := FPU_divide_by_zero(deststnr, sign);
        exit;
        end
      (* Must have infinities, NaNs, etc *)
      else
        if ((taga = TW_NaN) or (tagb = TW_NaN)) then
          begin
          if (flags and LOADED) <> 0 then
            begin
            Result := real_2op_NaN(PFPU_REG(rm), flags and $0f, 0, st0_ptr);
            Exit;
            end;

          if (flags and DEST_RM) <> 0 then
            begin
            tag := FPU_gettag0();
            if (tag = TAG_Special) then
              tag := FPU_Special(st0_ptr);
            if (flags and REV) <> 0 then
              p := st0_ptr
            else
              p := st(rmint);
            Result := real_2op_NaN(st0_ptr, tag, rmint, p);
            Exit;
            end
          else
            begin
            tag := FPU_gettagi(rmint);
            if (tag = TAG_Special) then
              tag := FPU_Special(st(rmint));
            if (flags and REV) <> 0 then
              p := st0_ptr
            else
              p := st(rmint);
            Result := real_2op_NaN(st(rmint), tag, 0, p);
            exit;
            end;
          end
        else
          if (taga = TW_Infinity) then
            begin
            if (tagb = TW_Infinity) then
              begin
              (* infinity/infinity *)
              Result := arith_invalid(deststnr);
              Exit;
              end
            else
              begin
              (* tagb must be Valid or Zero *)
              if ((tagb = TW_Denormal) and (denormal_operand() < 0)) then
                Result := FPU_Exception_c;
              Exit;

    (* Infinity divided by Zero or Valid does
       not raise and exception, but returns Infinity *)
              FPU_copy_to_regi(a, TAG_Special, deststnr);
              setsign(dest, sign);
              Result := taga;
              exit;
              end;
            end
          else
            if (tagb = TW_Infinity) then
              begin
              if ((taga = TW_Denormal) and (denormal_operand() < 0)) then
                begin
                Result := FPU_Exception_c;
                Exit;
                end;

              (* The result is zero. *)
              FPU_copy_to_regi(@CONST_Z, TAG_Zero, deststnr);
              setsign(dest, sign);
              Result := TAG_Zero;
              Exit;
              end;
{$ifdef PARANOID}
  else
    begin
      EXCEPTION(EX_INTERNAL|$102);
      return FPU_Exception;
    end;
{$endif}(* PARANOID *)

  end;

end.
