mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-26 00:01:47 +02:00
* i386 and x86_64 changes for Delphi compatibility:
* 'mxcsr' variable made public and renamed to DefaultMXCSR. * GetSSECSR and SetSSECSR renamed to GetMXCSR and SetMXCSR, respectively. Previous names continue to exist as deprecated aliases. git-svn-id: trunk@27656 -
This commit is contained in:
parent
7ba0b03cd0
commit
b16c6f8ced
@ -1334,8 +1334,6 @@ const
|
|||||||
MM_MaskUnderflow = %0000100000000000;
|
MM_MaskUnderflow = %0000100000000000;
|
||||||
MM_MaskPrecision = %0001000000000000;
|
MM_MaskPrecision = %0001000000000000;
|
||||||
|
|
||||||
mxcsr : dword = MM_MaskUnderflow or MM_MaskPrecision or MM_MaskDenorm;
|
|
||||||
|
|
||||||
|
|
||||||
{$define FPC_SYSTEM_HAS_SYSINITFPU}
|
{$define FPC_SYSTEM_HAS_SYSINITFPU}
|
||||||
Procedure SysInitFPU;
|
Procedure SysInitFPU;
|
||||||
@ -1358,7 +1356,7 @@ Procedure SysResetFPU;
|
|||||||
end;
|
end;
|
||||||
if has_sse_support then
|
if has_sse_support then
|
||||||
begin
|
begin
|
||||||
localmxcsr:=mxcsr;
|
localmxcsr:=DefaultMXCSR;
|
||||||
asm
|
asm
|
||||||
{ setup sse exceptions }
|
{ setup sse exceptions }
|
||||||
ldmxcsr localmxcsr
|
ldmxcsr localmxcsr
|
||||||
@ -1406,7 +1404,7 @@ procedure fpc_cpucodeinit;
|
|||||||
begin
|
begin
|
||||||
Default8087CW:=Get8087CW;
|
Default8087CW:=Get8087CW;
|
||||||
if has_sse_support then
|
if has_sse_support then
|
||||||
mxcsr:=GetSSECSR;
|
DefaultMXCSR:=GetMXCSR;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
SysResetFPU;
|
SysResetFPU;
|
||||||
|
|||||||
@ -61,16 +61,16 @@
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure SetSSECSR(w : dword);
|
procedure SetMXCSR(w : dword);
|
||||||
begin
|
begin
|
||||||
mxcsr:=w;
|
defaultmxcsr:=w;
|
||||||
asm
|
asm
|
||||||
ldmxcsr w
|
ldmxcsr w
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function GetSSECSR : dword;
|
function GetMXCSR : dword;
|
||||||
var
|
var
|
||||||
_w : dword;
|
_w : dword;
|
||||||
begin
|
begin
|
||||||
@ -80,6 +80,17 @@
|
|||||||
result:=_w;
|
result:=_w;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SetSSECSR(w : dword);
|
||||||
|
begin
|
||||||
|
SetMXCSR(w);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetSSECSR: dword;
|
||||||
|
begin
|
||||||
|
result:=GetMXCSR;
|
||||||
|
end;
|
||||||
|
|
||||||
{****************************************************************************
|
{****************************************************************************
|
||||||
EXTENDED data type routines
|
EXTENDED data type routines
|
||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
|
|||||||
@ -150,7 +150,7 @@ begin
|
|||||||
CtlWord := Get8087CW;
|
CtlWord := Get8087CW;
|
||||||
Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
|
Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
|
||||||
if has_sse_support then
|
if has_sse_support then
|
||||||
SetSSECSR((GetSSECSR and $ffff9fff) or (dword(RoundMode) shl 13));
|
SetMXCSR((GetMXCSR and $ffff9fff) or (dword(RoundMode) shl 13));
|
||||||
Result := TFPURoundingMode((CtlWord shr 10) and 3);
|
Result := TFPURoundingMode((CtlWord shr 10) and 3);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -180,7 +180,7 @@ begin
|
|||||||
CtlWord := Get8087CW;
|
CtlWord := Get8087CW;
|
||||||
Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
|
Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
|
||||||
if has_sse_support then
|
if has_sse_support then
|
||||||
SetSSECSR((GetSSECSR and $ffffe07f) or (dword(Mask) shl 7));
|
SetMXCSR((GetMXCSR and $ffffe07f) or (dword(Mask) shl 7));
|
||||||
Result := TFPUExceptionMask(Longint(CtlWord and $3F));
|
Result := TFPUExceptionMask(Longint(CtlWord and $3F));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|||||||
@ -87,7 +87,7 @@ Function DoSafeLoadLibrary(const Name : UnicodeString) : TLibHandle;
|
|||||||
{$ifdef cpui386}
|
{$ifdef cpui386}
|
||||||
if has_sse_support then
|
if has_sse_support then
|
||||||
{$endif cpui386}
|
{$endif cpui386}
|
||||||
ssecw:=GetSSECSR;
|
ssecw:=GetMXCSR;
|
||||||
{$endif}
|
{$endif}
|
||||||
Result:=doloadlibrary(Name);
|
Result:=doloadlibrary(Name);
|
||||||
finally
|
finally
|
||||||
@ -96,7 +96,7 @@ Function DoSafeLoadLibrary(const Name : UnicodeString) : TLibHandle;
|
|||||||
{$ifdef cpui386}
|
{$ifdef cpui386}
|
||||||
if has_sse_support then
|
if has_sse_support then
|
||||||
{$endif cpui386}
|
{$endif cpui386}
|
||||||
SetSSECSR(ssecw);
|
SetMXCSR(ssecw);
|
||||||
{$endif}
|
{$endif}
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|||||||
@ -20,10 +20,16 @@
|
|||||||
|
|
||||||
procedure Set8087CW(cw:word);
|
procedure Set8087CW(cw:word);
|
||||||
function Get8087CW:word;
|
function Get8087CW:word;
|
||||||
{$ifndef cpui8086}
|
{$endif}
|
||||||
procedure SetSSECSR(w : dword);
|
|
||||||
function GetSSECSR : dword;
|
{$if defined (cpui386) or defined(cpux86_64)}
|
||||||
{$endif not cpui8086}
|
const
|
||||||
|
DefaultMXCSR: dword = $1900;
|
||||||
|
|
||||||
|
procedure SetMXCSR(w: dword);
|
||||||
|
function GetMXCSR: dword;
|
||||||
|
procedure SetSSECSR(w : dword); deprecated 'Renamed to SetMXCSR';
|
||||||
|
function GetSSECSR : dword; deprecated 'Renamed to GetMXCSR';
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|||||||
@ -695,7 +695,7 @@ function SafeLoadLibrary(const FileName: AnsiString;
|
|||||||
{$ifdef cpui386}
|
{$ifdef cpui386}
|
||||||
if has_sse_support then
|
if has_sse_support then
|
||||||
{$endif cpui386}
|
{$endif cpui386}
|
||||||
ssecw:=GetSSECSR;
|
ssecw:=GetMXCSR;
|
||||||
{$endif}
|
{$endif}
|
||||||
{$if defined(windows) or defined(win32)}
|
{$if defined(windows) or defined(win32)}
|
||||||
Result:=LoadLibraryA(PChar(Filename));
|
Result:=LoadLibraryA(PChar(Filename));
|
||||||
@ -708,7 +708,7 @@ function SafeLoadLibrary(const FileName: AnsiString;
|
|||||||
{$ifdef cpui386}
|
{$ifdef cpui386}
|
||||||
if has_sse_support then
|
if has_sse_support then
|
||||||
{$endif cpui386}
|
{$endif cpui386}
|
||||||
SetSSECSR(ssecw);
|
SetMXCSR(ssecw);
|
||||||
{$endif}
|
{$endif}
|
||||||
{$if defined(win64) or defined(win32)}
|
{$if defined(win64) or defined(win32)}
|
||||||
SetErrorMode(mode);
|
SetErrorMode(mode);
|
||||||
|
|||||||
@ -45,16 +45,16 @@ const
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure SetSSECSR(w : dword);
|
procedure SetMXCSR(w : dword);
|
||||||
begin
|
begin
|
||||||
mxcsr:=w;
|
defaultmxcsr:=w;
|
||||||
asm
|
asm
|
||||||
ldmxcsr w
|
ldmxcsr w
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function GetSSECSR : dword;assembler;
|
function GetMXCSR : dword;assembler;
|
||||||
var
|
var
|
||||||
_w : dword;
|
_w : dword;
|
||||||
asm
|
asm
|
||||||
@ -62,6 +62,18 @@ const
|
|||||||
movl _w,%eax
|
movl _w,%eax
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SetSSECSR(w : dword);
|
||||||
|
begin
|
||||||
|
SetMXCSR(w);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetSSECSR: dword;
|
||||||
|
begin
|
||||||
|
result:=GetMXCSR;
|
||||||
|
end;
|
||||||
|
|
||||||
{****************************************************************************
|
{****************************************************************************
|
||||||
EXTENDED data type routines
|
EXTENDED data type routines
|
||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
|
|||||||
@ -104,7 +104,7 @@ procedure sincos(theta : single;out sinus,cosinus : single);assembler;
|
|||||||
function GetRoundMode: TFPURoundingMode;
|
function GetRoundMode: TFPURoundingMode;
|
||||||
begin
|
begin
|
||||||
{$ifndef FPC_HAS_TYPE_EXTENDED}
|
{$ifndef FPC_HAS_TYPE_EXTENDED}
|
||||||
Result:=TFPURoundingMode((GetSSECSR shr 13) and $3);
|
Result:=TFPURoundingMode((GetMXCSR shr 13) and $3);
|
||||||
{$else win64}
|
{$else win64}
|
||||||
Result:=TFPURoundingMode((Get8087CW shr 10) and $3);
|
Result:=TFPURoundingMode((Get8087CW shr 10) and $3);
|
||||||
{$endif win64}
|
{$endif win64}
|
||||||
@ -116,9 +116,9 @@ var
|
|||||||
SSECSR: dword;
|
SSECSR: dword;
|
||||||
begin
|
begin
|
||||||
CtlWord:=Get8087CW;
|
CtlWord:=Get8087CW;
|
||||||
SSECSR:=GetSSECSR;
|
SSECSR:=GetMXCSR;
|
||||||
Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
|
Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
|
||||||
SetSSECSR((SSECSR and $ffff9fff) or (dword(RoundMode) shl 13));
|
SetMXCSR((SSECSR and $ffff9fff) or (dword(RoundMode) shl 13));
|
||||||
{$ifdef FPC_HAS_TYPE_EXTENDED}
|
{$ifdef FPC_HAS_TYPE_EXTENDED}
|
||||||
Result:=TFPURoundingMode((CtlWord shr 10) and 3);
|
Result:=TFPURoundingMode((CtlWord shr 10) and 3);
|
||||||
{$else}
|
{$else}
|
||||||
@ -143,7 +143,7 @@ end;
|
|||||||
function GetExceptionMask: TFPUExceptionMask;
|
function GetExceptionMask: TFPUExceptionMask;
|
||||||
begin
|
begin
|
||||||
{$ifndef FPC_HAS_TYPE_EXTENDED}
|
{$ifndef FPC_HAS_TYPE_EXTENDED}
|
||||||
Result:=TFPUExceptionMask(dword((GetSSECSR shr 7) and $3f));
|
Result:=TFPUExceptionMask(dword((GetMXCSR shr 7) and $3f));
|
||||||
{$else win64}
|
{$else win64}
|
||||||
Result:=TFPUExceptionMask(dword(Get8087CW and $3F));
|
Result:=TFPUExceptionMask(dword(Get8087CW and $3F));
|
||||||
{$endif win64}
|
{$endif win64}
|
||||||
@ -155,9 +155,9 @@ var
|
|||||||
SSECSR: dword;
|
SSECSR: dword;
|
||||||
begin
|
begin
|
||||||
CtlWord:=Get8087CW;
|
CtlWord:=Get8087CW;
|
||||||
SSECSR:=GetSSECSR;
|
SSECSR:=GetMXCSR;
|
||||||
Set8087CW((CtlWord and $FFC0) or Byte(Longint(Mask)));
|
Set8087CW((CtlWord and $FFC0) or Byte(Longint(Mask)));
|
||||||
SetSSECSR((SSECSR and $ffffe07f) or (dword(Mask) shl 7));
|
SetMXCSR((SSECSR and $ffffe07f) or (dword(Mask) shl 7));
|
||||||
{$ifdef FPC_HAS_TYPE_EXTENDED}
|
{$ifdef FPC_HAS_TYPE_EXTENDED}
|
||||||
Result:=TFPUExceptionMask(dword(CtlWord and $3F));
|
Result:=TFPUExceptionMask(dword(CtlWord and $3F));
|
||||||
{$else}
|
{$else}
|
||||||
|
|||||||
@ -932,7 +932,6 @@ const
|
|||||||
MM_MaskUnderflow = %0000100000000000;
|
MM_MaskUnderflow = %0000100000000000;
|
||||||
MM_MaskPrecision = %0001000000000000;
|
MM_MaskPrecision = %0001000000000000;
|
||||||
|
|
||||||
mxcsr : dword = MM_MaskUnderflow or MM_MaskPrecision or MM_MaskDenorm;
|
|
||||||
|
|
||||||
procedure fpc_cpuinit;
|
procedure fpc_cpuinit;
|
||||||
begin
|
begin
|
||||||
@ -940,7 +939,7 @@ procedure fpc_cpuinit;
|
|||||||
if IsLibrary then
|
if IsLibrary then
|
||||||
begin
|
begin
|
||||||
Default8087CW:=Get8087CW;
|
Default8087CW:=Get8087CW;
|
||||||
mxcsr:=GetSSECSR;
|
DefaultMXCSR:=GetMXCSR;
|
||||||
end;
|
end;
|
||||||
SysResetFPU;
|
SysResetFPU;
|
||||||
end;
|
end;
|
||||||
@ -959,7 +958,7 @@ Procedure SysResetFPU;
|
|||||||
localfpucw: word;
|
localfpucw: word;
|
||||||
begin
|
begin
|
||||||
localfpucw:=Default8087CW;
|
localfpucw:=Default8087CW;
|
||||||
localmxcsr:=mxcsr;
|
localmxcsr:=DefaultMXCSR;
|
||||||
asm
|
asm
|
||||||
fninit
|
fninit
|
||||||
fwait
|
fwait
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user