FPU and Int08 - Possible explanation?

This is a multi-part message in MIME format.

--------------5C564B607EEB
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

Hello all,

I have seen 2 threads recently about problems with TP's floating-point
support when you also hook interrupts (specifically the timer, Int 08).

I have done a little bit of digging...

Firstly, it seems that TP never generates FPU instructions when it
compiles your code, no matter what compiler options you set. Instead it
seems to call a dedicated library of FPU-code; TP decides which library
to use at link/run time as follows:

{$N+,E-} Use the native x87 library.
{$N+,E+} Link in Borland's FPU emulation library as well as the x87
library.
         Determine which library to use at run-time.
{$N-}    Use the non-FPU library (the "Real" type).

The example program calls the Round() function both in an interrupt
handler
and in the main program. When Round() fails, you can see that the main
program has (somehow) obtained the result from the handler.

The solution is to assemble some of the FPU code by hand, thus avoiding
the non-reentrant nature of the library. Using Round87() instead of
one (or both) of the Round()s does the trick.

Chris.

--------------5C564B607EEB
Content-Type: text/plain; charset=us-ascii; name="TestFP.pas"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="TestFP.pas"

{$Q+,R+}
{$G+}
{$E-,N+}

{$ifdef CPU87}
{$DEFINE OwnFPUCode}
{$endif}

program testfp;

uses dos, FPUtils;

const epsi=0.00001;

procedure DisableInterrupts; inline($FA);
procedure EnableInterrupts; inline($FB);

type
  TProcedure = procedure;

type
  TestReal = {$ifopt n+} Extended
             {$else}     Real
             {$endif};

var
l:longint;
r,diff: TestReal;
OldInt08: TProcedure;

{ Sample asynchronous task}

const Int08Busy: Boolean = False;

procedure conttask; interrupt;
const
  NegFour: Extended = -4.0;
var
LocalInt:  longint;
salva_fpu: array[1..94] of byte;
label
QuickExit;

begin
{
  Timer interrupt - make sure doesn't interrupt itself ...

Quote
}

  asm
     MOV AL, True
     XCHG Int08Busy, AL
     TEST AL, AL
     JNZ QuickExit
  end;
{$ifopt n+}
{$ifdef CPU87}
     asm
       fsave[salva_fpu];
     end;
{$endif}
{$endif}

    {$ifdef OwnFPUCode}
      LocalInt := Round87(-4.0*r);
    {$else}
      LocalInt := round(-4.0*r); { Doesn't matter what the operand is }
    {$endif}

{$ifopt n+}
{$ifdef CPU87}
     asm
       frstor[salva_fpu];
     end;
{$endif}
{$endif}
  Int08Busy := False;

QuickExit:
  asm
    PUSHF
  end;
  OldInt08
end;

{
  Install new INT 08 ...

Quote
}

procedure attivacont;
begin
  getintvec($08,@OldInt08);
  setintvec($08,@conttask)
end;

{ Back to normal }

procedure disattivacont;

begin
  setintvec($08,@OldInt08)
end;

var ExitSave: Pointer;

procedure ExitProcedure; far;
begin
  ExitProc := ExitSave;
  disattivacont
end;

{
  Main program

Quote
}

begin
{$ifdef CPU87}
  Writeln( 'Machine supports FPU' );
{$endif}
{$ifopt n+}
  Writeln( 'Compiled to use co-processor' );
{$endif}
{$ifopt e+}
  Writeln( 'FPU is emulated' );
{$endif}

   attivacont;
   ExitSave := ExitProc;
   ExitProc := @ExitProcedure;

   r := 1;
   repeat

  {$ifndef OwnFPUCode}
    l := Round87(r);
  {$else}
     l:=round(r);
  {$endif}
     diff:= abs(r-l); {difference should be less than 1 }
       IF(diff>1) THEN
         begin
           writeln('Error in function round()!');
           break;
         end;
    r:=r+epsi;

   until (r>50);
   writeln( 'r = ', r, ' l=', l );

  end.

--------------5C564B607EEB
Content-Type: text/plain; charset=us-ascii; name="FPUtils.pas"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="FPUtils.pas"

{$E-,N+,G+,R-,S-}

unit FPUtils;

interface

function Round87(const X: Extended): LongInt;
function Trunc87(const X: Extended): LongInt;

implementation

type
  TWordRec = record
               Lo, Hi: Byte
             end;

{
  Rounds X towards nearest integer. If X halfway between two
  integers then rounds towards one with greater absolute magnitude ...

Quote
}

function Round87(const X: Extended): LongInt; assembler;
const
  FPUHalf: Extended = 0.5;
{$ifopt g-}
var
  FPUFlags: Word;
{$endif}
asm
{
  Determine sign of X, and load FPU flags into AX ...
Quote
}

  FLD X
  FXAM
{$ifopt g+}
  FSTSW AX
{$else}
  FSTSW FPUFlags
  MOV AX, FPUFlags
{$endif}
  FLD FPUHalf
{
  FPU's sign-flag is bit 1 of AH. 1 = -ve, 0 = +ve ...
Quote
}

  TEST AH, 00000010b
  JZ @Add
{
  If we are here then X was negative. Hence we make ST(0) negative,
  so that we end up subtracting 0.5 instead of adding 0.5
Quote
}

  FCHS
@Add:
  FADDP
{
  We only want the integer part of this number ... call Trunc87()
Quote
}

@Store:
  SUB SP, TYPE Extended
  MOV BX, SP
  FSTP Extended PTR SS:[BX]

  PUSH CS
  CALL NEAR PTR Trunc87
end;

function Trunc87(const X: Extended): LongInt;
var
  FPUControlWord: Word;
const
  NewControlWordOfs = SizeOf(LongInt) + 2*SizeOf(FPUControlWord);
begin
  asm
{
  We are going to modify the rounding-control bits in the
  FPU's control word - save the original ...

Quote
}

    FNSTCW FPUControlWord
{
  Now make a copy (to modify) ...
Quote
}

    PUSH FPUControlWord
    OR TWordRec[BP-NewControlWordOfs].Hi, 00001100b
    FLDCW [BP-NewControlWordOfs]
    POP AX
{
  The new control word is now loaded: convert X to an integer ...
Quote
}

    FLD X
    fistP @Result
{
  Restore original control word ...
Quote
}

    FLDCW FPUControlWord
  end
end;

end.

--------------5C564B607EEB--