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

* moved *SSECSR to system unit

Browse Source 
* exposed cpu feature detection on i386 from system unit
+ SafeLoadLibrary

git-svn-id: trunk@3481 -
This commit is contained in:
florian 2006-05-11 19:13:54 +00:00
parent a1b2701e5f
commit 47fac4ee6e
9 changed files with 118 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/i386/i386.inc
View File

@ -18,7 +18,7 @@
Primitives
****************************************************************************}
var
has_sse_support,has_mmx_support,os_supports_sse : boolean;
os_supports_sse : boolean;
{$asmmode intel}

45
rtl/i386/math.inc
View File

@ -18,21 +18,44 @@
****************************************************************************}
procedure Set8087CW(cw:word);assembler;
asm
asm
{$ifndef REGCALL}
movw cw,%ax
movw cw,%ax
{$endif}
movw %ax,default8087cw
fnclex
fldcw default8087cw
end;
movw %ax,default8087cw
fnclex
fldcw default8087cw
end;
function Get8087CW:word;assembler;
asm
pushl $0
fnstcw (%esp)
popl %eax
end;
asm
pushl $0
fnstcw (%esp)
popl %eax
end;
procedure SetSSECSR(w : dword);
var
_w : dword;
begin
_w:=w;
asm
ldmxcsr _w
end;
end;
function GetSSECSR : dword;
var
_w : dword;
begin
asm
stmxcsr _w
end;
result:=_w;
end;
{****************************************************************************
EXTENDED data type routines

23
rtl/i386/mathu.inc
View File

@ -22,29 +22,6 @@ function arctan2(y,x : float) : float;assembler;
fwait
end;
procedure SetSSECSR(w : dword);
var
_w : dword;
begin
_w:=w;
asm
ldmxcsr _w
end;
end;
function GetSSECSR : dword;
var
_w : dword;
begin
asm
stmxcsr _w
end;
result:=_w;
end;
function GetRoundMode: TFPURoundingMode;
begin
Result := TFPURoundingMode((Get8087CW shr 10) and 3);

5
rtl/i386/mathuh.inc
View File

@ -27,8 +27,3 @@ function SetPrecisionMode(const Precision: TFPUPrecisionMode): TFPUPrecisionMode
function GetExceptionMask: TFPUExceptionMask;
function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
procedure ClearExceptions(RaisePending: Boolean =true);
procedure SetSSECSR(w : dword);
function GetSSECSR : dword;

14
rtl/inc/mathh.inc
View File

@ -14,21 +14,15 @@
{ i386 FPU Controlword }
{$ifdef cpui386}
{$if defined(cpui386) or defined(cpux86_64)}
const
Default8087CW : word = $1332;
procedure Set8087CW(cw:word);
function Get8087CW:word;
{$endif cpui386}
{$ifdef cpux86_64}
const
Default8087CW : word = $1332;
procedure Set8087CW(cw:word);
function Get8087CW:word;
{$endif cpux86_64}
procedure SetSSECSR(w : dword);
function GetSSECSR : dword;
{$endif}
{ declarations of the math routines }

9
rtl/inc/systemh.inc
View File

@ -294,8 +294,13 @@ type
const
{$ifdef cpui386}
Test8086 : byte = 2; { Always i386 or newer }
Test8087 : byte = 3; { Always 387 or newer. Emulated if needed. }
{ Always i386 or newer }
Test8086 : byte = 2;
{ Always 387 or newer. Emulated if needed. }
Test8087 : byte = 3;
{ will be detected at startup }
has_sse_support : boolean = false;
has_mmx_support : boolean = false;
{$endif cpui386}
{$ifdef cpum68k}
Test68000 : byte = 0; { Must be determined at startup for both }

7
rtl/objpas/sysutils/sysutilh.inc
View File

@ -179,14 +179,11 @@ Var
type
TTerminateProc = Function: Boolean;
procedure AddTerminateProc(TermProc: TTerminateProc);
function CallTerminateProcs: Boolean;
Var
OnShowException : Procedure (Msg : ShortString);
@ -237,3 +234,5 @@ Type
{ interface handling }
{$i intfh.inc}
function SafeLoadLibrary(const FileName: AnsiString;
ErrorMode: DWord = {$ifdef windows}SEM_NOOPENFILEERRORBOX{$else windows}0{$endif windows}): HMODULE;

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

@ -576,3 +576,34 @@ begin
end;
end;
function SafeLoadLibrary(const FileName: AnsiString;
ErrorMode: DWord = {$ifdef windows}SEM_NOOPENFILEERRORBOX{$else windows}0{$endif windows}): HMODULE;
var
mode : DWord;
{$if defined(cpui386) or defined(cpux86_64)}
fpucw : Word;
ssecw : DWord;
{$endif}
begin
mode:=SetErrorMode(ErrorMode);
try
{$if defined(cpui386) or defined(cpux86_64)}
fpucw:=Get8087CW;
{$ifdef cpui386}
if has_sse_support then
{$endif cpui386}
ssecw:=GetSSECSR;
{$endif}
Result:=LoadLibrary(PChar(Filename));
finally
{$if defined(cpui386) or defined(cpux86_64)}
Set8087CW(fpucw);
{$ifdef cpui386}
if has_sse_support then
{$endif cpui386}
SetSSECSR(ssecw);
{$endif}
SetErrorMode(mode);
end;
end;

53
rtl/x86_64/math.inc
View File

@ -37,26 +37,49 @@ FPC_ABSMASK_DOUBLE:
****************************************************************************}
procedure Set8087CW(cw:word);assembler;
asm
movw cw,%ax
asm
movw cw,%ax
{$ifdef FPC_PIC}
movq default8087cw@GOTPCREL(%rip),%rax
movw %ax,(%rax)
fnclex
fldcw (%rax)
movq default8087cw@GOTPCREL(%rip),%rax
movw %ax,(%rax)
fnclex
fldcw (%rax)
{$else FPC_PIC}
movw %ax,default8087cw
fnclex
fldcw default8087cw
movw %ax,default8087cw
fnclex
fldcw default8087cw
{$endif FPC_PIC}
end;
end;
function Get8087CW:word;assembler;
asm
pushq $0
fnstcw (%rsp)
popq %rax
end;
asm
pushq $0
fnstcw (%rsp)
popq %rax
end;
procedure SetSSECSR(w : dword);
var
_w : dword;
begin
_w:=w;
asm
ldmxcsr _w
end;
end;
function GetSSECSR : dword;
var
_w : dword;
begin
asm
stmxcsr _w
end;
result:=_w;
end;
{****************************************************************************
EXTENDED data type routines