devel/perlasm/cpuid-x86_64.pl

   1 #!/usr/bin/env perl
   2 #
   3 # ====================================================================
   4 # Written by Nikos Mavrogiannopoulos
   5 # Based on e_padlock-x86_64
   6 # ====================================================================
   7 #
   8
   9 $flavour = shift;
  10 $output  = shift;
  11 if ($flavour =~ /\./) { $output = $flavour; undef $flavour; }
  12
  13 $win64=0; $win64=1 if ($flavour =~ /[nm]asm|mingw64/ || $output =~ /\.asm$/);
  14
  15 $0 =~ m/(.*[\/\\])[^\/\\]+$/; $dir=$1;
  16 ( $xlate="${dir}x86_64-xlate.pl" and -f $xlate ) or
  17 ( $xlate="${dir}../../crypto/perlasm/x86_64-xlate.pl" and -f $xlate) or
  18 die "can't locate x86_64-xlate.pl";
  19
  20 open STDOUT,"| $^X $xlate $flavour $output";
  21
  22 $code=".text\n";
  23
  24 ($arg1,$arg2,$arg3,$arg4)=$win64?("%rcx","%rdx","%r8", "%r9") : # Win64 order
  25                                  ("%rdi","%rsi","%rdx","%rcx"); # Unix order
  26
  27
  28 $code.=<<___;
  29 .globl gnutls_cpuid
  30 .type gnutls_cpuid,\@function
  31 .align  16
  32 gnutls_cpuid:
  33         pushq   %rbp
  34         movq    %rsp, %rbp
  35         pushq   %rbx
  36         movl    %edi, -12(%rbp)
  37         movq    %rsi, -24(%rbp)
  38         movq    %rdx, -32(%rbp)
  39         movq    %rcx, -40(%rbp)
  40         movq    %r8, -48(%rbp)
  41         movl    -12(%rbp), %eax
  42         movl    %eax, -60(%rbp)
  43         movl    -60(%rbp), %eax
  44         cpuid
  45         movl    %edx, -56(%rbp)
  46         movl    %ecx, %esi
  47         movl    %eax, -52(%rbp)
  48         movq    -24(%rbp), %rax
  49         movl    -52(%rbp), %edx
  50         movl    %edx, (%rax)
  51         movq    -32(%rbp), %rax
  52         movl    %ebx, (%rax)
  53         movq    -40(%rbp), %rax
  54         movl    %esi, (%rax)
  55         movq    -48(%rbp), %rax
  56         movl    -56(%rbp), %ecx
  57         movl    %ecx, (%rax)
  58         popq    %rbx
  59         leave
  60         ret
  61 .size gnutls_cpuid,.-gnutls_cpuid
  62 ___
  63
  64 $code =~ s/\`([^\`]*)\`/eval($1)/gem;
  65
  66 print $code;
  67
  68 close STDOUT;
  69