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