Исследовательский проект "Цифровая оптика" .

[Alex2013]

Что я делаю для преобразования ТBitmap(класс "картинка" в LCL) в IplImage (класс "картинка" в OpenCV )?

нашел кое что...

Хм нужно проверить ...

Зы
А вообще у меня в проекте образовался довольно старый "затык" с однородными координатами ...
То есть метка есть ее "плоские координаты" и я могу что-то плоское туда вклеить с "афинными искажениям".
Но как от плоскости прейти к пространству и ПРАВИЛЬНО привязать к метке "не плоский" объект или модель "сея тайна велика" есть" ... (Даже кубик над меткой и то "фальшивый" рисую )
Зы
В книгах разумеется "все есть" но хорошо-бы пример на "пасквиле" найти ...

[IvoX]

к метке "не плоский" объект

Смотрел одного программиста на юпупуе...
Он вроде в открытый доступ выложил свой проект,там у него анимация 3D драки на его рабочем столе,в общем не вникал..

А по поводу "Move" есть ещё в сети разные версии наверное вплоть до avx512, мне больше интересно - А стоит ли оно того,возможно "новые" современные компиляторы итак используют вовсю все скоростные инструкции ,если видят что процессор "умеет".
Такое встречал в опенсорсных проектах 10(минимум) версий кода ,каждый под свою архитектуру оптимизирован

Добавлено спустя 10 минут 35 секунд:
Вот драки на столе:
https://www.youtube.com/watch?v=WqQXOG2KW8M
гитхаб там есть в коменте.

[Pavia]

Но как от плоскости прейти к пространству и ПРАВИЛЬНО привязать к метке "не плоский" объект или модель "сея тайна велика" есть" ... (Даже кубик над меткой и то "фальшивый" рисую )
Зы
В книгах разумеется "все есть" но хорошо-бы пример на "пасквиле" найти ...

Вначале неплохо бы камеру откалибровать. Т.е. найти её внутренние параметры. Строить 3-D треугольники. Путем покачивания камеры из разных снимков выбираем два соседних. Ищем особые точки - углы. Путем подсчета моментов координат особых точек ищем центр масс и угол наклона. Рассчитываем изменения и поворачиваем облако особых точек так чтобы их совместить. Находим ближайшие пары точки были стали. ЗА счет параллакса они будут расходиться между 1 кадром и вторым.
Далее используя эппиполярную геометрию составляем систему уравнений. Линеаризуем систему и находим минимум для недоопределенной системы системы.
Тут есть практические проблемы солвер нужно не менее N особых точек. T1=[x1,y1,z1] R1=(Y,P,R) T2=[x1,y1,z1] R2=(Y,P,R) P1=(x,y,z) P2=(x,y,z) P3=(x,y,z)

Тоже до этого пока не добрался. QR доделаю попробую сделать.

[Alex2013]

А по поводу "Move" есть ещё в сети разные версии наверное вплоть до avx512, мне больше интересно - А стоит ли оно того,возможно "новые" современные компиляторы итак используют вовсю все скоростные инструкции ,если видят что процессор "умеет".

1 Кстати про avx интересно (у меня проц первые версии avx умеет ) Но юзать это расширение для Move моветон .(А вот пересчет матриц и векторные операции вроде самое-то )
2 На компилятор я бы особо не рассчитывал (Сто раз стакивался с вариантами где даже "ручное" использование древних как бронтозавр инструкций ММХ давало неплохой результат )

Смотрел одного программиста на юпупуе...
Он вроде в открытый доступ выложил свой проект,там у него анимация 3D драки на его рабочем столе,в общем не вникал..

Так примеры "вообще" не проблема но вот найти что-то на паскале довольно сложно . (Или хотя-бы "вменяемый"(то бишь без "дикостей" типа "лямбда функций" и т.п. ) код на С++ или например питоне )

Добавлено спустя 1 час 3 минуты 21 секунду:

Но как от плоскости прейти к пространству и ПРАВИЛЬНО привязать к метке "не плоский" объект или модель "сея тайна велика" есть" ... (Даже кубик над меткой и то "фальшивый" рисую )
Зы
В книгах разумеется "все есть" но хорошо-бы пример на "пасквиле" найти ...

Вначале неплохо бы камеру откалибровать. Т.е. найти её внутренние параметры. Строить 3-D треугольники. Путем покачивания камеры из разных снимков выбираем два соседних. Ищем особые точки - углы. Путем подсчета моментов координат особых точек ищем центр масс и угол наклона. Рассчитываем изменения и поворачиваем облако особых точек так чтобы их совместить. Находим ближайшие пары точки были стали. ЗА счет параллакса они будут расходиться между 1 кадром и вторым.
Далее используя эппиполярную геометрию составляем систему уравнений. Линеаризуем систему и находим минимум для недоопределенной системы системы.
Тут есть практические проблемы солвер нужно не менее N особых точек. T1=[x1,y1,z1] R1=(Y,P,R) T2=[x1,y1,z1] R2=(Y,P,R) P1=(x,y,z) P2=(x,y,z) P3=(x,y,z)

Тоже до этого пока не добрался. QR доделаю попробую сделать.

