cpu.pp 4.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Florian Klaempfl
  4. This unit contains some routines to get informations about the
  5. processor
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$mode objfpc}
  13. unit cpu;
  14. interface
  15. uses
  16. sysutils;
  17. { returns true, if the processor supports the cpuid instruction }
  18. function cpuid_support : boolean;
  19. { returns true, if floating point is done by an emulator }
  20. function floating_point_emulation : boolean;
  21. { returns the contents of the cr0 register }
  22. function cr0 : longint;
  23. function InterlockedCompareExchange128Support : boolean;
  24. function AESSupport : boolean;inline;
  25. function AVXSupport: boolean;inline;
  26. function AVX2Support: boolean;inline;
  27. function FMASupport: boolean;inline;
  28. var
  29. is_sse3_cpu : boolean = false;
  30. function InterlockedCompareExchange128(var Target: Int128Rec; NewValue: Int128Rec; Comperand: Int128Rec): Int128Rec;
  31. implementation
  32. {$ASMMODE INTEL}
  33. var
  34. _AVXSupport,
  35. _AVX2Support,
  36. _AESSupport,
  37. _FMASupport : boolean;
  38. function InterlockedCompareExchange128(var Target: Int128Rec; NewValue: Int128Rec; Comperand: Int128Rec): Int128Rec;
  39. begin
  40. RunError(217);
  41. end;
  42. function cpuid_support : boolean;assembler;
  43. {
  44. Check if the ID-flag can be changed, if changed then CpuID is supported.
  45. Tested under go32v1 and Linux on c6x86 with CpuID enabled and disabled (PFV)
  46. }
  47. asm
  48. push ebx
  49. pushfd
  50. pushfd
  51. pop eax
  52. mov ebx,eax
  53. xor eax,200000h
  54. push eax
  55. popfd
  56. pushfd
  57. pop eax
  58. popfd
  59. and eax,200000h
  60. and ebx,200000h
  61. cmp eax,ebx
  62. setnz al
  63. pop ebx
  64. end;
  65. function cr0 : longint;assembler;
  66. asm
  67. DB 0Fh,20h,0C0h
  68. { mov eax,cr0
  69. special registers are not allowed in the assembler
  70. parsers }
  71. end;
  72. function floating_point_emulation : boolean;
  73. begin
  74. {!!!! I don't know currently the position of the EM flag }
  75. { $4 after Ralf Brown's list }
  76. floating_point_emulation:=(cr0 and $4)<>0;
  77. end;
  78. {$ASMMODE ATT}
  79. function XGETBV(i : dword) : int64;assembler;
  80. asm
  81. movl %eax,%ecx
  82. // older FPCs don't know the xgetbv opcode
  83. .byte 0x0f,0x01,0xd0
  84. end;
  85. procedure SetupSupport;
  86. var
  87. _ecx,_ebx : longint;
  88. begin
  89. is_sse3_cpu:=false;
  90. if cpuid_support then
  91. begin
  92. asm
  93. pushl %ebx
  94. movl $1,%eax
  95. cpuid
  96. movl %ecx,_ecx
  97. popl %ebx
  98. end;
  99. _AESSupport:=(_ecx and $2000000)<>0;
  100. _AVXSupport:=
  101. { XGETBV suspport? }
  102. ((_ecx and $08000000)<>0) and
  103. { xmm and ymm state enabled? }
  104. ((XGETBV(0) and %110)=%110) and
  105. { avx supported? }
  106. ((_ecx and $10000000)<>0);
  107. is_sse3_cpu:=(_ecx and $1)<>0;
  108. _FMASupport:=_AVXSupport and ((_ecx and $1000)<>0);
  109. asm
  110. pushl %ebx
  111. movl $7,%eax
  112. movl $0,%ecx
  113. cpuid
  114. movl %ebx,_ebx
  115. popl %ebx
  116. end;
  117. _AVX2Support:=_AVXSupport and ((_ebx and $20)<>0);
  118. end;
  119. end;
  120. function InterlockedCompareExchange128Support : boolean;
  121. begin
  122. { 32 Bit CPUs have no 128 Bit interlocked exchange support }
  123. result:=false;
  124. end;
  125. function AESSupport : boolean;
  126. begin
  127. result:=_AESSupport;
  128. end;
  129. function AVXSupport: boolean;inline;
  130. begin
  131. result:=_AVXSupport;
  132. end;
  133. function AVX2Support: boolean;inline;
  134. begin
  135. result:=_AVX2Support;
  136. end;
  137. function FMASupport: boolean;inline;
  138. begin
  139. result:=_FMASupport;
  140. end;
  141. begin
  142. SetupSupport;
  143. end.