1{
2    This file is part of the PTCPas framebuffer library
3    Copyright (C) 2001-2010, 2017 Nikolay Nikolov (nickysn@users.sourceforge.net)
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License as published by the Free Software Foundation; either
8    version 2.1 of the License, or (at your option) any later version
9    with the following modification:
10
11    As a special exception, the copyright holders of this library give you
12    permission to link this library with independent modules to produce an
13    executable, regardless of the license terms of these independent modules,and
14    to copy and distribute the resulting executable under terms of your choice,
15    provided that you also meet, for each linked independent module, the terms
16    and conditions of the license of that module. An independent module is a
17    module which is not derived from or based on this library. If you modify
18    this library, you may extend this exception to your version of the library,
19    but you are not obligated to do so. If you do not wish to do so, delete this
20    exception statement from your version.
21
22    This library is distributed in the hope that it will be useful,
23    but WITHOUT ANY WARRANTY; without even the implied warranty of
24    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
25    Lesser General Public License for more details.
26
27    You should have received a copy of the GNU Lesser General Public
28    License along with this library; if not, write to the Free Software
29    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
30}
31
32{$MODE objfpc}
33{$ASMMODE intel}
34{$GOTO on}
35
36unit timeunit;
37
38interface
39
40type
41  TGetClockTics = function: QWord;
42
43var
44  TimerResolution: Double;
45  CPS: Double;
46  GetClockTics: TGetClockTics;
47
48implementation
49
50var
51  UseRDTSC: Boolean;
52  Clk1Lo, Clk1Hi, Clk2Lo, Clk2Hi: DWord;
53  Clk1, Clk2: QWord;
54  ClkDelta: QWord;
55  CpuFlags: DWord;
56
57function GetClockTics_RDTSC: QWord; Assembler;
58
59Asm
60  rdtsc
61end;
62
63function GetClockTics_LAME: QWord;
64
65begin
66  GetClockTics_LAME := MemL[$46C];
67end;
68
69procedure DetectCPUSpeed_RDTSC;
70
71begin
72  {word absolute $46C}
73  Asm
74    mov di, fs:[046Ch]
75@@1:
76    cmp di, fs:[046Ch]
77    je @@1
78    rdtsc
79    mov ebx, eax
80    mov ecx, edx
81    mov di, fs:[046Ch]
82@@2:
83    mov ax, fs:[046Ch]
84    sub ax, di
85    cmp ax, 32
86    jb @@2
87    rdtsc
88    mov [Clk1Lo], ebx
89    mov [Clk1Hi], ecx
90    mov [Clk2Lo], eax
91    mov [Clk2Hi], edx
92  end ['EAX','EBX','ECX','EDX','EDI'];
93{  Clk1 := Clk1Lo or (QWord(Clk1Hi) shl 32);
94  Clk2 := Clk2Lo or (QWord(Clk2Hi) shl 32);}
95  Clk1 := Clk1Hi;
96  Clk1 := Clk1 shl 32;
97  Clk1 := Clk1 + Clk1Lo;
98  Clk2 := Clk2Hi;
99  Clk2 := Clk2 shl 32;
100  Clk2 := Clk2 + Clk2Lo;
101  ClkDelta := Clk2 - Clk1;
102  CPS := (ClkDelta * 18.2) / 32;
103  TimerResolution := 1 / CPS;
104end;
105
106procedure _CPU; Assembler;
107
108Label
109  nocpuid;
110
111Asm
112  mov CpuFlags, 0
113  pushfd
114  pop eax
115  mov ecx, eax
116  xor eax, 40000h
117  push eax
118  popfd
119  pushfd
120  pop eax
121  xor eax, ecx
122  jz nocpuid
123  push ecx
124  popfd
125  mov eax, ecx
126  xor eax, 200000h
127  push eax
128  popfd
129  pushfd
130  pop eax
131  xor eax, ecx
132  je nocpuid
133
134  pushad
135  mov eax, 1
136  cpuid
137  mov CpuFlags, edx
138  popad
139
140nocpuid:
141end;
142
143procedure DetectCPU;
144
145begin
146  _CPU;
147  if (CpuFlags and $10) <> 0 then
148    UseRDTSC := True
149  else
150    UseRDTSC := False;
151
152  if UseRDTSC then
153  begin
154    DetectCPUSpeed_RDTSC;
155    GetClockTics := @GetClockTics_RDTSC;
156  end
157  else
158  begin
159    TimerResolution := 1 / 18.2;
160    GetClockTics := @GetClockTics_LAME;
161  end;
162end;
163
164initialization
165
166begin
167  DetectCPU;
168end;
169
170end.
171