with System.Machine_Code;
use System.Machine_Code;

pragma Optimize (Off);

package body Rounding.FPU is

  function Union(A,B: R_Set) return R_Set renames "or";

  procedure Set_Rounding_Mode(M: in Rounding_Mode) is
    W: R_Set;
  begin
    if (M.Mask = Strict) then
      case M.Direction is
        when Up        => W := Union(R_Strict,R_Up);
        when Nearest   => W := Union(R_Strict,R_Nearest);
        when Down      => W := Union(R_Strict,R_Down);
        when Truncate  => W := Union(R_Strict,R_Truncate);
      end case;
    else
      case M.Direction is
        when Nearest   => W := Union(R_Relaxed,R_Nearest);
        when Up        => W := Union(R_Relaxed,R_Up);
        when Down      => W := Union(R_Relaxed,R_Down);
        when Truncate  => W := Union(R_Relaxed,R_Truncate);
      end case;
    end if;

    if Current_Rounding_Mode.Mask=Relaxed then
      --- clear exception flags
      Asm("fnclex",Volatile => True);
      --- load control word into FPU
      Asm("fldcw %0",Inputs => R_Set'Asm_Input("g",W), Volatile => True);
    else
      --- clear exception flags after handling pending unmasked exceptions
      Asm("fclex",Volatile => True);
      --- load control word into FPU
      Asm("fldcw %0",Inputs => R_Set'Asm_Input("g",W), Volatile => True);
    end if;
    Current_Rounding_Mode := M;
  end Set_Rounding_Mode;

  function Get_Rounding_Mode return Rounding_Mode is
  begin
    return Current_Rounding_Mode;
  end Get_Rounding_Mode;

  procedure Default_Rounding_Mode is
  begin
    Set_Rounding_Mode((Nearest,Relaxed));
  end Default_Rounding_Mode;

end Rounding.FPU;
