unit fpu_tags;

interface

uses service_fpu, fpu_types, fpu_system;

function FPU_gettag0: intg;
procedure FPU_settag (regnr: intg; tag: intg);
function isNaN (ptr: PFPU_REG): intg;
procedure FPU_settag0 (tag: intg);
function FPU_stackoverflow (var st_new_ptr: PFPU_REG): intg;

implementation

function FPU_gettag0: intg;
  begin
    Result := (I387.soft.twd shr ((top and 7) * 2)) and 3;
  end;

procedure FPU_settag (regnr: intg; tag: intg);
  begin
    regnr := regnr and 7;
    I387.soft.twd := I387.soft.twd and not (3 shl (regnr * 2));
    I387.soft.twd := I387.soft.twd or (tag and 3) shl (regnr * 2);
  end;

procedure FPU_settag0 (tag: intg);
  var
    regnr: intg;
  begin
    regnr := top;
    regnr := regnr and 7;
    I387.soft.twd := I387.soft.twd and not (3 shl (regnr * 2));
    I387.soft.twd := I387.soft.twd or (tag and 3) shl (regnr * 2);
  end;

function isNaN (ptr: PFPU_REG): intg;
  begin
    Result := word((exponent(ptr) = EXP_BIAS + EXP_OVER) and
      ((ptr^.sigh = $8000) and (ptr^.sigl = 0)) = False);
  end;

function FPU_stackoverflow (var st_new_ptr: PFPU_REG): intg;
  begin
    st_new_ptr := st(-1);

    Result := word(((I387.soft.twd shr (((I387.soft.ftop - 1) and 7) * 2)) and 3) <>
      TAG_Empty);
  end;

end.
