paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 19:29:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ SetFPUExceptionMask implementation for PPC

Browse Source
This commit is contained in:
Jonas Maebe 2004-01-02 16:50:24 +00:00
parent 0a74dd10a4
commit c094978054
1 changed files with 57 additions and 1 deletions

58
compiler/globals.pas
View File

@ -1273,9 +1273,62 @@ implementation
Result:=TFPUExceptionMask(CtlWord and $3F);
end;
{$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;
begin
end;
{$endif CPUPOWERPC}
{$endif CPUI386}
function is_number_float(d : double) : boolean;
@ -1744,7 +1797,10 @@ implementation
end.
{
$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
+ single data type operations with sse unit
* fixed more x86-64 stuff