diff --git a/rtl/i386/i386.inc b/rtl/i386/i386.inc index 41fddc323e..a25860f1e3 100644 --- a/rtl/i386/i386.inc +++ b/rtl/i386/i386.inc @@ -18,7 +18,7 @@ Primitives ****************************************************************************} var - has_sse_support,has_mmx_support,os_supports_sse : boolean; + os_supports_sse : boolean; {$asmmode intel} diff --git a/rtl/i386/math.inc b/rtl/i386/math.inc index f9fd51e33a..7831875cec 100644 --- a/rtl/i386/math.inc +++ b/rtl/i386/math.inc @@ -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 diff --git a/rtl/i386/mathu.inc b/rtl/i386/mathu.inc index 5803119a61..edae15dbe6 100644 --- a/rtl/i386/mathu.inc +++ b/rtl/i386/mathu.inc @@ -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); diff --git a/rtl/i386/mathuh.inc b/rtl/i386/mathuh.inc index f0258b9720..c802e73fe0 100644 --- a/rtl/i386/mathuh.inc +++ b/rtl/i386/mathuh.inc @@ -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; - - diff --git a/rtl/inc/mathh.inc b/rtl/inc/mathh.inc index 2a1a9b75db..61449d3952 100644 --- a/rtl/inc/mathh.inc +++ b/rtl/inc/mathh.inc @@ -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 } diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index 8e182077bc..71923fc317 100644 --- a/rtl/inc/systemh.inc +++ b/rtl/inc/systemh.inc @@ -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 } diff --git a/rtl/objpas/sysutils/sysutilh.inc b/rtl/objpas/sysutils/sysutilh.inc index 0c11f8ef83..dc975314fc 100644 --- a/rtl/objpas/sysutils/sysutilh.inc +++ b/rtl/objpas/sysutils/sysutilh.inc @@ -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; diff --git a/rtl/objpas/sysutils/sysutils.inc b/rtl/objpas/sysutils/sysutils.inc index be8101988b..bc27a56487 100644 --- a/rtl/objpas/sysutils/sysutils.inc +++ b/rtl/objpas/sysutils/sysutils.inc @@ -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; diff --git a/rtl/x86_64/math.inc b/rtl/x86_64/math.inc index 0b918fe250..01052fd681 100644 --- a/rtl/x86_64/math.inc +++ b/rtl/x86_64/math.inc @@ -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