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