paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 09:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

m68k: support FFU exception settings, also reworked FPU initalization

Browse Source 
git-svn-id: trunk@36618 -
This commit is contained in:
Károly Balogh 2017-06-30 02:38:14 +00:00
parent a301bf75ea
commit 2d8313165d
4 changed files with 90 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
rtl/amiga/system.pp
View File

@ -301,9 +301,6 @@ end;
begin
IsConsole := TRUE;
SysResetFPU;
if not(IsLibrary) then
SysInitFPU;
StackLength := CheckInitialStkLen(InitialStkLen);
StackBottom := Sptr - StackLength;
{ OS specific startup }

16
rtl/inc/mathh.inc
View File

@ -32,6 +32,22 @@
function GetSSECSR : dword; deprecated 'Renamed to GetMXCSR';
{$endif}
{$if defined(cpum68k)}
{$if defined(fpu68881) or defined(fpucoldfire)}
const
{$ifdef FPC_68K_SYSTEM_HAS_FPU_EXCEPTIONS}
Default68KFPCR: DWord = $3400; { Enable OVFL, OPERR and DZ, round to nearest, default precision }
{$else}
Default68KFPCR: DWord = 0;
{$endif}
procedure SetFPCR(x: DWord);
procedure SetFPSR(x: DWord);
function GetFPCR: DWord;
function GetFPSR: DWord;
{$endif}
{$endif}
type
TFPURoundingMode = (rmNearest, rmDown, rmUp, rmTruncate);
TFPUPrecisionMode = (pmSingle, pmReserved, pmDouble, pmExtended);

52
rtl/m68k/m68k.inc
View File

@ -29,23 +29,49 @@
{****************************************************************************}
{$IFDEF FPU68881}
{$DEFINE FPC_SYSTEM_HAS_SYSRESETFPU}
procedure SysResetFPU; assembler;
{$IF DEFINED(FPU68881) OR DEFINED(FPUCOLDFIRE)}
function GetFPCR: DWord; assembler; nostackframe;
asm
clr.l d0
fmove.l d0,fpcr
fmove.l fpcr,d0
end;
function GetFPSR: DWord; assembler; nostackframe;
asm
fmove.l fpsr, d0
end;
procedure SetFPCR(x: DWord); assembler; nostackframe;
asm
fmove.l x, fpcr
end;
procedure SetFPSR(x: DWord); assembler; nostackframe;
asm
fmove.l x, fpsr
end;
{$DEFINE FPC_SYSTEM_HAS_SYSRESETFPU}
procedure SysResetFPU;
begin
SetFPCR(Default68KFPCR);
SetFPSR(0);
end;
{$DEFINE FPC_SYSTEM_HAS_SYSINITFPU}
procedure SysInitFPU; assembler;
asm
clr.l d0
// FIX ME:
// move.w 0,d0 // enable a sane set of exception flags here
fmove.l d0,fpcr
procedure SysInitFPU;
begin
end;
{$ENDIF}
procedure fpc_cpuinit;
begin
if IsLibrary then
begin
Default68kFPCR:=GetFPCR;
end;
SysResetFPU;
end;
{$ELSE}
procedure fpc_cpuinit;
begin
@ -54,6 +80,8 @@ procedure fpc_cpuinit;
SysInitFPU;
end;
{$ENDIF}
{$ifndef INTERNAL_BACKTRACE}
{$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame : pointer; assembler;nostackframe;

44
rtl/m68k/mathu.inc
View File

@ -66,16 +66,19 @@ const
FPU68K_PREC_SINGLE = 1 shl FPU68K_PREC_MASK_SHIFT;
FPU68K_PREC_DOUBLE = 2 shl FPU68K_PREC_MASK_SHIFT;
const
FPU68K_EXCEPT_MASK_SHIFT = 8;
FPU68K_EXCEPT_MASK = 255 shl FPU68K_EXCEPT_MASK_SHIFT;
function GetFPCR: DWord; assembler; nostackframe;
asm
fmove.l fpcr,d0
end;
FPU68K_EXCEPT_INEX1 = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 0);
FPU68K_EXCEPT_INEX2 = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 1);
FPU68K_EXCEPT_DZ = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 2);
FPU68K_EXCEPT_UNFL = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 3);
FPU68K_EXCEPT_OVFL = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 4);
FPU68K_EXCEPT_OPERR = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 5);
FPU68K_EXCEPT_SNAN = 1 shl (FPU68K_EXCEPT_MASK_SHIFT + 6);
FPU68K_EXCEPT_BSUN = 1 shl (FPU68K_EXCEPT_MASK_SHIFt + 7);
function SetFPCR(x: DWord): DWord; assembler; nostackframe;
asm
fmove.l x, fpcr
end;
function GetExceptionMask: TFPUExceptionMask;
begin
@ -83,8 +86,28 @@ begin
end;
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
const
FPCToFPUExceptionFlags: array[TFPUException] of DWord =
( FPU68K_EXCEPT_OPERR, 0, FPU68K_EXCEPT_DZ, FPU68K_EXCEPT_OVFL, FPU68K_EXCEPT_UNFL, FPU68K_EXCEPT_INEX2 );
FPUToFPCExceptionFlags: array[0..7] of TFPUExceptionMask =
( [], [exPrecision], [exZeroDivide], [exUnderflow], [exOverflow], [exInvalidOp], [], [] );
var
oldMode, Mode: DWord;
e: TFPUException;
i: longint;
begin
result:=softfloat_exception_mask;
result:=[];
oldMode:=(GetFPCR and FPU68K_EXCEPT_MASK) shr FPU68K_EXCEPT_MASK_SHIFT;
for i:=low(FPUToFPCExceptionFlags) to high(FPUToFPCExceptionFlags) do
if ((1 shl i) and oldMode) > 0 then
result:=result+FPUToFPCExceptionFlags[i];
mode:=0;
for e in Mask do
mode:=mode or FPCToFPUExceptionFlags[e];
SetFPCR((GetFPCR and not FPU68K_EXCEPT_MASK) or (mode shl FPU68K_EXCEPT_MASK_SHIFT));
softfloat_exception_mask:=mask;
end;
@ -120,9 +143,10 @@ end;
procedure ClearExceptions(RaisePending: Boolean);
begin
SetFPCR(GetFPCR and not FPU68K_EXCEPT_MASK);
SetFPSR(0);
softfloat_exception_flags:=[];
end;
{$else}
function GetExceptionMask: TFPUExceptionMask;