{$ifdef LINUX}
{$include ../defines.pas}
{$else}
{$include ..\defines.pas}
{$endif}
unit fpu_aux;

interface

procedure fnop;
procedure fclex;
procedure finit;
procedure fld_i_;
procedure ffree_;
procedure fxch_i;
procedure fp_nop;
procedure fst_i_ ();
procedure fstp_i ();
procedure finit_;
procedure fstsw_ ();

{$include fpu_const.pas}
implementation

uses fpu_system, fpu_types, Service_fpu, fpu_tags, errors, SysUtils;

var
  AlreadyGone: boolean = False;

procedure fnop;
  begin
  end;

procedure fclex;
  begin
    I387.soft.swd := I387.soft.swd and not (SW_Backward or SW_Summary or
      SW_Stack_Fault or SW_Precision or SW_Underflow or SW_Overflow or
      SW_Zero_Div or SW_Denorm_Op or SW_Invalid);
    I387.soft.no_update := 1;
  end;

(* Needs to be externally visible *)
procedure finit;
  begin
    if not alreadygone then
      fp_fpu := fileopen('C:\bochs-1.4.1\merge\fpu$.bin', fmOpenRead);
    alreadygone := True;
    I387.soft.cwd  := $037f;
    I387.soft.swd  := 0;
    I387.soft.ftop := 0;
    (* We don't keep I387.soft.ftop in the status word internally. *)
    I387.soft.twd  := $ffff;
  (* The behaviour is different from that detailed in
     Section 15.1.6 of the Intel manual *)
    paddress(@I387.soft.foo)^.offset := 0;
    paddress(@I387.soft.foo)^.selector := 0;
    paddress(@I387.soft.fip)^.offset := 0;
    paddress(@I387.soft.fip)^.selector := 0;
    paddress(@I387.soft.fip)^.opcode := 0;
    I387.soft.no_update := 1;
  end;

(*
 * These are nops on the i387..
 *)
 //#define feni fnop
 //#define fdisi fnop
 //#define fsetpm fnop

const
  finit_table: array[0..7] of procedure = (
    fnop, fnop, fclex, finit,
    fnop, FPU_illegal, FPU_illegal, FPU_illegal);

procedure finit_;
  var
    PosProc: integer;
  begin
    PosProc := FPU_rm^;
    (finit_table[PosProc]);
  end;

procedure fstsw_ax;
  begin
    fpu_cpu_ptr^.gen_reg[0].rx := (status_word()); // KPL
    I387.soft.no_update := 1;
  end;

const
  fstsw_table: array[0..7] of procedure = (
    fstsw_ax, FPU_illegal, FPU_illegal, FPU_illegal,
    FPU_illegal, FPU_illegal, FPU_illegal, FPU_illegal);

procedure fstsw_ ();
  begin
    (fstsw_table[FPU_rm^]);
  end;


const
  fp_nop_table: array[0..7] of procedure = (
    fnop, FPU_illegal, FPU_illegal, FPU_illegal,
    FPU_illegal, FPU_illegal, FPU_illegal, FPU_illegal);

procedure fp_nop ();
  begin
    (fp_nop_table[FPU_rm^]);
  end;


procedure fld_i_;
  var
    st_new_ptr: PFPU_REG;
    i: intg;
    tag: u_char;
  begin

    if FPU_stackoverflow(st_new_ptr) <> 0 then
      begin
      FPU_stack_overflow();
      exit;
      end;

    (* fld st(i) *)
    i := FPU_rm^;
    if (FPU_empty_i(i)) <> 0 then
      begin
      reg_copy(st(i), st_new_ptr);
      tag := FPU_gettagi(i);
      Dec(I387.soft.ftop);
      FPU_settag0(tag);
      end
    else
      begin
      if (I387.soft.cwd and CW_Invalid) <> 0 then
        begin
        (* The masked response *)
        FPU_stack_underflow();
        end
      else
        fpu_EXCEPTION(EX_StackUnder);
      end;

  end;

procedure fxch_i ();
  var
    t: FPU_REG;
    i: intg;
    st0_ptr, sti_ptr: PFPU_REG;
    tag_word: s32;
    regnr, regnri: intg;
    st0_tag: u_char;
    sti_tag: u_char;
  begin
    (* fxch st(i) *)
    i := fpu_rm^;
    st0_ptr := st(0);
    sti_ptr := st(i);
    tag_word := I387.soft.twd;
    regnr := I387.soft.ftop and 7;
    regnri := ((regnr + i) and 7);
    st0_tag := (tag_word shr (regnr * 2)) and 3;
    sti_tag := (tag_word shr (regnri * 2)) and 3;

    if (st0_tag = TAG_Empty) then
      begin
      if (sti_tag = TAG_Empty) then
        begin
        FPU_stack_underflow();
        FPU_stack_underflow_i(i);
        exit;
        end;
      if (I387.soft.cwd and CW_Invalid) <> 0 then
        begin
        (* Masked response *)
        FPU_copy_to_reg0(sti_ptr, sti_tag);
        end;
      FPU_stack_underflow_i(i);
      exit;
      end;
    if (sti_tag = TAG_Empty) then
      begin
      if (I387.soft.cwd and CW_Invalid) <> 0 then
        begin
        (* Masked response *)
        FPU_copy_to_regi(st0_ptr, st0_tag, i);
        end;
      FPU_stack_underflow();
      exit;
      end;
    clear_C1();

    reg_copy(st0_ptr, @t);
    reg_copy(sti_ptr, st0_ptr);
    reg_copy(@t, sti_ptr);

    tag_word := tag_word and not (3 shl (regnr * 2)) and not (3 shl (regnri * 2));
    tag_word := tag_word or (sti_tag shl (regnr * 2)) or (st0_tag shl (regnri * 2));
    I387.soft.twd := tag_word;
  end;


procedure ffree_ ();
  begin
    (* ffree st(i) *)
    FPU_settagi(FPU_rm^, TAG_Empty);
  end;


procedure ffreep ();
  begin
    (* ffree st(i) + pop - unofficial code *)
    FPU_settagi(FPU_rm^, TAG_Empty);
    FPU_pop();
  end;


procedure fst_i_ ();
  begin
    (* fst st(i) *)
    FPU_copy_to_regi(st(0), FPU_gettag0(), FPU_rm^);
  end;


procedure fstp_i ();
  begin
    (* fstp st(i) *)
    FPU_copy_to_regi(st(0), FPU_gettag0(), FPU_rm^);
    FPU_pop();
  end;


end.
