* 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:
sergei 2014-04-25 15:10:12 +00:00
parent 7ba0b03cd0
commit b16c6f8ced
9 changed files with 55 additions and 29 deletions

View File

@ -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;

View File

@ -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
****************************************************************************} ****************************************************************************}

View File

@ -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;

View File

@ -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;

View File

@ -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

View File

@ -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);

View File

@ -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
****************************************************************************} ****************************************************************************}

View File

@ -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}

View File

@ -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