insns.pl

   1 #!/usr/bin/perl
   2 ## --------------------------------------------------------------------------
   3 ##
   4 ##   Copyright 1996-2013 The NASM Authors - All Rights Reserved
   5 ##   See the file AUTHORS included with the NASM distribution for
   6 ##   the specific copyright holders.
   7 ##
   8 ##   Redistribution and use in source and binary forms, with or without
   9 ##   modification, are permitted provided that the following
  10 ##   conditions are met:
  11 ##
  12 ##   * Redistributions of source code must retain the above copyright
  13 ##     notice, this list of conditions and the following disclaimer.
  14 ##   * Redistributions in binary form must reproduce the above
  15 ##     copyright notice, this list of conditions and the following
  16 ##     disclaimer in the documentation and/or other materials provided
  17 ##     with the distribution.
  18 ##
  19 ##     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
  20 ##     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
  21 ##     INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  22 ##     MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  23 ##     DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
  24 ##     CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  25 ##     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  26 ##     NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  27 ##     LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28 ##     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
  29 ##     CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  30 ##     OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
  31 ##     EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32 ##
  33 ## --------------------------------------------------------------------------
  34
  35 #
  36 # insns.pl
  37 #
  38 # Parse insns.dat and produce generated source code files
  39
  40 # Opcode prefixes which need their own opcode tables
  41 # LONGER PREFIXES FIRST!
  42 @disasm_prefixes = qw(0F24 0F25 0F38 0F3A 0F7A 0FA6 0FA7 0F);
  43
  44 # This should match MAX_OPERANDS from nasm.h
  45 $MAX_OPERANDS = 5;
  46
  47 # Add VEX/XOP prefixes
  48 @vex_class = ( 'vex', 'xop', 'evex' );
  49 $vex_classes = scalar(@vex_class);
  50 @vexlist = ();
  51 %vexmap = ();
  52 for ($c = 0; $c < $vex_classes; $c++) {
  53     $vexmap{$vex_class[$c]} = $c;
  54     for ($m = 0; $m < 32; $m++) {
  55         for ($p = 0; $p < 4; $p++) {
  56             push(@vexlist, sprintf("%s%02X%01X", $vex_class[$c], $m, $p));
  57         }
  58     }
  59 }
  60 @disasm_prefixes = (@vexlist, @disasm_prefixes);
  61
  62 @bytecode_count = (0) x 256;
  63
  64 print STDERR "Reading insns.dat...\n";
  65
  66 @args   = ();
  67 undef $output;
  68 foreach $arg ( @ARGV ) {
  69     if ( $arg =~ /^\-/ ) {
  70         if  ( $arg =~ /^\-([abdin])$/ ) {
  71             $output = $1;
  72         } else {
  73             die "$0: Unknown option: ${arg}\n";
  74         }
  75     } else {
  76         push (@args, $arg);
  77     }
  78 }
  79
  80 $fname = "insns.dat" unless $fname = $args[0];
  81 open (F, $fname) || die "unable to open $fname";
  82
  83 %dinstables = ();
  84 @bytecode_list = ();
  85
  86 $line = 0;
  87 $insns = 0;
  88 while (<F>) {
  89     $line++;
  90     chomp;
  91     next if ( /^\s*(\;.*|)$/ );   # comments or blank lines
  92
  93     unless (/^\s*(\S+)\s+(\S+)\s+(\S+|\[.*\])\s+(\S+)\s*$/) {
  94         warn "line $line does not contain four fields\n";
  95         next;
  96     }
  97     @fields = ($1, $2, $3, $4);
  98     @field_list = ([@fields, 0]);
  99
 100     if ($fields[1] =~ /\*/) {
 101         # This instruction has relaxed form(s)
 102         if ($fields[2] !~ /^\[/) {
 103             warn "line $line has an * operand but uses raw bytecodes\n";
 104             next;
 105         }
 106
 107         $opmask = 0;
 108         @ops = split(/,/, $fields[1]);
 109         for ($oi = 0; $oi < scalar @ops; $oi++) {
 110             if ($ops[$oi] =~ /\*$/) {
 111                 if ($oi == 0) {
 112                     warn "line $line has a first operand with a *\n";
 113                     next;
 114                 }
 115                 $opmask |= 1 << $oi;
 116             }
 117         }
 118
 119         for ($oi = 1; $oi < (1 << scalar @ops); $oi++) {
 120             if (($oi & ~$opmask) == 0) {
 121                 my @xops = ();
 122                 my $omask = ~$oi;
 123                 for ($oj = 0; $oj < scalar(@ops); $oj++) {
 124                     if ($omask & 1) {
 125                         push(@xops, $ops[$oj]);
 126                     }
 127                     $omask >>= 1;
 128                 }
 129                 push(@field_list, [$fields[0], join(',', @xops),
 130                      $fields[2], $fields[3], $oi]);
 131             }
 132         }
 133     }
 134
 135     foreach $fptr (@field_list) {
 136         @fields = @$fptr;
 137         ($formatted, $nd) = format_insn(@fields);
 138         if ($formatted) {
 139             $insns++;
 140             $aname = "aa_$fields[0]";
 141             push @$aname, $formatted;
 142         }
 143         if ( $fields[0] =~ /cc$/ ) {
 144             # Conditional instruction
 145             $k_opcodes_cc{$fields[0]}++;
 146         } else {
 147             # Unconditional instruction
 148             $k_opcodes{$fields[0]}++;
 149         }
 150         if ($formatted && !$nd) {
 151             push @big, $formatted;
 152             my @sseq = startseq($fields[2], $fields[4]);
 153             foreach $i (@sseq) {
 154                 if (!defined($dinstables{$i})) {
 155                     $dinstables{$i} = [];
 156                 }
 157                 push(@{$dinstables{$i}}, $#big);
 158             }
 159         }
 160     }
 161 }
 162
 163 close F;
 164
 165 #
 166 # Generate the bytecode array.  At this point, @bytecode_list contains
 167 # the full set of bytecodes.
 168 #
 169
 170 # Sort by descending length
 171 @bytecode_list = sort { scalar(@$b) <=> scalar(@$a) } @bytecode_list;
 172 @bytecode_array = ();
 173 %bytecode_pos = ();
 174 $bytecode_next = 0;
 175 foreach $bl (@bytecode_list) {
 176     my $h = hexstr(@$bl);
 177     next if (defined($bytecode_pos{$h}));
 178
 179     push(@bytecode_array, $bl);
 180     while ($h ne '') {
 181         $bytecode_pos{$h} = $bytecode_next;
 182         $h = substr($h, 2);
 183         $bytecode_next++;
 184     }
 185 }
 186 undef @bytecode_list;
 187
 188 @opcodes    = sort keys(%k_opcodes);
 189 @opcodes_cc = sort keys(%k_opcodes_cc);
 190
 191 if ( !defined($output) || $output eq 'b') {
 192     print STDERR "Writing insnsb.c...\n";
 193
 194     open B, ">insnsb.c";
 195
 196     print B "/* This file auto-generated from insns.dat by insns.pl" .
 197         " - don't edit it */\n\n";
 198
 199     print B "#include \"nasm.h\"\n";
 200     print B "#include \"insns.h\"\n\n";
 201
 202     print B "const uint8_t nasm_bytecodes[$bytecode_next] = {\n";
 203
 204     $p = 0;
 205     foreach $bl (@bytecode_array) {
 206         printf B "    /* %5d */ ", $p;
 207         foreach $d (@$bl) {
 208             printf B "%#o,", $d;
 209             $p++;
 210         }
 211         printf B "\n";
 212     }
 213     print B "};\n";
 214
 215     print B "\n";
 216     print B "/*\n";
 217     print B " * Bytecode frequencies (including reuse):\n";
 218     print B " *\n";
 219     for ($i = 0; $i < 32; $i++) {
 220         print B " *";
 221         for ($j = 0; $j < 256; $j += 32) {
 222             print B " |" if ($j);
 223             printf B " %3o:%4d", $i+$j, $bytecode_count[$i+$j];
 224         }
 225         print B "\n";
 226     }
 227     print B " */\n";
 228
 229     close B;
 230 }
 231
 232 if ( !defined($output) || $output eq 'a' ) {
 233     print STDERR "Writing insnsa.c...\n";
 234
 235     open A, ">insnsa.c";
 236
 237     print A "/* This file auto-generated from insns.dat by insns.pl" .
 238         " - don't edit it */\n\n";
 239
 240     print A "#include \"nasm.h\"\n";
 241     print A "#include \"insns.h\"\n\n";
 242
 243     foreach $i (@opcodes, @opcodes_cc) {
 244         print A "static const struct itemplate instrux_${i}[] = {\n";
 245         $aname = "aa_$i";
 246         foreach $j (@$aname) {
 247             print A "    ", codesubst($j), "\n";
 248         }
 249         print A "    ITEMPLATE_END\n};\n\n";
 250     }
 251     print A "const struct itemplate * const nasm_instructions[] = {\n";
 252     foreach $i (@opcodes, @opcodes_cc) {
 253         print A "    instrux_${i},\n";
 254     }
 255     print A "};\n";
 256
 257     close A;
 258 }
 259
 260 if ( !defined($output) || $output eq 'd' ) {
 261     print STDERR "Writing insnsd.c...\n";
 262
 263     open D, ">insnsd.c";
 264
 265     print D "/* This file auto-generated from insns.dat by insns.pl" .
 266         " - don't edit it */\n\n";
 267
 268     print D "#include \"nasm.h\"\n";
 269     print D "#include \"insns.h\"\n\n";
 270
 271     print D "static const struct itemplate instrux[] = {\n";
 272     $n = 0;
 273     foreach $j (@big) {
 274         printf D "    /* %4d */ %s\n", $n++, codesubst($j);
 275     }
 276     print D "};\n";
 277
 278     foreach $h (sort(keys(%dinstables))) {
 279         next if ($h eq ''); # Skip pseudo-instructions
 280             print D "\nstatic const struct itemplate * const itable_${h}[] = {\n";
 281         foreach $j (@{$dinstables{$h}}) {
 282             print D "    instrux + $j,\n";
 283         }
 284         print D "};\n";
 285     }
 286
 287     @prefix_list = ();
 288     foreach $h (@disasm_prefixes, '') {
 289         for ($c = 0; $c < 256; $c++) {
 290             $nn = sprintf("%s%02X", $h, $c);
 291             if ($is_prefix{$nn} || defined($dinstables{$nn})) {
 292                 # At least one entry in this prefix table
 293                 push(@prefix_list, $h);
 294                 $is_prefix{$h} = 1;
 295                 last;
 296             }
 297         }
 298     }
 299
 300     foreach $h (@prefix_list) {
 301         print D "\n";
 302         print D "static " unless ($h eq '');
 303         print D "const struct disasm_index ";
 304         print D ($h eq '') ? 'itable' : "itable_$h";
 305         print D "[256] = {\n";
 306         for ($c = 0; $c < 256; $c++) {
 307             $nn = sprintf("%s%02X", $h, $c);
 308             if ($is_prefix{$nn}) {
 309                 die "$fname: ambiguous decoding of $nn\n"
 310                     if (defined($dinstables{$nn}));
 311                 printf D "    /* 0x%02x */ { itable_%s, -1 },\n", $c, $nn;
 312             } elsif (defined($dinstables{$nn})) {
 313                 printf D "    /* 0x%02x */ { itable_%s, %u },\n", $c,
 314                        $nn, scalar(@{$dinstables{$nn}});
 315             } else {
 316                 printf D "    /* 0x%02x */ { NULL, 0 },\n", $c;
 317             }
 318         }
 319         print D "};\n";
 320     }
 321
 322     printf D "\nconst struct disasm_index * const itable_vex[NASM_VEX_CLASSES][32][4] =\n";
 323     print D "{\n";
 324     for ($c = 0; $c < $vex_classes; $c++) {
 325         print D "    {\n";
 326         for ($m = 0; $m < 32; $m++) {
 327             print D "        { ";
 328             for ($p = 0; $p < 4; $p++) {
 329                 $vp = sprintf("%s%02X%01X", $vex_class[$c], $m, $p);
 330                 printf D "%-15s",
 331                        ($is_prefix{$vp} ? sprintf("itable_%s,", $vp) : 'NULL,');
 332             }
 333             print D "},\n";
 334         }
 335         print D "    },\n";
 336     }
 337     print D "};\n";
 338
 339     close D;
 340 }
 341
 342 if ( !defined($output) || $output eq 'i' ) {
 343     print STDERR "Writing insnsi.h...\n";
 344
 345     open I, ">insnsi.h";
 346
 347     print I "/* This file is auto-generated from insns.dat by insns.pl" .
 348         " - don't edit it */\n\n";
 349     print I "/* This file in included by nasm.h */\n\n";
 350
 351     print I "/* Instruction names */\n\n";
 352     print I "#ifndef NASM_INSNSI_H\n";
 353     print I "#define NASM_INSNSI_H 1\n\n";
 354     print I "enum opcode {\n";
 355     $maxlen = 0;
 356     foreach $i (@opcodes, @opcodes_cc) {
 357         print I "\tI_${i},\n";
 358         $len = length($i);
 359         $len++ if ( $i =~ /cc$/ ); # Condition codes can be 3 characters long
 360         $maxlen = $len if ( $len > $maxlen );
 361     }
 362     print I "\tI_none = -1\n";
 363     print I "};\n\n";
 364     print I "#define MAX_INSLEN ", $maxlen, "\n";
 365     print I "#define NASM_VEX_CLASSES ", $vex_classes, "\n";
 366     print I "#define NO_DECORATOR\t{", join(',',(0) x $MAX_OPERANDS), "}\n";
 367     print I "#define FIRST_COND_OPCODE I_", $opcodes_cc[0], "\n\n";
 368     print I "#endif /* NASM_INSNSI_H */\n";
 369
 370     close I;
 371 }
 372
 373 if ( !defined($output) || $output eq 'n' ) {
 374     print STDERR "Writing insnsn.c...\n";
 375
 376     open N, ">insnsn.c";
 377
 378     print N "/* This file is auto-generated from insns.dat by insns.pl" .
 379         " - don't edit it */\n\n";
 380     print N "#include \"tables.h\"\n\n";
 381
 382     print N "const char * const nasm_insn_names[] = {";
 383     $first = 1;
 384     foreach $i (@opcodes, @opcodes_cc) {
 385         print N "," if ( !$first );
 386         $first = 0;
 387         $ilower = $i;
 388         $ilower =~ s/cc$//;             # Remove conditional cc suffix
 389         $ilower =~ tr/A-Z/a-z/;         # Change to lower case (Perl 4 compatible)
 390         print N "\n\t\"${ilower}\"";
 391     }
 392     print N "\n};\n";
 393     close N;
 394 }
 395
 396 printf STDERR "Done: %d instructions\n", $insns;
 397
 398 # Count primary bytecodes, for statistics
 399 sub count_bytecodes(@) {
 400     my $skip = 0;
 401     foreach my $bc (@_) {
 402         if ($skip) {
 403             $skip--;
 404             next;
 405         }
 406         $bytecode_count[$bc]++;
 407         if ($bc >= 01 && $bc <= 04) {
 408             $skip = $bc;
 409         } elsif (($bc & ~03) == 010) {
 410             $skip = 1;
 411         } elsif (($bc & ~013) == 0144) {
 412             $skip = 1;
 413         } elsif ($bc == 0172 || $bc == 0173) {
 414             $skip = 1;
 415         } elsif (($bc & ~3) == 0260 || $bc == 0270) {   # VEX
 416             $skip = 2;
 417         } elsif (($bc & ~3) == 0240 || $bc == 0250) {   # EVEX
 418             $skip = 3;
 419         } elsif ($bc == 0330) {
 420             $skip = 1;
 421         }
 422     }
 423 }
 424
 425 sub format_insn($$$$$) {
 426     my ($opcode, $operands, $codes, $flags, $relax) = @_;
 427     my $num, $nd = 0;
 428     my @bytecode;
 429     my $op, @ops, $opp, @opx, @oppx, @decos, @opevex;
 430     my @iflags = (  "FPU", "MMX", "3DNOW", "SSE", "SSE2",
 431                     "SSE3", "VMX", "SSSE3", "SSE4A", "SSE41",
 432                     "SSE42", "SSE5", "AVX", "AVX2", "AVX512",
 433                     "FMA", "BMI1", "BMI2", "TBM", "RTM", "INVPCID");
 434
 435     return (undef, undef) if $operands eq "ignore";
 436
 437     # format the operands
 438     $operands =~ s/\*//g;
 439     $operands =~ s/:/|colon,/g;
 440     @ops = ();
 441     @decos = ();
 442     if ($operands ne 'void') {
 443         foreach $op (split(/,/, $operands)) {
 444             @opx = ();
 445             @opevex = ();
 446             foreach $opp (split(/\|/, $op)) {
 447                 @oppx = ();
 448                 if ($opp =~ s/^(b(32|64)|mask|z|er|sae)$//) {
 449                     push(@opevex, $1);
 450                 }
 451
 452                 if ($opp =~ s/(?<!\d)(8|16|32|64|80|128|256|512)$//) {
 453                     push(@oppx, "bits$1");
 454                 }
 455                 $opp =~ s/^mem$/memory/;
 456                 $opp =~ s/^memory_offs$/mem_offs/;
 457                 $opp =~ s/^imm$/immediate/;
 458                 $opp =~ s/^([a-z]+)rm$/rm_$1/;
 459                 $opp =~ s/^rm$/rm_gpr/;
 460                 $opp =~ s/^reg$/reg_gpr/;
 461                 push(@opx, $opp, @oppx) if $opp;
 462             }
 463             $op = join('|', @opx);
 464             push(@ops, $op);
 465             push(@decos, (@opevex ? join('|', @opevex) : '0'));
 466         }
 467     }
 468
 469     $num = scalar(@ops);
 470     while (scalar(@ops) < $MAX_OPERANDS) {
 471         push(@ops, '0');
 472         push(@decos, '0');
 473     }
 474     $operands = join(',', @ops);
 475     $operands =~ tr/a-z/A-Z/;
 476
 477     $decorators = "{" . join(',', @decos) . "}";
 478     if ($decorators =~ /^{(0,)+0}$/) {
 479         $decorators = "NO_DECORATOR";
 480     }
 481     $decorators =~ tr/a-z/A-Z/;
 482
 483     # check if two different insn set types are set
 484     $cnt = 0;
 485     foreach $fla (split(/,/, $flags)) {
 486         if (grep(/$fla/, @iflags)) {
 487             $cnt++;
 488             if ($cnt >= 2) {
 489                 die "Too many insn set flags in $flags\n";
 490             }
 491         }
 492     }
 493
 494     # format the flags
 495     $flags =~ s/,/|IF_/g;
 496     $flags =~ s/(\|IF_ND|IF_ND\|)//, $nd = 1 if $flags =~ /IF_ND/;
 497     $flags = "IF_" . $flags;
 498
 499     @bytecode = (decodify($codes, $relax), 0);
 500     push(@bytecode_list, [@bytecode]);
 501     $codes = hexstr(@bytecode);
 502     count_bytecodes(@bytecode);
 503
 504     ("{I_$opcode, $num, {$operands}, $decorators, \@\@CODES-$codes\@\@, $flags},", $nd);
 505 }
 506
 507 #
 508 # Look for @@CODES-xxx@@ sequences and replace them with the appropriate
 509 # offset into nasm_bytecodes
 510 #
 511 sub codesubst($) {
 512     my($s) = @_;
 513     my $n;
 514
 515     while ($s =~ /\@\@CODES-([0-9A-F]+)\@\@/) {
 516         my $pos = $bytecode_pos{$1};
 517         if (!defined($pos)) {
 518             die "$fname: no position assigned to byte code $1\n";
 519         }
 520         $s = $` . "nasm_bytecodes+${pos}" . "$'";
 521     }
 522     return $s;
 523 }
 524
 525 sub addprefix ($@) {
 526     my ($prefix, @list) = @_;
 527     my $x;
 528     my @l = ();
 529
 530     foreach $x (@list) {
 531         push(@l, sprintf("%s%02X", $prefix, $x));
 532     }
 533
 534     return @l;
 535 }
 536
 537 #
 538 # Turn a code string into a sequence of bytes
 539 #
 540 sub decodify($$) {
 541   # Although these are C-syntax strings, by convention they should have
 542   # only octal escapes (for directives) and hexadecimal escapes
 543   # (for verbatim bytes)
 544     my($codestr, $relax) = @_;
 545
 546     if ($codestr =~ /^\s*\[([^\]]*)\]\s*$/) {
 547         return byte_code_compile($1, $relax);
 548     }
 549
 550     my $c = $codestr;
 551     my @codes = ();
 552
 553     unless ($codestr eq 'ignore') {
 554         while ($c ne '') {
 555             if ($c =~ /^\\x([0-9a-f]+)(.*)$/i) {
 556                 push(@codes, hex $1);
 557                 $c = $2;
 558                 next;
 559             } elsif ($c =~ /^\\([0-7]{1,3})(.*)$/) {
 560                 push(@codes, oct $1);
 561                 $c = $2;
 562                 next;
 563             } else {
 564                 die "$fname: unknown code format in \"$codestr\"\n";
 565             }
 566         }
 567     }
 568
 569     return @codes;
 570 }
 571
 572 # Turn a numeric list into a hex string
 573 sub hexstr(@) {
 574     my $s = '';
 575     my $c;
 576
 577     foreach $c (@_) {
 578         $s .= sprintf("%02X", $c);
 579     }
 580     return $s;
 581 }
 582
 583 # Here we determine the range of possible starting bytes for a given
 584 # instruction. We need only consider the codes:
 585 # \[1234]      mean literal bytes, of course
 586 # \1[0123]     mean byte plus register value
 587 # \330         means byte plus condition code
 588 # \0 or \340   mean give up and return empty set
 589 # \34[4567]    mean PUSH/POP of segment registers: special case
 590 # \17[234]     skip is4 control byte
 591 # \26x \270    skip VEX control bytes
 592 # \24x \250    skip EVEX control bytes
 593 sub startseq($$) {
 594     my ($codestr, $relax) = @_;
 595     my $word, @range;
 596     my @codes = ();
 597     my $c = $codestr;
 598     my $c0, $c1, $i;
 599     my $prefix = '';
 600
 601     @codes = decodify($codestr, $relax);
 602
 603     while ($c0 = shift(@codes)) {
 604         $c1 = $codes[0];
 605         if ($c0 >= 01 && $c0 <= 04) {
 606             # Fixed byte string
 607             my $fbs = $prefix;
 608             while (1) {
 609                 if ($c0 >= 01 && $c0 <= 04) {
 610                     while ($c0--) {
 611                         $fbs .= sprintf("%02X", shift(@codes));
 612                     }
 613                 } else {
 614                     last;
 615                 }
 616                 $c0 = shift(@codes);
 617             }
 618
 619             foreach $pfx (@disasm_prefixes) {
 620                 if (substr($fbs, 0, length($pfx)) eq $pfx) {
 621                     $prefix = $pfx;
 622                     $fbs = substr($fbs, length($pfx));
 623                     last;
 624                 }
 625             }
 626
 627             if ($fbs ne '') {
 628                 return ($prefix.substr($fbs,0,2));
 629             }
 630
 631             unshift(@codes, $c0);
 632         } elsif ($c0 >= 010 && $c0 <= 013) {
 633             return addprefix($prefix, $c1..($c1+7));
 634         } elsif (($c0 & ~013) == 0144) {
 635             return addprefix($prefix, $c1, $c1|2);
 636         } elsif ($c0 == 0330) {
 637             return addprefix($prefix, $c1..($c1+15));
 638         } elsif ($c0 == 0 || $c0 == 0340) {
 639             return $prefix;
 640         } elsif (($c0 & ~3) == 0260 || $c0 == 0270 ||
 641                  ($c0 & ~3) == 0240 || $c0 == 0250) {
 642             my $c,$m,$wlp;
 643             $m   = shift(@codes);
 644             $wlp = shift(@codes);
 645             $c = ($m >> 6);
 646             $m = $m & 31;
 647             $prefix .= sprintf('%s%02X%01X', $vex_class[$c], $m, $wlp & 3);
 648             if ($c0 < 0260) {
 649                 my $tuple = shift(@codes);
 650             }
 651         } elsif ($c0 >= 0172 && $c0 <= 173) {
 652             shift(@codes);      # Skip is4 control byte
 653         } else {
 654             # We really need to be able to distinguish "forbidden"
 655             # and "ignorable" codes here
 656         }
 657     }
 658     return $prefix;
 659 }
 660
 661 # EVEX tuple types offset is 0300. e.g. 0301 is for full vector(fv).
 662 sub tupletype($) {
 663     my ($tuplestr) = @_;
 664     my %tuple_codes = (
 665         ''      => 000,
 666         'fv'    => 001,
 667         'hv'    => 002,
 668         'fvm'   => 003,
 669         't1s8'  => 004,
 670         't1s16' => 005,
 671         't1s'   => 006,
 672         't1f32' => 007,
 673         't1f64' => 010,
 674         't2'    => 011,
 675         't4'    => 012,
 676         't8'    => 013,
 677         'hvm'   => 014,
 678         'qvm'   => 015,
 679         'ovm'   => 016,
 680         'm128'  => 017,
 681         'dup'   => 020,
 682     );
 683
 684     if (defined $tuple_codes{$tuplestr}) {
 685         return 0300 + $tuple_codes{$tuplestr};
 686     } else {
 687         die "Undefined tuple type : $tuplestr\n";
 688     }
 689 }
 690
 691 #
 692 # This function takes a series of byte codes in a format which is more
 693 # typical of the Intel documentation, and encode it.
 694 #
 695 # The format looks like:
 696 #
 697 # [operands: opcodes]
 698 #
 699 # The operands word lists the order of the operands:
 700 #
 701 # r = register field in the modr/m
 702 # m = modr/m
 703 # v = VEX "v" field
 704 # i = immediate
 705 # s = register field of is4/imz2 field
 706 # - = implicit (unencoded) operand
 707 # x = indeX register of mib. 014..017 bytecodes are used.
 708 #
 709 # For an operand that should be filled into more than one field,
 710 # enter it as e.g. "r+v".
 711 #
 712 sub byte_code_compile($$) {
 713     my($str, $relax) = @_;
 714     my $opr;
 715     my $opc;
 716     my @codes = ();
 717     my $litix = undef;
 718     my %oppos = ();
 719     my $i;
 720     my $op, $oq;
 721     my $opex;
 722
 723     my %imm_codes = (
 724         'ib'        => 020,     # imm8
 725         'ib,u'      => 024,     # Unsigned imm8
 726         'iw'        => 030,     # imm16
 727         'ib,s'      => 0274,    # imm8 sign-extended to opsize or bits
 728         'iwd'       => 034,     # imm16 or imm32, depending on opsize
 729         'id'        => 040,     # imm32
 730         'id,s'      => 0254,    # imm32 sign-extended to 64 bits
 731         'iwdq'      => 044,     # imm16/32/64, depending on addrsize
 732         'rel8'      => 050,
 733         'iq'        => 054,
 734         'rel16'     => 060,
 735         'rel'       => 064,     # 16 or 32 bit relative operand
 736         'rel32'     => 070,
 737         'seg'       => 074,
 738     );
 739     my %plain_codes = (
 740         'o16'       => 0320,    # 16-bit operand size
 741         'o32'       => 0321,    # 32-bit operand size
 742         'odf'       => 0322,    # Operand size is default
 743         'o64'       => 0324,    # 64-bit operand size requiring REX.W
 744         'o64nw'     => 0323,    # Implied 64-bit operand size (no REX.W)
 745         'a16'       => 0310,
 746         'a32'       => 0311,
 747         'adf'       => 0312,    # Address size is default
 748         'a64'       => 0313,
 749         '!osp'      => 0364,
 750         '!asp'      => 0365,
 751         'f2i'       => 0332,    # F2 prefix, but 66 for operand size is OK
 752         'f3i'       => 0333,    # F3 prefix, but 66 for operand size is OK
 753         'mustrep'   => 0336,
 754         'mustrepne' => 0337,
 755         'rex.l'     => 0334,
 756         'norexb'    => 0314,
 757         'norexx'    => 0315,
 758         'norexr'    => 0316,
 759         'norexw'    => 0317,
 760         'repe'      => 0335,
 761         'nohi'      => 0325,    # Use spl/bpl/sil/dil even without REX
 762         'nof3'      => 0326,    # No REP 0xF3 prefix permitted
 763         'norep'     => 0331,    # No REP prefix permitted
 764         'wait'      => 0341,    # Needs a wait prefix
 765         'resb'      => 0340,
 766         'jcc8'      => 0370,    # Match only if Jcc possible with single byte
 767         'jmp8'      => 0371,    # Match only if JMP possible with single byte
 768         'bnd'       => 0372,    # BND (0xF2) prefix available
 769         'jlen'      => 0373,    # Length of jump
 770         'hlexr'     => 0271,
 771         'hlenl'     => 0272,
 772         'hle'       => 0273,
 773
 774         # This instruction takes XMM VSIB
 775         'vsibx'     => 0374,
 776         'vm32x'     => 0374,
 777         'vm64x'     => 0374,
 778
 779         # This instruction takes YMM VSIB
 780         'vsiby'     => 0375,
 781         'vm32y'     => 0375,
 782         'vm64y'     => 0375,
 783
 784         # This instruction takes ZMM VSIB
 785         'vsibz'     => 0376,
 786         'vm32z'     => 0376,
 787         'vm64z'     => 0376,
 788     );
 789
 790     unless ($str =~ /^(([^\s:]*)\:*([^\s:]*)\:|)\s*(.*\S)\s*$/) {
 791         die "$fname: $line: cannot parse: [$str]\n";
 792     }
 793     $opr = "\L$2";
 794     $tuple = "\L$3";    # Tuple type for AVX512
 795     $opc = "\L$4";
 796
 797     my $op = 0;
 798     for ($i = 0; $i < length($opr); $i++) {
 799         my $c = substr($opr,$i,1);
 800         if ($c eq '+') {
 801             $op--;
 802         } else {
 803             if ($relax & 1) {
 804                 $op--;
 805             }
 806             $relax >>= 1;
 807             $oppos{$c} = $op++;
 808         }
 809     }
 810     $tup = tupletype($tuple);
 811
 812     my $last_imm = 'h';
 813     my $prefix_ok = 1;
 814     foreach $op (split(/\s*(?:\s|(?=[\/\\]))/, $opc)) {
 815         my $pc = $plain_codes{$op};
 816
 817         if (defined $pc) {
 818             # Plain code
 819             push(@codes, $pc);
 820         } elsif ($prefix_ok && $op =~ /^(66|f2|f3|np)$/) {
 821             # 66/F2/F3 prefix used as an opcode extension, or np = no prefix
 822             if ($op eq '66') {
 823                 push(@codes, 0361);
 824             } elsif ($op eq 'f2') {
 825                 push(@codes, 0332);
 826             } elsif ($op eq 'f3') {
 827                 push(@codes, 0333);
 828             } else {
 829                 push(@codes, 0360);
 830             }
 831         } elsif ($op =~ /^[0-9a-f]{2}$/) {
 832             if (defined($litix) && $litix+$codes[$litix]+1 == scalar @codes &&
 833                 $codes[$litix] < 4) {
 834                 $codes[$litix]++;
 835                 push(@codes, hex $op);
 836             } else {
 837                 $litix = scalar(@codes);
 838                 push(@codes, 01, hex $op);
 839             }
 840             $prefix_ok = 0;
 841         } elsif ($op eq '/r') {
 842             if (!defined($oppos{'r'}) || !defined($oppos{'m'})) {
 843                 die "$fname: $line: $op requires r and m operands\n";
 844             }
 845             $opex = (($oppos{'m'} & 4) ? 06 : 0) |
 846                 (($oppos{'r'} & 4) ? 05 : 0);
 847             push(@codes, $opex) if ($opex);
 848             # if mib is composed with two separate operands - ICC style
 849             push(@codes, 014 + ($oppos{'x'} & 3)) if (defined($oppos{'x'}));
 850             push(@codes, 0100 + (($oppos{'m'} & 3) << 3) + ($oppos{'r'} & 3));
 851             $prefix_ok = 0;
 852         } elsif ($op =~ m:^/([0-7])$:) {
 853             if (!defined($oppos{'m'})) {
 854                 die "$fname: $line: $op requires m operand\n";
 855             }
 856             push(@codes, 06) if ($oppos{'m'} & 4);
 857             push(@codes, 0200 + (($oppos{'m'} & 3) << 3) + $1);
 858             $prefix_ok = 0;
 859         } elsif ($op =~ /^(vex|xop)(|\..*)$/) {
 860             my $c = $vexmap{$1};
 861             my ($m,$w,$l,$p) = (undef,2,undef,0);
 862             my $has_nds = 0;
 863             my @subops = split(/\./, $op);
 864             shift @subops;      # Drop prefix
 865                 foreach $oq (@subops) {
 866                     if ($oq eq '128' || $oq eq 'l0' || $oq eq 'lz') {
 867                         $l = 0;
 868                     } elsif ($oq eq '256' || $oq eq 'l1') {
 869                         $l = 1;
 870                     } elsif ($oq eq 'lig') {
 871                         $l = 2;
 872                     } elsif ($oq eq 'w0') {
 873                         $w = 0;
 874                     } elsif ($oq eq 'w1') {
 875                         $w = 1;
 876                     } elsif ($oq eq 'wig') {
 877                         $w = 2;
 878                     } elsif ($oq eq 'ww') {
 879                         $w = 3;
 880                     } elsif ($oq eq 'p0') {
 881                         $p = 0;
 882                     } elsif ($oq eq '66' || $oq eq 'p1') {
 883                         $p = 1;
 884                     } elsif ($oq eq 'f3' || $oq eq 'p2') {
 885                         $p = 2;
 886                     } elsif ($oq eq 'f2' || $oq eq 'p3') {
 887                         $p = 3;
 888                     } elsif ($oq eq '0f') {
 889                         $m = 1;
 890                     } elsif ($oq eq '0f38') {
 891                         $m = 2;
 892                     } elsif ($oq eq '0f3a') {
 893                         $m = 3;
 894                     } elsif ($oq =~ /^m([0-9]+)$/) {
 895                         $m = $1+0;
 896                     } elsif ($oq eq 'nds' || $oq eq 'ndd' || $oq eq 'dds') {
 897                         if (!defined($oppos{'v'})) {
 898                             die "$fname: $line: vex.$oq without 'v' operand\n";
 899                         }
 900                         $has_nds = 1;
 901                     } else {
 902                         die "$fname: $line: undefined VEX subcode: $oq\n";
 903                     }
 904                 }
 905             if (!defined($m) || !defined($w) || !defined($l) || !defined($p)) {
 906                 die "$fname: $line: missing fields in VEX specification\n";
 907             }
 908             if (defined($oppos{'v'}) && !$has_nds) {
 909                 die "$fname: $line: 'v' operand without vex.nds or vex.ndd\n";
 910             }
 911             push(@codes, defined($oppos{'v'}) ? 0260+($oppos{'v'} & 3) : 0270,
 912                  ($c << 6)+$m, ($w << 4)+($l << 2)+$p);
 913             $prefix_ok = 0;
 914         } elsif ($op =~ /^(evex)(|\..*)$/) {
 915             my $c = $vexmap{$1};
 916             my ($m,$w,$l,$p) = (undef,2,undef,0);
 917             my $has_nds = 0;
 918             my @subops = split(/\./, $op);
 919             shift @subops;      # Drop prefix
 920                 foreach $oq (@subops) {
 921                     if ($oq eq '128' || $oq eq 'l0' || $oq eq 'lz' || $oq eq 'lig') {
 922                         $l = 0;
 923                     } elsif ($oq eq '256' || $oq eq 'l1') {
 924                         $l = 1;
 925                     } elsif ($oq eq '512' || $oq eq 'l2') {
 926                         $l = 2;
 927                     } elsif ($oq eq 'w0') {
 928                         $w = 0;
 929                     } elsif ($oq eq 'w1') {
 930                         $w = 1;
 931                     } elsif ($oq eq 'wig') {
 932                         $w = 2;
 933                     } elsif ($oq eq 'ww') {
 934                         $w = 3;
 935                     } elsif ($oq eq 'p0') {
 936                         $p = 0;
 937                     } elsif ($oq eq '66' || $oq eq 'p1') {
 938                         $p = 1;
 939                     } elsif ($oq eq 'f3' || $oq eq 'p2') {
 940                         $p = 2;
 941                     } elsif ($oq eq 'f2' || $oq eq 'p3') {
 942                         $p = 3;
 943                     } elsif ($oq eq '0f') {
 944                         $m = 1;
 945                     } elsif ($oq eq '0f38') {
 946                         $m = 2;
 947                     } elsif ($oq eq '0f3a') {
 948                         $m = 3;
 949                     } elsif ($oq =~ /^m([0-9]+)$/) {
 950                         $m = $1+0;
 951                     } elsif ($oq eq 'nds' || $oq eq 'ndd' || $oq eq 'dds') {
 952                         if (!defined($oppos{'v'})) {
 953                             die "$fname: $line: evex.$oq without 'v' operand\n";
 954                         }
 955                         $has_nds = 1;
 956                     } else {
 957                         die "$fname: $line: undefined EVEX subcode: $oq\n";
 958                     }
 959                 }
 960             if (!defined($m) || !defined($w) || !defined($l) || !defined($p)) {
 961                 die "$fname: $line: missing fields in EVEX specification\n";
 962             }
 963             if (defined($oppos{'v'}) && !$has_nds) {
 964                 die "$fname: $line: 'v' operand without evex.nds or evex.ndd\n";
 965             }
 966             push(@codes, defined($oppos{'v'}) ? 0240+($oppos{'v'} & 3) : 0250,
 967                  ($c << 6)+$m, ($w << 4)+($l << 2)+$p, $tup);
 968             $prefix_ok = 0;
 969         } elsif (defined $imm_codes{$op}) {
 970             if ($op eq 'seg') {
 971                 if ($last_imm lt 'i') {
 972                     die "$fname: $line: seg without an immediate operand\n";
 973                 }
 974             } else {
 975                 $last_imm++;
 976                 if ($last_imm gt 'j') {
 977                     die "$fname: $line: too many immediate operands\n";
 978                 }
 979             }
 980             if (!defined($oppos{$last_imm})) {
 981                 die "$fname: $line: $op without '$last_imm' operand\n";
 982             }
 983             push(@codes, 05) if ($oppos{$last_imm} & 4);
 984             push(@codes, $imm_codes{$op} + ($oppos{$last_imm} & 3));
 985             $prefix_ok = 0;
 986         } elsif ($op eq '/is4') {
 987             if (!defined($oppos{'s'})) {
 988                 die "$fname: $line: $op without 's' operand\n";
 989             }
 990             if (defined($oppos{'i'})) {
 991                 push(@codes, 0172, ($oppos{'s'} << 3)+$oppos{'i'});
 992             } else {
 993                 push(@codes, 05) if ($oppos{'s'} & 4);
 994                 push(@codes, 0174+($oppos{'s'} & 3));
 995             }
 996             $prefix_ok = 0;
 997         } elsif ($op =~ /^\/is4\=([0-9]+)$/) {
 998             my $imm = $1;
 999             if (!defined($oppos{'s'})) {
1000                 die "$fname: $line: $op without 's' operand\n";
1001             }
1002             if ($imm < 0 || $imm > 15) {
1003                 die "$fname: $line: invalid imm4 value for $op: $imm\n";
1004             }
1005             push(@codes, 0173, ($oppos{'s'} << 4) + $imm);
1006             $prefix_ok = 0;
1007         } elsif ($op =~ /^([0-9a-f]{2})\+c$/) {
1008             push(@codes, 0330, hex $1);
1009             $prefix_ok = 0;
1010         } elsif ($op =~ /^([0-9a-f]{2})\+r$/) {
1011             if (!defined($oppos{'r'})) {
1012                 die "$fname: $line: $op without 'r' operand\n";
1013             }
1014             push(@codes, 05) if ($oppos{'r'} & 4);
1015             push(@codes, 010 + ($oppos{'r'} & 3), hex $1);
1016             $prefix_ok = 0;
1017         } elsif ($op =~ /^\\([0-7]+|x[0-9a-f]{2})$/) {
1018             # Escape to enter literal bytecodes
1019             push(@codes, oct $1);
1020         } else {
1021             die "$fname: $line: unknown operation: $op\n";
1022         }
1023     }
1024
1025     return @codes;
1026 }