basis/cpu/x86/features/features.factor

   1 ! Copyright (C) 2009, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.c-types alien.data arrays assocs combinators
   4 compiler.codegen.labels cpu.architecture cpu.x86.assembler
   5 cpu.x86.assembler.operands init kernel math math.order
   6 math.parser memoize namespaces sequences
   7 specialized-arrays system math.bitwise combinators.smart ;
   8 SPECIALIZED-ARRAY: uint
   9 IN: cpu.x86.features
  10
  11 <PRIVATE
  12
  13 : return-reg ( -- reg ) int-regs return-regs at first ;
  14
  15 : (sse-version) ( -- n )
  16     int { } cdecl [
  17         "sse-42" define-label
  18         "sse-41" define-label
  19         "ssse-3" define-label
  20         "sse-3" define-label
  21         "sse-2" define-label
  22         "sse-1" define-label
  23         "end" define-label
  24
  25         return-reg 1 MOV
  26
  27         CPUID
  28
  29         ECX 20 BT
  30         "sse-42" get JB
  31
  32         ECX 19 BT
  33         "sse-41" get JB
  34
  35         ECX  9 BT
  36         "ssse-3" get JB
  37
  38         ECX  0 BT
  39         "sse-3" get JB
  40
  41         EDX 26 BT
  42         "sse-2" get JB
  43
  44         EDX 25 BT
  45         "sse-1" get JB
  46
  47         return-reg 0 MOV
  48         "end" get JMP
  49
  50         "sse-42" resolve-label
  51         return-reg 42 MOV
  52         "end" get JMP
  53
  54         "sse-41" resolve-label
  55         return-reg 41 MOV
  56         "end" get JMP
  57
  58         "ssse-3" resolve-label
  59         return-reg 33 MOV
  60         "end" get JMP
  61
  62         "sse-3" resolve-label
  63         return-reg 30 MOV
  64         "end" get JMP
  65
  66         "sse-2" resolve-label
  67         return-reg 20 MOV
  68         "end" get JMP
  69
  70         "sse-1" resolve-label
  71         return-reg 10 MOV
  72
  73         "end" resolve-label
  74     ] alien-assembly ;
  75
  76 PRIVATE>
  77
  78 MEMO: sse-version ( -- n )
  79     (sse-version) "sse-version" get string>number [ min ] when* ;
  80
  81 : sse? ( -- ? ) sse-version 10 >= ;
  82 : sse2? ( -- ? ) sse-version 20 >= ;
  83 : sse3? ( -- ? ) sse-version 30 >= ;
  84 : ssse3? ( -- ? ) sse-version 33 >= ;
  85 : sse4.1? ( -- ? ) sse-version 41 >= ;
  86 : sse4.2? ( -- ? ) sse-version 42 >= ;
  87
  88 HOOK: (cpuid) cpu ( rax rcx regs -- )
  89
  90
  91 : cpuid-extended ( rax rcx -- 4array )
  92    4 uint <c-array> [ (cpuid) ] keep >array ;
  93
  94 : cpuid ( rax -- 4array ) 0 cpuid-extended ;
  95
  96 : cpuid-processor-info ( -- eax ) 1 cpuid first ; inline
  97
  98 : parse-stepping ( eax -- n ) 3 0 bit-range ; inline
  99 : parse-model ( eax -- n ) 7 4 bit-range ; inline
 100 : parse-family ( eax -- n ) 11 8 bit-range ; inline
 101 : parse-processor-type ( eax -- n ) 13 12 bit-range ; inline
 102 : parse-extended-model ( eax -- n ) 19 16 bit-range ; inline
 103 : parse-extended-family ( eax -- n ) 27 20 bit-range ; inline
 104
 105 : cpu-stepping ( -- n ) cpuid-processor-info parse-stepping ;
 106 : cpu-model ( -- n ) cpuid-processor-info parse-model ;
 107 : cpu-family ( -- n ) cpuid-processor-info parse-family ;
 108 : cpu-processor-type ( -- n ) cpuid-processor-info parse-processor-type ;
 109 : cpu-extended-model ( -- n ) cpuid-processor-info parse-extended-model ;
 110 : cpu-extended-family ( -- n ) cpuid-processor-info parse-extended-family ;
 111
 112 : cpu-family-model-string ( -- string )
 113     [
 114         cpuid-processor-info {
 115             [ parse-extended-family >hex ]
 116             [ parse-family >hex ]
 117             [ drop "_" ]
 118             [ parse-extended-model >hex ]
 119             [ parse-model >hex ]
 120         } cleave
 121     ] "" append-outputs-as ;
 122
 123 : popcnt? ( -- ? )
 124     bool { } cdecl [
 125         return-reg 1 MOV
 126         CPUID
 127         return-reg dup XOR
 128         ECX 23 BT
 129         return-reg SETB
 130     ] alien-assembly ;
 131
 132 : tscdeadline? ( -- ? ) 1 cpuid third 24 bit? ;
 133 : aes? ( -- ? ) 1 cpuid third 25 bit? ;
 134 : xsave? ( -- ? ) 1 cpuid third 26 bit? ;
 135 : osxsave? ( -- ? ) 1 cpuid third 27 bit? ;
 136 : avx? ( -- ? ) 1 cpuid third 28 bit? ;
 137 : f16c? ( -- ? ) 1 cpuid third 29 bit? ;
 138 : rdrand? ( -- ? ) 1 cpuid third 30 bit? ;
 139
 140 : msr? ( -- ? ) 1 cpuid fourth 5 bit? ;
 141 : tm1? ( -- ? ) 1 cpuid fourth 29 bit? ;
 142 : tm2? ( -- ? ) 1 cpuid third 8 bit? ;
 143
 144 : rdrand8 ( -- x )
 145     uchar { } cdecl [
 146         AL RDRAND
 147     ] alien-assembly ;
 148
 149 : rdrand16 ( -- x )
 150     ushort { } cdecl [
 151         AX RDRAND
 152     ] alien-assembly ;
 153
 154 : rdrand32 ( -- x )
 155     uint { } cdecl [
 156         EAX RDRAND
 157     ] alien-assembly ;
 158
 159 : rdrand64 ( -- x )
 160     ulonglong { } cdecl [
 161         RAX RDRAND
 162     ] alien-assembly ;
 163
 164 MEMO: enable-popcnt? ( -- ? )
 165     popcnt? "disable-popcnt" get not and ;
 166
 167 STARTUP-HOOK: [
 168     { sse-version enable-popcnt? } [ reset-memoized ] each
 169 ]
 170
 171 : sse-string ( version -- string )
 172     {
 173         { 00 [ "no SSE" ] }
 174         { 10 [ "SSE1" ] }
 175         { 20 [ "SSE2" ] }
 176         { 30 [ "SSE3" ] }
 177         { 33 [ "SSSE3" ] }
 178         { 41 [ "SSE4.1" ] }
 179         { 42 [ "SSE4.2" ] }
 180     } case ;
 181
 182 HOOK: instruction-count cpu ( -- n )
 183
 184 M: x86.32 instruction-count
 185     longlong { } cdecl [
 186         RDTSC
 187     ] alien-assembly ;
 188
 189 M: x86.64 instruction-count
 190     longlong { } cdecl [
 191         RAX 0 MOV
 192         RDTSC
 193         RDX 32 SHL
 194         RAX RDX OR
 195     ] alien-assembly ;
 196
 197 : count-instructions ( quot -- n )
 198     instruction-count [ call instruction-count ] dip - ; inline