Преглед изворни кода

* moved *SSECSR to system unit
* exposed cpu feature detection on i386 from system unit
+ SafeLoadLibrary

git-svn-id: trunk@3481 -

florian пре 19 година
родитељ
комит
47fac4ee6e

+ 1 - 1
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}
 

+ 34 - 11
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

+ 0 - 23
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);

+ 0 - 5
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;
-
-

+ 4 - 10
rtl/inc/mathh.inc

@@ -14,21 +14,15 @@
 
    { i386 FPU Controlword }
 
-{$ifdef cpui386}
-    const
-      Default8087CW : word = $1332;
-
-    procedure Set8087CW(cw:word);
-    function Get8087CW:word;
-{$endif cpui386}
-
-{$ifdef cpux86_64}
+{$if defined(cpui386) or defined(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 }
 

+ 7 - 2
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 }

+ 3 - 4
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;

+ 31 - 0
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;

+ 38 - 15
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