Во первых разумеется спасибо за поддержку !
Однако, насколько я понял камеру калибровать нужно для вычисления РАССТОЯНИЯ до метки . А мне это пока почти "по барабану". У меня пока задача попроще . Есть "пронумерованные" 2д координаты углов метки и нужно вычислить углы ее поворота в пространстве и для начала сойдет даже без учета особенностей перспективы . Масштаб идет в грубом приближении ( то есть модель просто в "вписывается" в куб на над меткой )

Что касается поиска характерных точек и их примитивного трекинга то "этого у меня давно есть ".


Да это "немного не то" но как "опорная технология" может пригодится .

[IvoX]

Но юзать это расширение для Move моветон

Ну, я не особо разбираюсь, но ведь быстрее же будет, плюс они не засоряют кеш...

Ещё вариант: Берёте исходник процедуры Move и перекручиваете его на выполнение операции OR. Он там и хвост менее 4 байт учитывает тоже.

Правда, в ней SSE не пользуется. Хорошо бы использовать команду MOVNTQ, с ней запись данных ускоряется до 2-3 раз в зависимости от системы.

Я как раз искал как заставить компилятор генерировать AVX код,и кто-то гдето писал что через командную строку(Delphi 10.4) но ссылка та не работает с мая 2020.
Хотелось не вникая сравнить , типа поставил галочку и смотришь разницу.
Тут где не почитаю, все пишут современные компиляторы умеют оптимизировать.Может на С,С++ и иже сними так и есть,но
вот люди руками написали несколько вариантов и компилятор позади оказался.
https://www.cyberforum.ru/delphi-multimedia/thread2599425.html
И вроде бы ничего сложного,но держать в голове все выравнивания и нюансы...трудновато новичку.
Думаю с учебником/справочником каким смогу наваять похожее за пару недель ,но к сожалению вывихнул руку,теперь больше читаю

[Alex2013]

А

Я как раз искал как заставить компилятор генерировать AVX код,и кто-то гдето писал что через командную строку(Delphi 10.4) но ссылка та не работает с мая 2020.

И ИМХО проще "в ручную" через инлайн вставки в код ..

Что то вроде того, что делали для турбо паскаля в дос...
(Кусок "продвинутого" ( для мохнатых 90-х годов )теста CPU из моей старой программы )

Код: Выделить всё

  if (Test8086 = 2) then         { RTL check stops at 2 = 386}
  asm
             inc    Test8086     { 3 = 386, for consistency }
    { Do we have a 386 or a 486? }
    { Does pushf/popf preserve the Alignment Check bit? (386=no, 486=yes) }
             mov    bx, sp       { save current stack pointer }
             and    sp, not 3    { align stack to avoid AC fault }
    db $66;  pushf
    db $66;  pop    ax
    db $66;  mov    cx, ax
    db $66, $35; dd $40000       { xor AC bit in EFLAGS }
    db $66;  push   ax
    db $66;  popf
    db $66;  pushf
    db $66;  pop    ax
    db $66;  xor    ax, cx       { Is AC bit toggled? }
             je @@1              { if not, we have a 386 }
             and    sp, not 3    { align stack to avoid AC fault }
    db $66;  push   cx
    db $66;  popf                { restore original AC bit }
             mov    sp, bx       { restore original stack pointer }
             mov  Test8086, 4    { we know we have at least a 486 }

    { Do we have a 486 or a Pentium? }
    { Does pushf/popf preserve the CPUID bit? (486=no, P5=yes) }
    db $66;  mov    ax, cx       { get original EFLAGS}
    db $66, $35; dd $200000      { XOR id bit in flags}
    db $66;  push   ax
    db $66;  popf
    db $66;  pushf
    db $66;  pop    ax
    db $66;  xor    ax, cx      { Is CPUID bit toggled? }
             je @@1             { if not, we have a 486 }
    db $66;  xor    ax, ax
    db $f,$a2                   { CPUID, AX = 0 (get CPUID caps) }
    db $66;  cmp    ax, 1
             jl @@1             { if < 1, then exit }
    db $66;  xor    ax, ax
    db $66;  inc    ax
    db $f,$a2                   { CPUID, AX = 1 (get CPU info)   }
             and    ax, $f00    { mask out all but family id }
             {Shr ax,8}
             shr    ax, 1
             shr    ax, 1
              shr    ax, 1
              shr    ax, 1
             shr    ax, 1
             shr    ax, 1
              shr    ax, 1
              shr    ax, 1
             mov    Test8086, al      { Pentium family = 5 }
   @@1:
  end;


Особенно характерна например эта строчка ..

db $f,$a2 { CPUID, AX = 0 (get CPUID caps) }

...где используется вообще 100% "левый" для встроенного асемблера код ...

[IvoX]

Типа того что делали для турбо паскаля в дос

Слышал про этот способ. Выпонение 32х кода в 16х компиляторе

[Alex2013]

Выпонение 32х кода в 16х компиляторе

То что я хочу показать немного не то. (для выполнения 32-х разрядного кода часто было достаточно префикса db $66; )
А я хочу показать что в процессор на исполнение можно засунуть ВООБЩЕ ЛЮБОЙ код (Другое дело поймет ли он его или нет "вопрос интересный" )

[Pavia]

Я как раз искал как заставить компилятор генерировать AVX код,и кто-то гдето писал что через командную строку(Delphi 10.4) но ссылка та не работает с мая 2020.

Они его не сделали. Сказали есть первостепенные задачи и в ближайшее время неждите. Видимо пока 10.5 а то 11.0 не появится не сделают.

