paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 13:30:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* i386 and x86_64 changes for Delphi compatibility:

Browse Source 
* '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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
rtl/i386/i386.inc
View File

@ -1334,8 +1334,6 @@ const
MM_MaskUnderflow = %0000100000000000;
MM_MaskPrecision = %0001000000000000;
mxcsr : dword = MM_MaskUnderflow or MM_MaskPrecision or MM_MaskDenorm;
{$define FPC_SYSTEM_HAS_SYSINITFPU}
Procedure SysInitFPU;
@ -1358,7 +1356,7 @@ Procedure SysResetFPU;
end;
if has_sse_support then
begin
localmxcsr:=mxcsr;
localmxcsr:=DefaultMXCSR;
asm
{ setup sse exceptions }
ldmxcsr localmxcsr
@ -1406,7 +1404,7 @@ procedure fpc_cpucodeinit;
begin
Default8087CW:=Get8087CW;
if has_sse_support then
mxcsr:=GetSSECSR;
DefaultMXCSR:=GetMXCSR;
end;
SysResetFPU;

17
rtl/i386/math.inc
View File

@ -61,16 +61,16 @@
end;
procedure SetSSECSR(w : dword);
procedure SetMXCSR(w : dword);
begin
mxcsr:=w;
defaultmxcsr:=w;
asm
ldmxcsr w
end;
end;
function GetSSECSR : dword;
function GetMXCSR : dword;
var
_w : dword;
begin
@ -80,6 +80,17 @@
result:=_w;
end;
procedure SetSSECSR(w : dword);
begin
SetMXCSR(w);
end;
function GetSSECSR: dword;
begin
result:=GetMXCSR;
end;
{****************************************************************************
EXTENDED data type routines
****************************************************************************}

4
rtl/i386/mathu.inc
View File

@ -150,7 +150,7 @@ begin
CtlWord := Get8087CW;
Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
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);
end;
@ -180,7 +180,7 @@ begin
CtlWord := Get8087CW;
Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
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));
end;

4
rtl/inc/dynlibs.pas
View File

@ -87,7 +87,7 @@ Function DoSafeLoadLibrary(const Name : UnicodeString) : TLibHandle;
{$ifdef cpui386}
if has_sse_support then
{$endif cpui386}
ssecw:=GetSSECSR;
ssecw:=GetMXCSR;
{$endif}
Result:=doloadlibrary(Name);
finally
@ -96,7 +96,7 @@ Function DoSafeLoadLibrary(const Name : UnicodeString) : TLibHandle;
{$ifdef cpui386}
if has_sse_support then
{$endif cpui386}
SetSSECSR(ssecw);
SetMXCSR(ssecw);
{$endif}
end;
end;

14
rtl/inc/mathh.inc
View File

@ -20,10 +20,16 @@
procedure Set8087CW(cw:word);
function Get8087CW:word;
{$ifndef cpui8086}
procedure SetSSECSR(w : dword);
function GetSSECSR : dword;
{$endif not cpui8086}
{$endif}
{$if defined (cpui386) or defined(cpux86_64)}
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}
type

4
rtl/objpas/sysutils/sysutils.inc
View File

@ -695,7 +695,7 @@ function SafeLoadLibrary(const FileName: AnsiString;
{$ifdef cpui386}
if has_sse_support then
{$endif cpui386}
ssecw:=GetSSECSR;
ssecw:=GetMXCSR;
{$endif}
{$if defined(windows) or defined(win32)}
Result:=LoadLibraryA(PChar(Filename));
@ -708,7 +708,7 @@ function SafeLoadLibrary(const FileName: AnsiString;
{$ifdef cpui386}
if has_sse_support then
{$endif cpui386}
SetSSECSR(ssecw);
SetMXCSR(ssecw);
{$endif}
{$if defined(win64) or defined(win32)}
SetErrorMode(mode);

18
rtl/x86_64/math.inc
View File

@ -45,16 +45,16 @@ const
end;
procedure SetSSECSR(w : dword);
procedure SetMXCSR(w : dword);
begin
mxcsr:=w;
defaultmxcsr:=w;
asm
ldmxcsr w
end;
end;
function GetSSECSR : dword;assembler;
function GetMXCSR : dword;assembler;
var
_w : dword;
asm
@ -62,6 +62,18 @@ const
movl _w,%eax
end;
procedure SetSSECSR(w : dword);
begin
SetMXCSR(w);
end;
function GetSSECSR: dword;
begin
result:=GetMXCSR;
end;
{****************************************************************************
EXTENDED data type routines
****************************************************************************}

12
rtl/x86_64/mathu.inc
View File

@ -104,7 +104,7 @@ procedure sincos(theta : single;out sinus,cosinus : single);assembler;
function GetRoundMode: TFPURoundingMode;
begin
{$ifndef FPC_HAS_TYPE_EXTENDED}
Result:=TFPURoundingMode((GetSSECSR shr 13) and $3);
Result:=TFPURoundingMode((GetMXCSR shr 13) and $3);
{$else win64}
Result:=TFPURoundingMode((Get8087CW shr 10) and $3);
{$endif win64}
@ -116,9 +116,9 @@ var
SSECSR: dword;
begin
CtlWord:=Get8087CW;
SSECSR:=GetSSECSR;
SSECSR:=GetMXCSR;
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}
Result:=TFPURoundingMode((CtlWord shr 10) and 3);
{$else}
@ -143,7 +143,7 @@ end;
function GetExceptionMask: TFPUExceptionMask;
begin
{$ifndef FPC_HAS_TYPE_EXTENDED}
Result:=TFPUExceptionMask(dword((GetSSECSR shr 7) and $3f));
Result:=TFPUExceptionMask(dword((GetMXCSR shr 7) and $3f));
{$else win64}
Result:=TFPUExceptionMask(dword(Get8087CW and $3F));
{$endif win64}
@ -155,9 +155,9 @@ var
SSECSR: dword;
begin
CtlWord:=Get8087CW;
SSECSR:=GetSSECSR;
SSECSR:=GetMXCSR;
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}
Result:=TFPUExceptionMask(dword(CtlWord and $3F));
{$else}

5
rtl/x86_64/x86_64.inc
View File

@ -932,7 +932,6 @@ const
MM_MaskUnderflow = %0000100000000000;
MM_MaskPrecision = %0001000000000000;
mxcsr : dword = MM_MaskUnderflow or MM_MaskPrecision or MM_MaskDenorm;
procedure fpc_cpuinit;
begin
@ -940,7 +939,7 @@ procedure fpc_cpuinit;
if IsLibrary then
begin
Default8087CW:=Get8087CW;
mxcsr:=GetSSECSR;
DefaultMXCSR:=GetMXCSR;
end;
SysResetFPU;
end;
@ -959,7 +958,7 @@ Procedure SysResetFPU;
localfpucw: word;
begin
localfpucw:=Default8087CW;
localmxcsr:=mxcsr;
localmxcsr:=DefaultMXCSR;
asm
fninit
fwait