l4/pkg/valgrind/src/valgrind-3.6.0-svn/none/tests/amd64/gen_insn_test.pl

   1 #!/usr/bin/perl
   2
   3 use 5.006;
   4 use strict;
   5 use warnings;
   6
   7 our %ArgTypes = (
   8                  r8 => "reg8_t",
   9                  r16 => "reg16_t",
  10                  r32 => "reg32_t",
  11                  r64 => "reg64_t",
  12                  mm => "reg64_t",
  13                  xmm => "reg128_t",
  14                  m8 => "reg8_t",
  15                  m16 => "reg16_t",
  16                  m32 => "reg32_t",
  17                  m64 => "reg64_t",
  18                  m128 => "reg128_t",
  19                  eflags => "reg32_t",
  20                  st => "reg64_t",
  21                  fpucw => "reg16_t",
  22                  fpusw => "reg16_t"
  23                  );
  24
  25 our %SubTypeFormats = (
  26                        sb => "%d",
  27                        ub => "%u",
  28                        sw => "%d",
  29                        uw => "%u",
  30                        sd => "%d",
  31                        ud => "%u",
  32                        sq => "%lld",
  33                        uq => "%llu",
  34                        ps => "%.16g",
  35                        pd => "%.16g"
  36                        );
  37
  38 our %SubTypeSuffixes = (
  39                         sb => "",
  40                         ub => "U",
  41                         sw => "",
  42                         uw => "",
  43                         sd => "",
  44                         ud => "",
  45                         sq => "LL",
  46                         uq => "ULL",
  47                         ps => "F",
  48                         pd => ""
  49                         );
  50
  51 our %RegNums = (
  52                 r9b => 0, r9w => 0, r9d => 0, r9 => 0,
  53                 r10b => 1, r10w => 1, r10d => 1, r10 => 1,
  54                 r11b => 2, r11w => 2, r11d => 2, r11 => 2,
  55                 r12b => 3, r12w => 3, r12d => 3, r12 => 3,
  56                 al => 4, ax => 4, eax => 4, rax => 4,
  57                 bl => 5, bx => 5, ebx => 5, rbx => 5,
  58                 cl => 6, cx => 6, ecx => 6, rcx => 6,
  59                 dl => 7, dx => 7, edx => 7, rdx => 7,
  60                 ah => 8,
  61                 bh => 9,
  62                 ch => 10,
  63                 dh => 11,
  64                 st0 => 0, st1 => 1, st2 => 2, st3 => 3,
  65                 st4 => 4, st5 => 5, st6 => 6, st7 => 7
  66                 );
  67
  68 our %RegTypes = (
  69                  al => "r8", ah => "r8", ax => "r16", eax => "r32", rax => "r64",
  70                  bl => "r8", bh => "r8", bx => "r16", ebx => "r32", rbx => "r64",
  71                  cl => "r8", ch => "r8", cx => "r16", ecx => "r32", rcx => "r64",
  72                  dl => "r8", dh => "r8", dx => "r16", edx => "r32", rdx => "r64"
  73                  );
  74
  75 #our @IntRegs = (
  76 #                { r8 => "al", r16 => "ax", r32 => "eax", r64 => "rax" },
  77 #                { r8 => "bl", r16 => "bx", r32 => "ebx", r64 => "rbx" },
  78 #                { r8 => "cl", r16 => "cx", r32 => "ecx", r64 => "rcx" },
  79 #                { r8 => "dl", r16 => "dx", r32 => "edx", r64 => "rdx" },
  80 #                { r8 => "ah" },
  81 #                { r8 => "bh" },
  82 #                { r8 => "ch" },
  83 #                { r8 => "dh" }
  84 #                );
  85
  86 our @IntRegs = (
  87                 { r8 => "r9b", r16 => "r9w", r32 => "r9d", r64 => "r9" },
  88                 { r8 => "r10b", r16 => "r10w", r32 => "r10d", r64 => "r10" },
  89                 { r8 => "r11b", r16 => "r11w", r32 => "r11d", r64 => "r11" },
  90                 { r8 => "r12b", r16 => "r12w", r32 => "r12d", r64 => "r12" },
  91                 { r8 => "al", r16 => "ax", r32 => "eax", r64 => "rax" },
  92                 { r8 => "bl", r16 => "bx", r32 => "ebx", r64 => "rbx" },
  93                 { r8 => "cl", r16 => "cx", r32 => "ecx", r64 => "rcx" },
  94                 { r8 => "dl", r16 => "dx", r32 => "edx", r64 => "rdx" },
  95                 { r8 => "ah" },
  96                 { r8 => "bh" },
  97                 { r8 => "ch" },
  98                 { r8 => "dh" }
  99                 );
 100
 101 print <<EOF;
 102 #include <math.h>
 103 #include <setjmp.h>
 104 #include <signal.h>
 105 #include <stdio.h>
 106 #include <stdlib.h>
 107
 108 typedef union {
 109   char sb[1];
 110   unsigned char ub[1];
 111 } reg8_t;
 112
 113 typedef union {
 114   char sb[2];
 115   unsigned char ub[2];
 116   short sw[1];
 117   unsigned short uw[1];
 118 } reg16_t;
 119
 120 typedef union {
 121   char sb[4];
 122   unsigned char ub[4];
 123   short sw[2];
 124   unsigned short uw[2];
 125   int sd[1];
 126   unsigned int ud[1];
 127   float ps[1];
 128 } reg32_t;
 129
 130 typedef union {
 131   char sb[8];
 132   unsigned char ub[8];
 133   short sw[4];
 134   unsigned short uw[4];
 135   int sd[2];
 136   unsigned int ud[2];
 137   long long int sq[1];
 138   unsigned long long int uq[1];
 139   float ps[2];
 140   double pd[1];
 141 } reg64_t __attribute__ ((aligned (8)));
 142
 143 typedef union {
 144   char sb[16];
 145   unsigned char ub[16];
 146   short sw[8];
 147   unsigned short uw[8];
 148   int sd[4];
 149   unsigned int ud[4];
 150   long long int sq[2];
 151   unsigned long long int uq[2];
 152   float ps[4];
 153   double pd[2];
 154 } reg128_t __attribute__ ((aligned (16)));
 155
 156 static sigjmp_buf catchpoint;
 157
 158 static void handle_sigill(int signum)
 159 {
 160    siglongjmp(catchpoint, 1);
 161 }
 162
 163 __attribute__((unused))
 164 static int eq_float(float f1, float f2)
 165 {
 166    /* return f1 == f2 || fabsf(f1 - f2) < fabsf(f1) * 1.5 * powf(2,-12); */
 167    return f1 == f2 || fabsf(f1 - f2) < fabsf(f1) * 1.5 / 4096.0;
 168 }
 169
 170 __attribute__((unused))
 171 static int eq_double(double d1, double d2)
 172 {
 173    /* return d1 == d2 || fabs(d1 - d2) < fabs(d1) * 1.5 * pow(2,-12); */
 174    return d1 == d2 || fabs(d1 - d2) < fabs(d1) * 1.5 / 4096.0;
 175 }
 176
 177 EOF
 178
 179 my %tests;
 180 my @tests;
 181
 182 while (<>)
 183 {
 184     next if /^#/;
 185
 186     my $insn;
 187     my $presets;
 188     my $args;
 189     my $results;
 190
 191     if (/^(\S+)\s+(?:(\S+(?:\s+\S+)*)\s+:\s+)?((?:\S+\s+)*?)(?:=>\s+(\S+(?:\s+\S+)*))?$/)
 192     {
 193         $insn = $1;
 194         $presets = $2 || "";
 195         $args = $3 || "";
 196         $results = $4 || "";
 197
 198 #        print STDERR "insn: $insn\n";
 199 #        print STDERR "presets: $presets\n";
 200 #        print STDERR "args: $args\n";
 201 #        print STDERR "results: $results\n";
 202     }
 203     else
 204     {
 205         die "Can't parse test $_";
 206     }
 207
 208     $tests{$insn}++;
 209
 210     my $test = "${insn}_$tests{$insn}";
 211
 212     push @tests, $test;
 213
 214     print qq|static void $test(void)\n|;
 215     print qq|\{\n|;
 216
 217     my @intregs = @IntRegs;
 218     my @mmregs  = map { "mm$_" }  (6,7,0,1,2,3,4,5);
 219 #    my @xmmregs = map { "xmm$_" } (4,5,0,1,2,3,6,7);
 220     my @xmmregs = map { "xmm$_" } (12,13,8,9,10,11,14,15);
 221     my @fpregs  = map { "st$_" }  (0 .. 7);
 222
 223     my @presets;
 224     my $presetc = 0;
 225     my $eflagsmask;
 226     my $eflagsset;
 227     my $fpucwmask;
 228     my $fpucwset;
 229     my $fpuswmask;
 230     my $fpuswset;
 231
 232     foreach my $preset (split(/\s+/, $presets))
 233     {
 234         if ($preset =~ /^([abcd][lh]|[abcd]x|e[abcd]x|r[abcd]x)\.(sb|ub|sw|uw|sd|ud|sq|uq|ps|pd)\[([^\]]+)\]$/)
 235         {
 236             my $name = "preset$presetc";
 237             my $type = $RegTypes{$1};
 238             my $regnum = $RegNums{$1};
 239             my $register = $intregs[$regnum];
 240             my $subtype = $2;
 241             my @values = split(/,/, $3);
 242
 243             die "Register $1 already used" unless defined($register);
 244
 245             my $preset = {
 246                 name => $name,
 247                 type => $type,
 248                 subtype => $subtype,
 249                 register => $register
 250             };
 251
 252             delete($intregs[$regnum]);
 253
 254             push @presets, $preset;
 255
 256             print qq|   $ArgTypes{$type} $name = \{ .$subtype = \{|;
 257
 258             my $valuec = 0;
 259
 260             foreach my $value (@values)
 261             {
 262                 print qq|,| if $valuec > 0;
 263                 print qq| $value$SubTypeSuffixes{$subtype}|;
 264                 $valuec++;
 265             }
 266
 267             print qq| \} \};\n|;
 268
 269             $presetc++;
 270         }
 271         elsif ($preset =~ /^st([0-9]+)\.(ps|pd)\[([^\]]+)\]$/)
 272         {
 273             my $name = "preset$presetc";
 274             my $type = "st";
 275             my $regnum = $1;
 276             my $register = $fpregs[$regnum];
 277             my $subtype = $2;
 278             my @values = split(/,/, $3);
 279
 280             die "Register st$1 already used" unless defined($register);
 281
 282             my $preset = {
 283                 name => $name,
 284                 type => $type,
 285                 subtype => $subtype,
 286                 register => $register
 287             };
 288
 289             delete($fpregs[$regnum]);
 290
 291             push @presets, $preset;
 292
 293             print qq|   $ArgTypes{$type} $name = \{ .$subtype = \{|;
 294
 295             my $valuec = 0;
 296
 297             foreach my $value (@values)
 298             {
 299                 print qq|,| if $valuec > 0;
 300                 print qq| $value$SubTypeSuffixes{$subtype}|;
 301                 $valuec++;
 302             }
 303
 304             print qq| \} \};\n|;
 305
 306             $presetc++;
 307         }
 308         elsif ($preset =~ /^(eflags)\[([^\]]+)\]$/)
 309         {
 310             my $type = $1;
 311             my @values = split(/,/, $2);
 312
 313             $values[0] = oct($values[0]) if $values[0] =~ /^0/;
 314             $values[1] = oct($values[1]) if $values[1] =~ /^0/;
 315
 316             $eflagsmask = sprintf "0x%08x", $values[0] ^ 0xffffffff;
 317             $eflagsset = sprintf "0x%08x", $values[1];
 318         }
 319         elsif ($preset =~ /^(fpucw)\[([^\]]+)\]$/)
 320         {
 321             my $type = $1;
 322             my @values = split(/,/, $2);
 323
 324             $values[0] = oct($values[0]) if $values[0] =~ /^0/;
 325             $values[1] = oct($values[1]) if $values[1] =~ /^0/;
 326
 327             $fpucwmask = sprintf "0x%04x", $values[0] ^ 0xffff;
 328             $fpucwset = sprintf "0x%04x", $values[1];
 329         }
 330         elsif ($preset =~ /^(fpusw)\[([^\]]+)\]$/)
 331         {
 332             my $type = $1;
 333             my @values = split(/,/, $2);
 334
 335             $values[0] = oct($values[0]) if $values[0] =~ /^0/;
 336             $values[1] = oct($values[1]) if $values[1] =~ /^0/;
 337
 338             $fpuswmask = sprintf "0x%04x", $values[0] ^ 0xffff;
 339             $fpuswset = sprintf "0x%04x", $values[1];
 340         }
 341         else
 342         {
 343             die "Can't parse preset $preset";
 344         }
 345     }
 346
 347     my @args;
 348     my $argc = 0;
 349
 350     foreach my $arg (split(/\s+/, $args))
 351     {
 352         my $name = "arg$argc";
 353
 354         if ($arg =~ /^([abcd]l|[abcd]x|e[abcd]x|r[abcd]x|r8|r16|r32|r64|mm|xmm|m8|m16|m32|m64|m128)\.(sb|ub|sw|uw|sd|ud|sq|uq|ps|pd)\[([^\]]+)\]$/)
 355         {
 356             my $type = $RegTypes{$1} || $1;
 357             my $regnum = $RegNums{$1};
 358             my $register = $intregs[$regnum] if defined($regnum);
 359             my $subtype = $2;
 360             my @values = split(/,/, $3);
 361
 362             die "Register $1 already used" if defined($regnum) && !defined($register);
 363
 364             my $arg = {
 365                 name => $name,
 366                 type => $type,
 367                 subtype => $subtype
 368             };
 369
 370             if (defined($register))
 371             {
 372                 $arg->{register} = $register;
 373                 delete($intregs[$regnum]);
 374             }
 375
 376             push @args, $arg;
 377
 378             print qq|   $ArgTypes{$type} $name = \{ .$subtype = \{|;
 379
 380             my $valuec = 0;
 381
 382             foreach my $value (@values)
 383             {
 384                 print qq|,| if $valuec > 0;
 385                 print qq| $value$SubTypeSuffixes{$subtype}|;
 386                 $valuec++;
 387             }
 388
 389             print qq| \} \};\n|;
 390         }
 391         elsif ($arg =~ /^st([0-9]+)\.(ps|pd)\[([^\]]+)\]$/)
 392         {
 393             my $type = "st";
 394             my $regnum = $1;
 395             my $register = $fpregs[$regnum] if defined($regnum);
 396             my $subtype = $2;
 397             my @values = split(/,/, $3);
 398
 399             die "Register st$1 already used" if defined($regnum) && !defined($register);
 400
 401             my $arg = {
 402                 name => $name,
 403                 type => $type,
 404                 subtype => $subtype
 405             };
 406
 407             if (defined($register))
 408             {
 409                 $arg->{register} = $register;
 410                 delete($fpregs[$regnum]);
 411             }
 412
 413             push @args, $arg;
 414
 415             print qq|   $ArgTypes{$type} $name = \{ .$subtype = \{|;
 416
 417             my $valuec = 0;
 418
 419             foreach my $value (@values)
 420             {
 421                 print qq|,| if $valuec > 0;
 422                 print qq| $value$SubTypeSuffixes{$subtype}|;
 423                 $valuec++;
 424             }
 425
 426             print qq| \} \};\n|;
 427         }
 428         elsif ($arg =~ /^(imm8|imm16|imm32|imm64)\[([^\]]+)\]$/)
 429         {
 430             my $type = $1;
 431             my $value = $2;
 432
 433             my $arg = {
 434                 type => $type,
 435                 value => $value
 436             };
 437
 438             push @args, $arg;
 439         }
 440         else
 441         {
 442             die "Can't parse argument $arg";
 443         }
 444
 445         $argc++;
 446     }
 447
 448     foreach my $arg (@presets, @args)
 449     {
 450         if ($arg->{type} =~ /^(r8|r16|r32|r64|m8|m16|m32)$/)
 451         {
 452             while (!exists($arg->{register}) || !defined($arg->{register}))
 453             {
 454                 $arg->{register} = shift @intregs;
 455             }
 456
 457             $arg->{register} = $arg->{register}->{$arg->{type}};
 458         }
 459         elsif ($arg->{type} =~ /^(mm|m64)$/)
 460         {
 461             $arg->{register} = shift @mmregs;
 462         }
 463         elsif ($arg->{type} =~ /^(xmm|m128)$/)
 464         {
 465             $arg->{register} = shift @xmmregs;
 466         }
 467         elsif ($arg->{type} =~ /^st$/)
 468         {
 469             while (!exists($arg->{register}) || !defined($arg->{register}))
 470             {
 471                 $arg->{register} = shift @fpregs;
 472             }
 473         }
 474     }
 475
 476     my @results;
 477     my $resultc = 0;
 478
 479     foreach my $result (split(/\s+/, $results))
 480     {
 481         my $name = "result$resultc";
 482
 483         if ($result =~ /^(\d+)\.(sb|ub|sw|uw|sd|ud|sq|uq|ps|pd)\[([^\]]+)\]$/)
 484         {
 485             my $index = $1;
 486             my $type = $args[$index]->{type};
 487             my $subtype = $2;
 488             my @values = split(/,/, $3);
 489
 490             die "Argument $index not specified" unless exists($args[$index]);
 491
 492             my $result = {
 493                 name => $name,
 494                 type => $type,
 495                 subtype => $subtype,
 496                 arg => $args[$index],
 497                 register => $args[$index]->{register},
 498                 values => [ @values ]
 499             };
 500
 501             push @results, $result;
 502
 503             print qq|   $ArgTypes{$type} $name|;
 504             print qq| = arg$index| if $type =~ /^m(8|16|32|64|128)$/;
 505             print qq|;\n|;
 506
 507             $args[$index]->{result} = $result;
 508         }
 509         elsif ($result =~ /^([abcd][lh]|[abcd]x|e[abcd]x|r[abcd]x)\.(sb|ub|sw|uw|sd|ud|sq|uq|ps|pd)\[([^\]]+)\]$/)
 510         {
 511             my $register = $1;
 512             my $type = $RegTypes{$register};
 513             my $subtype = $2;
 514             my @values = split(/,/, $3);
 515
 516             my $result = {
 517                 name => $name,
 518                 type => $type,
 519                 subtype => $subtype,
 520                 register => $register,
 521                 values => [ @values ]
 522             };
 523
 524             push @results, $result;
 525
 526             print qq|   $ArgTypes{$type} $name;\n|;
 527         }
 528         elsif ($result =~ /^(st[0-9]+)\.(ps|pd)\[([^\]]+)\]$/)
 529         {
 530             my $register = $1;
 531             my $type = "st";
 532             my $subtype = $2;
 533             my @values = split(/,/, $3);
 534
 535             my $result = {
 536                 name => $name,
 537                 type => $type,
 538                 subtype => $subtype,
 539                 register => $register,
 540                 values => [ @values ]
 541             };
 542
 543             push @results, $result;
 544
 545             print qq|   $ArgTypes{$type} $name;\n|;
 546         }
 547         elsif ($result =~ /^eflags\[([^\]]+)\]$/)
 548         {
 549             my @values = split(/,/, $1);
 550
 551             $values[0] = oct($values[0]) if $values[0] =~ /^0/;
 552             $values[1] = oct($values[1]) if $values[1] =~ /^0/;
 553
 554             my $result = {
 555                 name => $name,
 556                 type => "eflags",
 557                 subtype => "ud",
 558                 values => [ map { sprintf "0x%08x", $_ } @values ]
 559             };
 560
 561             push @results, $result;
 562
 563             print qq|   $ArgTypes{eflags} $name;\n|;
 564
 565             if (!defined($eflagsmask) && !defined($eflagsset))
 566             {
 567                 $eflagsmask = sprintf "0x%08x", $values[0] ^ 0xffffffff;
 568                 $eflagsset = sprintf "0x%08x", $values[0] & ~$values[1];
 569             }
 570         }
 571         elsif ($result =~ /^fpucw\[([^\]]+)\]$/)
 572         {
 573             my @values = split(/,/, $1);
 574
 575             $values[0] = oct($values[0]) if $values[0] =~ /^0/;
 576             $values[1] = oct($values[1]) if $values[1] =~ /^0/;
 577
 578             my $result = {
 579                 name => $name,
 580                 type => "fpucw",
 581                 subtype => "ud",
 582                 values => [ map { sprintf "0x%04x", $_ } @values ]
 583             };
 584
 585             push @results, $result;
 586
 587             print qq|   $ArgTypes{fpucw} $name;\n|;
 588
 589             if (!defined($fpucwmask) && !defined($fpucwset))
 590             {
 591                 $fpucwmask = sprintf "0x%04x", $values[0] ^ 0xffff;
 592                 $fpucwset = sprintf "0x%04x", $values[0] & ~$values[1];
 593             }
 594         }
 595         elsif ($result =~ /^fpusw\[([^\]]+)\]$/)
 596         {
 597             my @values = split(/,/, $1);
 598
 599             $values[0] = oct($values[0]) if $values[0] =~ /^0/;
 600             $values[1] = oct($values[1]) if $values[1] =~ /^0/;
 601
 602             my $result = {
 603                 name => $name,
 604                 type => "fpusw",
 605                 subtype => "ud",
 606                 values => [ map { sprintf "0x%04x", $_ } @values ]
 607             };
 608
 609             push @results, $result;
 610
 611             print qq|   $ArgTypes{fpusw} $name;\n|;
 612
 613             if (!defined($fpuswmask) && !defined($fpuswset))
 614             {
 615                 $fpuswmask = sprintf "0x%04x", $values[0] ^ 0xffff;
 616                 $fpuswset = sprintf "0x%04x", $values[0] & ~$values[1];
 617             }
 618         }
 619         else
 620         {
 621             die "Can't parse result $result";
 622         }
 623
 624         $resultc++;
 625     }
 626
 627     my $argnum = 0;
 628
 629     foreach my $result (@results)
 630     {
 631         if ($result->{type} eq "xmm")
 632         {
 633             $result->{argnuml} = $argnum++;
 634             $result->{argnumh} = $argnum++;
 635         }
 636         else
 637         {
 638             $result->{argnum} = $argnum++;
 639         }
 640     }
 641
 642     foreach my $arg (@presets, @args)
 643     {
 644         if (defined($arg->{name}))
 645         {
 646             if ($arg->{type} eq "xmm")
 647             {
 648                 $arg->{argnuml} = $argnum++;
 649                 $arg->{argnumh} = $argnum++;
 650             }
 651             else
 652             {
 653                 $arg->{argnum} = $argnum++;
 654             }
 655         }
 656     }
 657
 658     my $stateargnum = $argnum++;
 659
 660     print qq|   char state\[108\];\n|;
 661     print qq|\n|;
 662     print qq|   if (sigsetjmp(catchpoint, 1) == 0)\n|;
 663     print qq|   \{\n|;
 664     print qq|      asm\(\n|;
 665 #    print qq|         \"fsave %$stateargnum\\n\"\n|;
 666     print qq|         \"ffree %%st(7)\\n\"\n|;
 667     print qq|         \"ffree %%st(6)\\n\"\n|;
 668     print qq|         \"ffree %%st(5)\\n\"\n|;
 669     print qq|         \"ffree %%st(4)\\n\"\n|;
 670
 671     my @fpargs;
 672
 673     foreach my $arg (@presets, @args)
 674     {
 675         if ($arg->{type} eq "r8")
 676         {
 677             print qq|         \"movb %$arg->{argnum}, %%$arg->{register}\\n\"\n|;
 678         }
 679         elsif ($arg->{type} eq "r16")
 680         {
 681             print qq|         \"movw %$arg->{argnum}, %%$arg->{register}\\n\"\n|;
 682         }
 683         elsif ($arg->{type} eq "r32")
 684         {
 685             print qq|         \"movl %$arg->{argnum}, %%$arg->{register}\\n\"\n|;
 686         }
 687         elsif ($arg->{type} eq "r64")
 688         {
 689             print qq|         \"movq %$arg->{argnum}, %%$arg->{register}\\n\"\n|;
 690         }
 691         elsif ($arg->{type} eq "mm")
 692         {
 693             print qq|         \"movq %$arg->{argnum}, %%$arg->{register}\\n\"\n|;
 694         }
 695         elsif ($arg->{type} eq "xmm")
 696         {
 697             print qq|         \"movlps %$arg->{argnuml}, %%$arg->{register}\\n\"\n|;
 698             print qq|         \"movhps %$arg->{argnumh}, %%$arg->{register}\\n\"\n|;
 699         }
 700         elsif ($arg->{type} eq "st")
 701         {
 702             $fpargs[$RegNums{$arg->{register}}] = $arg;
 703         }
 704     }
 705
 706     foreach my $arg (reverse @fpargs)
 707     {
 708         if (defined($arg))
 709         {
 710             if ($arg->{subtype} eq "ps")
 711             {
 712                 print qq|         \"flds %$arg->{argnum}\\n\"\n|;
 713             }
 714             elsif ($arg->{subtype} eq "pd")
 715             {
 716                 print qq|         \"fldl %$arg->{argnum}\\n\"\n|;
 717             }
 718         }
 719         else
 720         {
 721             print qq|         \"fldz\\n\"\n|;
 722         }
 723     }
 724
 725     if (defined($eflagsmask) || defined($eflagsset))
 726     {
 727         print qq|         \"pushfq\\n\"\n|;
 728         print qq|         \"andl \$$eflagsmask, (%%rsp)\\n\"\n| if defined($eflagsmask);
 729         print qq|         \"andl \$0, 4(%%rsp)\\n\"\n| if defined($eflagsmask);
 730         print qq|         \"orq \$$eflagsset, (%%rsp)\\n\"\n| if defined($eflagsset);
 731         print qq|         \"popfq\\n\"\n|;
 732     }
 733
 734     if (defined($fpucwmask) || defined($fpucwset))
 735     {
 736         print qq|         \"subq \$2, %%rsp\\n\"\n|;
 737         print qq|         \"fstcw (%%rsp)\\n\"\n|;
 738         print qq|         \"andw \$$fpucwmask, (%%rsp)\\n\"\n| if defined($fpucwmask);
 739         print qq|         \"orw \$$fpucwset, (%%rsp)\\n\"\n| if defined($fpucwset);
 740         print qq|         \"fldcw (%%rsp)\\n\"\n|;
 741         print qq|         \"addq \$2, %%rsp\\n\"\n|;
 742     }
 743
 744     print qq|         \"$insn|;
 745
 746     my $prefix = " ";
 747
 748     foreach my $arg (@args)
 749     {
 750         next if $arg->{type} eq "eflags";
 751
 752         if ($arg->{type} =~ /^(r8|r16|r32|r64|mm|xmm)$/)
 753         {
 754             print qq|$prefix%%$arg->{register}|;
 755         }
 756         elsif ($arg->{type} =~ /^st$/)
 757         {
 758             my $register = $arg->{register};
 759
 760             $register =~ s/st(\d+)/st\($1\)/;
 761
 762             print qq|$prefix%%$register|;
 763         }
 764         elsif ($arg->{type} =~ /^(m(8|16|32|64|128))$/)
 765         {
 766             if (exists($arg->{result}))
 767             {
 768                 print qq|$prefix%$arg->{result}->{argnum}|;
 769             }
 770             else
 771             {
 772                 print qq|$prefix%$arg->{argnum}|;
 773             }
 774         }
 775         elsif ($arg->{type} =~ /^imm(8|16|32|64)$/)
 776         {
 777             print qq|$prefix\$$arg->{value}|;
 778         }
 779
 780         $prefix = ", ";
 781     }
 782
 783     print qq|\\n\"\n|;
 784
 785     my @fpresults;
 786
 787     foreach my $result (@results)
 788     {
 789         if ($result->{type} eq "r8")
 790         {
 791             print qq|         \"movb %%$result->{register}, %$result->{argnum}\\n\"\n|;
 792         }
 793         elsif ($result->{type} eq "r16")
 794         {
 795             print qq|         \"movw %%$result->{register}, %$result->{argnum}\\n\"\n|;
 796         }
 797         elsif ($result->{type} eq "r32")
 798         {
 799             print qq|         \"movl %%$result->{register}, %$result->{argnum}\\n\"\n|;
 800         }
 801         elsif ($result->{type} eq "r64")
 802         {
 803             print qq|         \"movq %%$result->{register}, %$result->{argnum}\\n\"\n|;
 804         }
 805         elsif ($result->{type} eq "mm")
 806         {
 807             print qq|         \"movq %%$result->{register}, %$result->{argnum}\\n\"\n|;
 808         }
 809         elsif ($result->{type} eq "xmm")
 810         {
 811             print qq|         \"movlps %%$result->{register}, %$result->{argnuml}\\n\"\n|;
 812             print qq|         \"movhps %%$result->{register}, %$result->{argnumh}\\n\"\n|;
 813         }
 814         elsif ($result->{type} eq "st")
 815         {
 816             $fpresults[$RegNums{$result->{register}}] = $result;
 817         }
 818         elsif ($result->{type} eq "eflags")
 819         {
 820             print qq|         \"pushfq\\n\"\n|;
 821             print qq|         \"popq %$result->{argnum}\\n\"\n|;
 822         }
 823         elsif ($result->{type} eq "fpucw")
 824         {
 825             print qq|         \"fstcw %$result->{argnum}\\n\"\n|;
 826         }
 827         elsif ($result->{type} eq "fpusw")
 828         {
 829             print qq|         \"fstsw %$result->{argnum}\\n\"\n|;
 830         }
 831     }
 832
 833     foreach my $result (@fpresults)
 834     {
 835         if (defined($result))
 836         {
 837             if ($result->{subtype} eq "ps")
 838             {
 839                 print qq|         \"fstps %$result->{argnum}\\n\"\n|;
 840             }
 841             elsif ($result->{subtype} eq "pd")
 842             {
 843                 print qq|         \"fstpl %$result->{argnum}\\n\"\n|;
 844             }
 845         }
 846         else
 847         {
 848             print qq|         \"fincstp\\n\"\n|;
 849         }
 850     }
 851
 852 #    print qq|         \"frstor %$stateargnum\\n\"\n|;
 853
 854     print qq|         :|;
 855
 856     $prefix = " ";
 857
 858     foreach my $result (@results)
 859     {
 860         if ($result->{type} eq "xmm")
 861         {
 862             print qq|$prefix\"=m\" \($result->{name}.uq[0]\), \"=m\" \($result->{name}.uq[1]\)|;
 863         }
 864         else
 865         {
 866             print qq|$prefix\"=m\" \($result->{name}\)|;
 867         }
 868
 869         $prefix = ", ";
 870     }
 871
 872     print qq|\n|;
 873
 874     $prefix = "         : ";
 875
 876     foreach my $arg (@presets, @args)
 877     {
 878         if (defined($arg->{name}))
 879         {
 880             if ($arg->{type} eq "xmm")
 881             {
 882                 print qq|$prefix\"m\" \($arg->{name}.uq[0]\), \"m\" \($arg->{name}.uq[1]\)|;
 883             }
 884             else
 885             {
 886                 print qq|$prefix\"m\" \($arg->{name}\)|;
 887             }
 888
 889             $prefix = ", ";
 890         }
 891     }
 892
 893     print qq|$prefix\"m\" \(state[0]\)\n|;
 894
 895     $prefix = "         : ";
 896
 897     foreach my $arg (@presets, @args)
 898     {
 899         if ($arg->{register} && $arg->{type} ne "st")
 900         {
 901             my $register = $arg->{register};
 902
 903             $register =~ s/^(r[0-9]+)[bwd]$/$1/;
 904             print qq|$prefix\"$register\"|;
 905             $prefix = ", ";
 906         }
 907     }
 908
 909     print qq|\n|;
 910
 911     print qq|      \);\n|;
 912     print qq|\n|;
 913
 914     if (@results)
 915     {
 916         print qq|      if \(|;
 917
 918         $prefix = "";
 919
 920         foreach my $result (@results)
 921         {
 922             my $type = $result->{type};
 923             my $subtype = $result->{subtype};
 924             my $suffix = $SubTypeSuffixes{$subtype};
 925             my @values = @{$result->{values}};
 926
 927             if ($type eq "eflags")
 928             {
 929                 print qq|${prefix}\($result->{name}.ud[0] & $values[0]UL\) == $values[1]UL|;
 930             }
 931             elsif ($type =~ /^fpu[cs]w$/)
 932             {
 933                 print qq|${prefix}\($result->{name}.uw[0] & $values[0]\) == $values[1]|;
 934             }
 935             else
 936             {
 937                 foreach my $value (0 .. $#values)
 938                 {
 939                     if ($subtype eq "ps")
 940                     {
 941                         print qq|${prefix}eq_float($result->{name}.$subtype\[$value\], $values[$value]$suffix)|;
 942                     }
 943                     elsif ($subtype eq "pd")
 944                     {
 945                         print qq|${prefix}eq_double($result->{name}.$subtype\[$value\], $values[$value]$suffix)|;
 946                     }
 947                     else
 948                     {
 949                         print qq|${prefix}$result->{name}.$subtype\[$value\] == $values[$value]$suffix|;
 950                     }
 951
 952                     $prefix = " && ";
 953                 }
 954             }
 955
 956             $prefix = " &&\n          ";
 957         }
 958
 959         print qq| \)\n|;
 960         print qq|      \{\n|;
 961         print qq|         printf("$test ... ok\\n");\n|;
 962         print qq|      \}\n|;
 963         print qq|      else\n|;
 964         print qq|      \{\n|;
 965         print qq|         printf("$test ... not ok\\n");\n|;
 966
 967         foreach my $result (@results)
 968         {
 969             my $type = $result->{type};
 970             my $subtype = $result->{subtype};
 971             my $suffix = $SubTypeSuffixes{$subtype};
 972             my @values = @{$result->{values}};
 973
 974             if ($type eq "eflags")
 975             {
 976                 print qq|         printf("  eflags & 0x%lx = 0x%lx (expected 0x%lx)\\n", $values[0]UL, $result->{name}.ud\[0\] & $values[0]UL, $values[1]UL);\n|;
 977             }
 978             elsif ($type =~ /^fpu[cs]w$/)
 979             {
 980                 print qq|         printf("  $type & 0x%x = 0x%x (expected 0x%x)\\n", $values[0], $result->{name}.uw\[0\] & $values[0], $values[1]);\n|;
 981             }
 982             else
 983             {
 984                 foreach my $value (0 .. $#values)
 985                 {
 986                     print qq|         printf("  $result->{name}.$subtype\[$value\] = $SubTypeFormats{$subtype} (expected $SubTypeFormats{$subtype})\\n", $result->{name}.$subtype\[$value\], $values[$value]$suffix);\n|;
 987                 }
 988             }
 989         }
 990
 991         print qq|      \}\n|;
 992     }
 993     else
 994     {
 995         print qq|      printf("$test ... ok\\n");\n|;
 996     }
 997
 998     print qq|   \}\n|;
 999     print qq|   else\n|;
1000     print qq|   \{\n|;
1001     print qq|      printf("$test ... failed\\n");\n|;
1002     print qq|   \}\n|;
1003     print qq|\n|;
1004     print qq|   return;\n|;
1005     print qq|\}\n|;
1006     print qq|\n|;
1007 }
1008
1009 print qq|int main(int argc, char **argv)\n|;
1010 print qq|\{\n|;
1011 print qq|   signal(SIGILL, handle_sigill);\n|;
1012 print qq|\n|;
1013
1014 foreach my $test (@tests)
1015 {
1016     print qq|   $test();\n|;
1017 }
1018
1019 print qq|\n|;
1020 print qq|   exit(0);\n|;
1021 print qq|\}\n|;
1022
1023 exit 0;