[IvoX]

(Другое дело поймет ли он его или нет

я нашел пока только проверу поддержки AVX2 и доступности регистров Xmm/Ymm, мой проц всё может и в системе всё как надо...

Код: Выделить всё

function IsAVX2supported: boolean;
asm
    // Save EBX
    {$IFDEF CPUx86}
      push ebx
    {$ELSE CPUx64}
      mov r10, rbx
    {$ENDIF}
    //Check CPUID.0
    xor eax, eax
    cpuid //modifies EAX,EBX,ECX,EDX
    cmp al, 7 // do we have a CPUID leaf 7 ?
    jge @Leaf7
      xor eax, eax
      jmp @Exit
    @Leaf7:
      //Check CPUID.7
      mov eax, 7h
      xor ecx, ecx
      cpuid
      bt ebx, 5 //AVX2: CPUID.(EAX=07H, ECX=0H):EBX.AVX2[bit 5]=1
      setc al
   @Exit:
   // Restore EBX
   {$IFDEF CPUx86}
     pop ebx
   {$ELSE CPUx64}
     mov rbx, r10
   {$ENDIF}
end;
function OSEnabledXmmYmm: boolean;
// necessary to check before using AVX, FMA or AES instructions!
asm
  {$IFDEF CPUx86}
  push ebx
  {$ELSE CPUx64}
  mov r10, rbx
  {$ENDIF}
  mov eax,1
  cpuid
  bt ecx, 27  // CPUID.1:ECX.OSXSAVE[bit 27] = 1 (XGETBV enabled for application use; implies XGETBV is an available instruction also)
  jnc @not_supported
    xor ecx,ecx //Specify control register XCR0 = XFEATURE_ENABLED_MASK register
    db 0Fh, 01h, 0D0h // xgetbv //Reads XCR (extended control register) -> EDX:EAX
    {lgdt eax = db 0Fh, 01h = privileged instruction, so don't go here unless xgetbv is allowed}
      //CHECK XFEATURE_ENABLED_MASK[2:1] = ‘11b’
      and eax, 06h //06h= 00000000000000000000000000000110b
      cmp eax, 06h//; check OS has enabled both XMM (bit 1) and YMM (bit 2) state management support
    jne @not_supported
      mov eax,1
      jmp @out
  @not_supported:
    xor eax,eax
  @out:
{$IFDEF CPUx86}
  pop ebx
  {$ELSE CPUx64}
  mov rbx, r10
  {$ENDIF}
end;

[Alex2013]

я нашел пока только проверу поддержки AVX2 и доступности регистров Xmm/Ymm, мой проц всё может и в системе всё как надо...

О спасибо! Проверю ...
CPUZ выдает вот что...

[iskander]

Fpc-3.2.0 искаропки умеет определять поддержку AVX/AVX2(модуль Cpu).
Некоторое время назад не умел, я даже строил свой наколенный фичедетектор:

Код: Выделить всё

unit uCpu;
{$mode objfpc}{$H+}

{$COPERATORS ON}
{$WRITEABLECONST OFF}
{$BOOLEVAL OFF}
{$POINTERMATH ON}
{$MODESWITCH ADVANCEDRECORDS}

{$IFDEF CPUI386)}
  {$DEFINE UC_CPU_I386}
{$ENDIF}

{$IF DEFINED(CPUAMD64) or DEFINED(CPUX86_64)}
  {$DEFINE UC_CPU_AMD64}
{$ENDIF}

{$IF DEFINED(UC_CPU_AMD64) or DEFINED(UC_CPU_I386)}
  {$DEFINE UC_CPU_INTEL}
  {$ASMMODE INTEL}
{$ENDIF}

interface

uses
  SysUtils;

{$IFDEF UC_CPU_INTEL}
type

  TCpu = record
  public
  type
    TCpuVendor = (cvUnknown, cvIntel, cvAMD, cvVIA, cvZhaoxin, cvHygon, cvMcst);

  private
  type //todo: split by features ???
    TCpuFeature = (
      cfCPUID, cfCMOV, cfTSC, cfInvTSC, cfMMX, cfSSE, cfSSE2, cfSSE3, cfSSSE3,
      cfFMA, cfSSE41, cfSSE42, cfAESNI, cfCLMULQDQ, cfAVX, cfAVX2, cfTsxHle,
      cfTsxRtm, cfBMI1, cfBMI2, cfAVX512f, cfAVX512dq, cfAVX512er, cfAVX512ifma,
      cfAVX512pf, cfAVX512cd, cfAVX512bw, cfAVX512vbmi, cfADX, cfPOPCNT, cfRDRAND,
      cfRDSeed, cfSHAX, cfVIARNG, cfVIAACE, cfVIAACE2, cfVIAPHE, cfVIAPMM);

    TCpuFeatures = set of TCpuFeature;

  const
    CpuVendors: array [TCpuVendor] of  string = (
      'Unknown vendor', 'Intel Corporation', 'Advanced Micro Devices',
      'VIA Technologies', 'Shanghai Zhaoxin Semiconductor',
      'Chengdu Haiguang Integrated Circuit Design', 'MCST Elbrus');

  class var
    CvFeatures: TCpuFeatures;
    CvFamily,
    CvModel,
    CvStepping: DWord;
    CvVendor: TCpuVendor;
    CvBrand: string;
    class procedure TestFeatures; static;
    class constructor Setup;
  public
    class property Vendor: TCpuVendor read CvVendor;
    class property Family: DWord read CvFamily;
    class property Model: DWord read CvModel;
    class property Stepping: DWord read CvStepping;
    class function VendorString: string; static; inline;
    class function BrandString: string; static; inline;
    class function HasCPUID: Boolean; static; inline;
    class function HasCMOV: Boolean; static; inline;
    class function HasTSC: Boolean; static; inline;
    class function HasInvariantTSC: Boolean; static; inline;
    class function HasMMX: Boolean; static; inline;
    class function HasSSE: Boolean; static; inline;
    class function HasSSE2: Boolean; static; inline;
    class function HasSSE3: Boolean; static; inline;
    class function HasSSSE3: Boolean; static; inline;
    class function HasFMA3: Boolean; static; inline;
    class function HasSSE41: Boolean; static; inline;
    class function HasSSE42: Boolean; static; inline;
    class function HasAESNI: Boolean; static; inline;
    class function HasCLMULQDQ: Boolean; static; inline;
    class function HasAVX: Boolean; static; inline;
    class function HasAVX2: Boolean; static; inline;
    class function HasHLE: Boolean; static; inline;
    class function HasRTM: Boolean; static; inline;
    class function HasXTEST: Boolean; static; inline;
    class function HasAVX512f: Boolean; static; inline;
    class function HasAVX512cd: Boolean; static; inline;
    class function HasAVX512er: Boolean; static; inline;
    class function HasAVX512pf: Boolean; static; inline;
    class function HasAVX512dq: Boolean; static; inline;
    class function HasAVX512bw: Boolean; static; inline;
    class function HasAVX512ifma: Boolean; static; inline;
    class function HasAVX512vbmi: Boolean; static; inline;
    class function HasBMI1: Boolean; static; inline;
    class function HasBMI2: Boolean; static; inline;
    class function HasRDRAND: Boolean; static; inline;
    class function HasRDSEED: Boolean; static; inline;
    class function HasADX: Boolean; static; inline;
    class function HasPOPCNT: Boolean; static; inline;
    class function HasVAESNI: Boolean; static; inline;
    class function HasVCLMULQDQ: Boolean; static; inline;
    class function HasSHAX: Boolean; static; inline;
    class function HasVIARng: Boolean; static; inline;
    class function HasVIAAce: Boolean; static; inline;
    class function HasVIAAce2: Boolean; static; inline;
    class function HasVIAPHE: Boolean; static; inline;
    class function HasVIAPMM: Boolean; static; inline;
  end;
{$ENDIF UC_CPU_INTEL}

implementation

{$IFDEF UC_CPU_INTEL}
type

  TCpuIdQuery = packed record
    EAX, EBX, ECX, EDX: DWord;
  end;

const

  CPUVendorQuery: TCpuIdQuery        = (EAX: 0; EBX: 0; ECX: 0; EDX: 0);
  CPUFeaturesQuery: TCpuIdQuery      = (EAX: 1; EBX: 0; ECX: 0; EDX: 0);
  CPUExtFeaturesQuery1: TCpuIdQuery  = (EAX: 7; EBX: 0; ECX: 0; EDX: 0);
  CPUExtFeaturesQuery2: TCpuIdQuery  = (EAX: $80000000; EBX: 0; ECX: 0; EDX: 0); //////////////////
  CPUPowManFeatureQuery: TCpuIdQuery = (EAX: $80000007; EBX: 0; ECX: 0; EDX: 0); ////////////////////
  VIAPadlockExists: TCpuIdQuery      = (EAX: $C0000000; EBX: 0; ECX: 0; EDX: 0);
  VIAPadlockFeatures: TCpuIdQuery    = (EAX: $C0000001; EBX: 0; ECX: 0; EDX: 0);
  BrandQuery1: TCpuIdQuery           = (EAX: $80000002; EBX: 0; ECX: 0; EDX: 0);
  BrandQuery2: TCpuIdQuery           = (EAX: $80000003; EBX: 0; ECX: 0; EDX: 0);
  BrandQuery3: TCpuIdQuery           = (EAX: $80000004; EBX: 0; ECX: 0; EDX: 0);

  BrandFeatureSupport  = DWord($80000004);
  LowestVIAPadlockFunc = DWord($C0000001);

  TscEdxFlag        = DWord(1) shl  4;  //edx
  InvTscEdxFlag     = DWord(1) shl  8;  //edx
  CmovEdxFlag       = DWord(1) shl 15;  //edx
  MmxEdxFlag        = DWord(1) shl 23;  //edx
  SseEdxFlag        = DWord(1) shl 25;  //edx
  Sse2EdxFlag       = DWord(1) shl 26;  //edx
  ViaRngEdxFlags    = DWord(3) shl  2;  //edx
  ViaAceEdxFlags    = DWord(3) shl  6;  //edx
  ViaAce2EdxFlags   = DWord(3) shl  8;  //edx
  ViaPheEdxFlags    = DWord(3) shl 10;  //edx
  ViaPmmEdxFlags    = DWord(3) shl 12;  //edx

  Sse3EcxFlag       = DWord(1) shl  0;  //ecx
  ClmulqdqEcxFlag   = DWord(1) shl  1;  //ecx
  Avx512vbmiEcxFlag = DWord(1) shl  1;  //ecx
  Ssse3EcxFlag      = DWord(1) shl  9;  //ecx
  FmaEcxFlag        = DWord(1) shl 12;  //ecx
  Sse41EcxFlag      = DWord(1) shl 19;  //ecx
  Sse42EcxFlag      = DWord(1) shl 20;  //ecx
  PopcntEcxFlag     = DWord(1) shl 23;  //ecx
  AesniEcxFlag      = DWord(1) shl 25;  //ecx
  XSaveEcxFlag      = DWord(1) shl 26;  //ecx
  OSXSaveEcxFlag    = DWord(1) shl 27;  //ecx
  AvxEcxFlag        = DWord(1) shl 28;  //ecx
  RDRandEcxFlag     = DWord(1) shl 30;  //ecx

  Bmi1EbxFlag       = DWord(1) shl  3;  //ebx
  TsxHleEbxFlag     = DWord(1) shl  4;  //ebx
  TsxRtmEbxFlag     = DWord(1) shl 11;  //ebx
  Avx2EbxFlag       = DWord(1) shl  5;  //ebx
  Bmi2EbxFlag       = DWord(1) shl  8;  //ebx
  Avx512fEbxFlag    = DWord(1) shl 16;  //ebx
  Avx512dqEbxFlag   = DWord(1) shl 17;  //ebx
  RDSeedEbxFlag     = DWord(1) shl 18;  //ebx
  AdxEbxFlag        = DWord(1) shl 19;  //ebx
  Avx512ifmaEbxFlag = DWord(1) shl 21;  //ebx
  Avx512pfEbxFlag   = DWord(1) shl 26;  //ebx
  Avx512erEbxFlag   = DWord(1) shl 27;  //ebx
  Avx512cdEbxFlag   = DWord(1) shl 28;  //ebx
  ShaxEbxFlag       = DWord(1) shl 29;  //ebx
  Avx512bwEbxFlag   = DWord(1) shl 30;  //ebx

function CpuIdAvailable: Boolean; register; assembler;
asm
{$IFDEF UC_CPU_I386}
  pushfd
  pushfd
  pop     eax
  mov     edx, eax
  xor     eax, 200000h
  push    eax
  popfd
  pushfd
  pop     eax
  popfd
  and     eax, 200000h
  and     edx, 200000h
  cmp     eax, edx
  mov     eax, 0
  setnz   al
{$ELSE UC_CPU_I386}
  mov    rax, True
{$ENDIF UC_CPU_I386}
end;


procedure CallCpuId(var aQuery: TCpuIdQuery); register; assembler;
asm
{$IFDEF UC_CPU_I386}
  push ebx
  push esi

  mov  esi, eax
  mov  ecx, [eax + offset TCpuIdQuery.ECX]
  mov  eax, [eax + offset TCpuIdQuery.EAX]

  cpuid

  mov  [esi + offset TCpuIdQuery.EAX], eax
  mov  [esi + offset TCpuIdQuery.EBX], ebx
  mov  [esi + offset TCpuIdQuery.ECX], ecx
  mov  [esi + offset TCpuIdQuery.EDX], edx

  pop  esi
  pop  ebx
{$ELSE UC_CPU_I386}
  push rbx
{$IFDEF MSWINDOWS}
  push rdi
  mov  rdi, rcx
{$ENDIF MSWINDOWS}
  mov  eax, dword ptr[rdi + offset TCpuIdQuery.EAX]
  mov  ecx, dword ptr[rdi + offset TCpuIdQuery.ECX]

  cpuid

  mov  dword ptr[rdi + offset TCpuIdQuery.EAX], eax
  mov  dword ptr[rdi + offset TCpuIdQuery.EBX], ebx
  mov  dword ptr[rdi + offset TCpuIdQuery.ECX], ecx
  mov  dword ptr[rdi + offset TCpuIdQuery.EDX], edx
{$IFDEF MSWINDOWS}
  pop  rdi
{$ENDIF MSWINDOWS}
  pop  rbx
{$ENDIF UC_CPU_I386}
end;

function GetXCRValue(aXCrIndex: DWord): QWord; register; assembler; nostackframe;
asm
{$IFDEF UC_CPU_AMD64}
  {$IFNDEF MSWINDOWS}
  mov  rcx, rdi
  {$ENDIF MSWINDOWS}
{$ELSE UC_CPU_AMD64}
  mov  ecx, eax
{$ENDIF UC_CPU_AMD64}
  //db   $0f, $01, $d0   //XGETBV
  xgetbv
{$IFDEF UC_CPU_AMD64}
  shl rdx, 32
  or  rax, rdx
{$ENDIF UC_CPU_AMD64}
end;

function OSSupportsAVX: Boolean;
begin
  Result := GetXCRValue(0) and 6 = 6;
end;

function OSSupportsAVX512: Boolean;
begin
  Result := GetXCRValue(0) and $e6 = $e6;
end;

function ReadTSC: QWord; assembler; nostackframe;
asm
  rdtsc
{$IFDEF UC_CPU_AMD64}
  shl rdx, 32
  or  rax, rdx
{$ENDIF}
end;

function ReadInvTSC: QWord; assembler; nostackframe;
asm
  rdtscp
  //db  $0F,$01,$F9 //rdtscp
{$IFDEF UC_CPU_AMD64}
  shl rdx, 32
  or  rax, rdx
{$ENDIF}
end;

function OsSupportsTSC: Boolean;
begin
  Result := True;
  try
    ReadTSC;
  except
    Result := False;
  end;
end;

function OsSupportsInvTSC: Boolean;
begin
  Result := True;
  try
    ReadInvTSC;
  except
    Result := False;
  end;
end;

{ TCpu }

class procedure TCpu.TestFeatures;
type
  TVendorId = packed record
    case Integer of
      0: (DWords: array[0..2] of DWord);
      1: (Alpha: array[0..11] of AnsiChar);
  end;

var
  Query: TCpuIdQuery;
  MaxLeaf: DWord;
  OsXSave, XSave: Boolean;

  procedure TestCpuVendor;
  var
    VendorId:  TVendorId;
  begin
    with Query do
      begin
        VendorId.DWords[0] := EBX;
        VendorId.DWords[1] := EDX;
        VendorId.DWords[2] := ECX;
      end;
    case shortstring(VendorId.Alpha) of
      'GenuineIntel': CvVendor := cvIntel;
      'AuthenticAMD': CvVendor := cvAMD;
      'VIA VIA VIA ',
      'CentaurHauls': CvVendor := cvVIA;
      '  Shanghai  ': CvVendor := cvZhaoxin;
      'HygonGenuine': CvVendor := cvHygon;
      'E2K MACHINE':  CvVendor := cvMcst; //todo: ???
    else
      CvVendor := cvUnknown;
    end;
  end;

  procedure  TestCpuModel;
  const
    ModelShift     = 4;
    FamilyShift    = 8;
    ExtModelShift  = 16;
    ExtFamilyShift = 20;
    Stepping_Mask  = DWord($0f);
    ModelMask      = DWord($0f) shl ModelShift;
    FamilyMask     = DWord($0f) shl FamilyShift;
    ExtModelMask   = DWord($0f) shl ExtModelShift;
    ExtFamilyMask  = DWord($ff) shl ExtFamilyShift;
  begin
    with Query do
      begin
        CvStepping := EAX and Stepping_Mask;
        CvFamily := (EAX and FamilyMask) shr FamilyShift;
        CvModel := (EAX and ModelMask) shr ModelShift;
        if CvFamily = $06 then
          CvModel += (EAX and ExtModelMask) shr (ExtModelShift - ModelShift)
        else
          if CvFamily = $0f then
            begin
              CvFamily += (EAX and ExtFamilyMask) shr ExtFamilyShift;
              CvModel += (EAX and ExtModelMask) shr (ExtModelShift - ModelShift);
            end;
      end;
  end;

var
  BrandPart: array[0..15] of AnsiChar absolute Query;

begin
  if not CpuIdAvailable then
    exit;
  Include(CvFeatures, cfCPUID);

  Query := CPUVendorQuery;
  CallCpuId(Query);
  MaxLeaf := Query.EAX;
  TestCpuVendor;
  if CPUFeaturesQuery.EAX > MaxLeaf then
    exit;

  Query := CPUFeaturesQuery;
  CallCpuId(Query);
  TestCpuModel;
  if (Query.EDX and CmovEdxFlag) <> 0 then
    Include(CvFeatures, cfCMOV);
  if LongBool(Query.EDX and TscEdxFlag) and OsSupportsTSC then
    Include(CvFeatures, cfTSC);
  if (Query.EDX and MmxEdxFlag) <> 0 then
    Include(CvFeatures, cfMMX);
  if (Query.EDX and SseEdxFlag) <> 0 then
    Include(CvFeatures, cfSSE);
  if (Query.EDX and Sse2EdxFlag) <> 0 then
    Include(CvFeatures, cfSSE2);
  if (Query.ECX and Sse3EcxFlag) <> 0 then
    Include(CvFeatures, cfSSE3);
  if (Query.ECX and Ssse3EcxFlag) <> 0 then
    Include(CvFeatures, cfSSSE3);
  if (Query.ECX and FmaEcxFlag) <> 0 then
    Include(CvFeatures, cfFMA);
  if (Query.ECX and Sse41EcxFlag) <> 0 then
    Include(CvFeatures, cfSSE41);
  if (Query.ECX and Sse42EcxFlag) <> 0 then
    Include(CvFeatures, cfSSE42);
  if (Query.ECX and PopcntEcxFlag) <> 0 then
    Include(CvFeatures, cfPOPCNT);
  if (Query.ECX and AesniEcxFlag) <> 0 then
    Include(CvFeatures, cfAESNI);
  if (Query.ECX and ClmulqdqEcxFlag) <> 0 then
    Include(CvFeatures, cfCLMULQDQ);
  if (Query.ECX and RDRandEcxFlag) <> 0 then
    Include(CvFeatures, cfRDRand);

  OsXSave := (Query.ECX and OSXSaveEcxFlag) <> 0;
  XSave := (Query.ECX and XSaveEcxFlag) <> 0;
  if XSave and OsXSave then
    begin
      if LongBool(Query.ECX and AvxEcxFlag) and OSSupportsAVX then
        Include(CvFeatures, cfAVX);
    end;

  if CPUExtFeaturesQuery1.EAX > MaxLeaf then
    exit;
  Query := CPUExtFeaturesQuery1;
  CallCpuId(Query);
  if (cfAVX in CvFeatures) and LongBool(Query.EBX and Avx2EbxFlag) then
    Include(CvFeatures, cfAVX2);
  if (Query.EBX and Bmi1EbxFlag) <> 0 then
    Include(CvFeatures, cfBMI1);
  if (Query.EBX and Bmi2EbxFlag) <> 0 then
    Include(CvFeatures, cfBMI2);
  if (Query.EBX and RDSeedEbxFlag) <> 0 then
    Include(CvFeatures, cfRDSeed);
  if (Query.EBX and AdxEbxFlag) <> 0 then
    Include(CvFeatures, cfADX);
  if (Query.EBX and ShaxEbxFlag) <> 0 then
    Include(CvFeatures, cfSHAX);
  if (Query.EBX and TsxHleEbxFlag) <> 0 then
    Include(CvFeatures, cfTsxHle);
  if (Query.EBX and TsxRtmEbxFlag) <> 0 then
    Include(CvFeatures, cfTsxRtm);

  if XSave and OsXSave and OSSupportsAVX512 then
    begin
      if (Query.EBX and Avx512fEbxFlag) <> 0 then
        Include(CvFeatures, cfAVX512f);
      if (Query.EBX and Avx512dqEbxFlag) <> 0 then
        Include(CvFeatures, cfAVX512dq);
      if (Query.EBX and Avx512ifmaEbxFlag) <> 0 then
        Include(CvFeatures, cfAVX512ifma);
      if (Query.EBX and Avx512pfEbxFlag) <> 0 then
        Include(CvFeatures, cfAVX512pf);
      if (Query.EBX and Avx512erEbxFlag) <> 0 then
        Include(CvFeatures, cfAVX512er);
      if (Query.EBX and Avx512cdEbxFlag) <> 0 then
        Include(CvFeatures, cfAVX512cd);
      if (Query.EBX and Avx512bwEbxFlag) <> 0 then
        Include(CvFeatures, cfAVX512bw);
      if (Query.ECX and Avx512vbmiEcxFlag) <> 0 then
        Include(CvFeatures, cfAVX512vbmi);
    end;

  Query := CPUExtFeaturesQuery2;
  CallCpuId(Query);
  MaxLeaf := Query.EAX;

  if MaxLeaf >= BrandFeatureSupport then
    begin
      Query := BrandQuery1;
      CallCpuId(Query);
      CvBrand := shortstring(BrandPart);
      Query := BrandQuery2;
      CallCpuId(Query);
      CvBrand += shortstring(BrandPart);
      Query := BrandQuery3;
      CallCpuId(Query);
      CvBrand += shortstring(BrandPart);
    end;

  if CPUPowManFeatureQuery.EAX > MaxLeaf then
    exit;

  Query := CPUPowManFeatureQuery;
  CallCpuId(Query);
  if LongBool(Query.EDX and InvTscEdxFlag) and OsSupportsInvTSC then
    Include(CvFeatures, cfInvTSC);
  //VIA Padlock ACE detection
  if (CvVendor = cvVIA) and (cfSSE in CvFeatures) then///??????
    begin
      //Centaur Extended Feature Flags
      Query := VIAPadlockExists;
      CallCpuId(Query);
      if Query.EAX < LowestVIAPadlockFunc then
        exit;
      Query := VIAPadlockFeatures;
      CallCpuId(Query);
      if (Query.EDX and ViaRngEdxFlags) = ViaRngEdxFlags then
        Include(CvFeatures, cfVIARNG);
      if (Query.EDX and ViaAceEdxFlags) = ViaAceEdxFlags then
        Include(CvFeatures, cfVIAACE);
      if (Query.EDX and ViaAce2EdxFlags) = ViaAce2EdxFlags then
        Include(CvFeatures, cfVIAACE2);
      if (Query.EDX and ViaPheEdxFlags) = ViaPheEdxFlags then
        Include(CvFeatures, cfVIAPHE);
      if (Query.EDX and ViaPmmEdxFlags) = ViaPmmEdxFlags then
        Include(CvFeatures, cfVIAPMM);
    end;
end;

class constructor TCpu.Setup;
begin
  CvFeatures := [];
  CvFamily := 0;
  CvModel := 0;
  CvStepping := 0;
  CvVendor := cvUnknown;
  CvBrand := 'Not supported';
  try
    TestFeatures;
  except
  end;
end;

class function TCpu.VendorString: string;
begin
  Result := CpuVendors[CvVendor];
end;

class function TCpu.BrandString: string;
begin
  Result := CvBrand;
end;

class function TCpu.HasCPUID: Boolean;
begin
  Result := cfCPUID in CvFeatures;
end;

class function TCpu.HasCMOV: Boolean;
begin
  Result := cfCMOV in CvFeatures;
end;

class function TCpu.HasTSC: Boolean;
begin
  Result := cfTSC in CvFeatures;
end;

class function TCpu.HasInvariantTSC: Boolean;
begin
  Result := cfInvTSC in CvFeatures;
end;

class function TCpu.HasMMX: Boolean;
begin
  Result := cfMMX in CvFeatures;
end;

class function TCpu.HasSSE: Boolean;
begin
  Result := cfSSE in CvFeatures;
end;

class function TCpu.HasSSE2: Boolean;
begin
  Result := cfSSE2 in CvFeatures;
end;

class function TCpu.HasSSE3: Boolean;
begin
  Result := cfSSE3 in CvFeatures;
end;

class function TCpu.HasSSSE3: Boolean;
begin
  Result := cfSSSE3 in CvFeatures;
end;

class function TCpu.HasFMA3: Boolean;
begin
  Result := cfFMA in CvFeatures;
end;

class function TCpu.HasSSE41: Boolean;
begin
  Result := cfSSE41 in CvFeatures;
end;

class function TCpu.HasSSE42: Boolean;
begin
  Result := cfSSE42 in CvFeatures;
end;

class function TCpu.HasAESNI: Boolean;
begin
  Result := cfAESNI in CvFeatures;
end;

class function TCpu.HasCLMULQDQ: Boolean;
begin
  Result := cfCLMULQDQ in CvFeatures;
end;

class function TCpu.HasAVX: Boolean;
begin
  Result := cfAVX in CvFeatures;
end;

class function TCpu.HasAVX2: Boolean;
begin
  Result := cfAVX2 in CvFeatures;
end;

class function TCpu.HasHLE: Boolean;
begin
  Result := cfTsxHle in CvFeatures;
end;

class function TCpu.HasRTM: Boolean;
begin
  Result := cfTsxRtm in CvFeatures;
end;

class function TCpu.HasXTEST: Boolean;
begin
  Result := HasHLE or HasRTM;
end;

class function TCpu.HasAVX512f: Boolean;
begin
  Result := cfAVX512f in CvFeatures;
end;

class function TCpu.HasAVX512cd: Boolean;
begin
  Result := cfAVX512cd in CvFeatures;
end;

class function TCpu.HasAVX512er: Boolean;
begin
  Result := cfAVX512er in CvFeatures;
end;

class function TCpu.HasAVX512pf: Boolean;
begin
  Result := cfAVX512pf in CvFeatures;
end;

class function TCpu.HasAVX512dq: Boolean;
begin
  Result := cfAVX512dq in CvFeatures;
end;

class function TCpu.HasAVX512bw: Boolean;
begin
  Result := cfAVX512bw in CvFeatures;
end;

class function TCpu.HasAVX512ifma: Boolean;
begin
  Result := cfAVX512ifma in CvFeatures;
end;

class function TCpu.HasAVX512vbmi: Boolean;
begin
  Result := cfAVX512vbmi in CvFeatures;
end;

class function TCpu.HasBMI1: Boolean;
begin
  Result := cfBMI1 in CvFeatures;
end;

class function TCpu.HasBMI2: Boolean;
begin
  Result := cfBMI2 in CvFeatures;
end;

class function TCpu.HasRDRAND: Boolean;
begin
  Result := cfRDRAND in CvFeatures;
end;

class function TCpu.HasRDSEED: Boolean;
begin
  Result := cfRDSeed in CvFeatures;
end;

class function TCpu.HasADX: Boolean;
begin
  Result := cfADX in CvFeatures;
end;

class function TCpu.HasPOPCNT: Boolean;
begin
  Result := cfPOPCNT in CvFeatures;
end;

class function TCpu.HasVAESNI: Boolean;
begin
  Result := HasAESNI and HasAVX;
end;

class function TCpu.HasVCLMULQDQ: Boolean;
begin
  Result := HasCLMULQDQ and HasAVX;
end;

class function TCpu.HasSHAX: Boolean;
begin
  Result := cfSHAX in CvFeatures;
end;

class function TCpu.HasVIARng: Boolean;
begin
  Result := cfVIARNG in CvFeatures;
end;

class function TCpu.HasVIAAce: Boolean;
begin
  Result := cfVIAACE in CvFeatures;
end;

class function TCpu.HasVIAAce2: Boolean;
begin
  Result := cfVIAACE2 in CvFeatures;
end;

class function TCpu.HasVIAPHE: Boolean;
begin
  Result := cfVIAPHE in CvFeatures;
end;

class function TCpu.HasVIAPMM: Boolean;
begin
  Result := cfVIAPMM in CvFeatures;
end;
{$ENDIF UC_CPU_INTEL}

end.


Вроде даже работал.

[IvoX]

CPUZ выдает вот что...

2020-10-22_230342.png

Глянул что такое FMA- Весьма специфичные инструкции типа a = b·a ± c для разного порядка слагаемых.

я даже строил свой наколенный фичедетектор:

Зато он полноценный. Я так понял всё определяет за раз,это удобнее чем десяток разрозненных функций.

[iskander]

Добавить FMA3 и SSSE3 легко, я обновил код.

Добавлено спустя 3 часа 13 минут 41 секунду:
Расширил список вендоров и обновил код.
Насчёт МЦСТ Эльбрус не уверен, инфу взял из вики.

[Alex2013]

МЦСТ Эльбрус

Скорее всего для него особого толку в расширениях не буде бо х86 там есть только в виде "бинарной трансляции"
(Тот есть добавить то можно что угодно ( на уровне прошивки и микро кода), но будет ли от этого толк вопрос темный.)

А вот китайский Zhaoxin KX-6000 точно поддерживает SMM, FPU, NX, MMX, SSE, SSE2, SSE3, SSSE3, SSE4.1, SSE4.2, AES, SM3, SM4, AVX(1/2)