mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-12 16:18:20 +02:00
+ SetFPUExceptionMask implementation for PPC
This commit is contained in:
parent
0a74dd10a4
commit
c094978054
@ -1273,9 +1273,62 @@ implementation
|
|||||||
Result:=TFPUExceptionMask(CtlWord and $3F);
|
Result:=TFPUExceptionMask(CtlWord and $3F);
|
||||||
end;
|
end;
|
||||||
{$else CPUI386}
|
{$else CPUI386}
|
||||||
|
{$ifdef CPUPOWERPC}
|
||||||
|
function SetFPUExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
|
||||||
|
var
|
||||||
|
newmask: record
|
||||||
|
case byte of
|
||||||
|
1: (d: double);
|
||||||
|
2: (a,b: cardinal);
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
{ load currect control register contents }
|
||||||
|
asm
|
||||||
|
mffs f0
|
||||||
|
stfd f0,newmask.d
|
||||||
|
end;
|
||||||
|
{ invalid operation: bit 24 (big endian, bit 0 = left-most bit) }
|
||||||
|
if (exInvalidOp in mask) then
|
||||||
|
newmask.b := newmask.b and not(1 shl (31-24))
|
||||||
|
else
|
||||||
|
newmask.b := newmask.b or (1 shl (31-24));
|
||||||
|
|
||||||
|
{ denormals can not cause exceptions on the PPC }
|
||||||
|
|
||||||
|
{ zero divide: bit 27 }
|
||||||
|
if (exZeroDivide in mask) then
|
||||||
|
newmask.b := newmask.b and not(1 shl (31-27))
|
||||||
|
else
|
||||||
|
newmask.b := newmask.b or (1 shl (31-27));
|
||||||
|
|
||||||
|
{ overflow: bit 25 }
|
||||||
|
if (exOverflow in mask) then
|
||||||
|
newmask.b := newmask.b and not(1 shl (31-25))
|
||||||
|
else
|
||||||
|
newmask.b := newmask.b or (1 shl (31-25));
|
||||||
|
|
||||||
|
{ underflow: bit 26 }
|
||||||
|
if (exUnderflow in mask) then
|
||||||
|
newmask.b := newmask.b and not(1 shl (31-26))
|
||||||
|
else
|
||||||
|
newmask.b := newmask.b or (1 shl (31-26));
|
||||||
|
|
||||||
|
{ Precision (inexact result): bit 28 }
|
||||||
|
if (exUnderflow in mask) then
|
||||||
|
newmask.b := newmask.b and not(1 shl (31-28))
|
||||||
|
else
|
||||||
|
newmask.b := newmask.b or (1 shl (31-28));
|
||||||
|
{ update control register contents }
|
||||||
|
asm
|
||||||
|
lfd f0, newmask.d
|
||||||
|
mtfsf 255,f0
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$else CPUPOWERPC}
|
||||||
function SetFPUExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
|
function SetFPUExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
|
||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
|
{$endif CPUPOWERPC}
|
||||||
{$endif CPUI386}
|
{$endif CPUI386}
|
||||||
|
|
||||||
function is_number_float(d : double) : boolean;
|
function is_number_float(d : double) : boolean;
|
||||||
@ -1744,7 +1797,10 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.118 2003-12-25 01:07:09 florian
|
Revision 1.119 2004-01-02 16:50:24 jonas
|
||||||
|
+ SetFPUExceptionMask implementation for PPC
|
||||||
|
|
||||||
|
Revision 1.118 2003/12/25 01:07:09 florian
|
||||||
+ $fputype directive support
|
+ $fputype directive support
|
||||||
+ single data type operations with sse unit
|
+ single data type operations with sse unit
|
||||||
* fixed more x86-64 stuff
|
* fixed more x86-64 stuff
|
||||||
|
Loading…
Reference in New Issue
Block a user