gen_insn_test.pl

The Valgrind distribution has multiple tools. The most popular is the memory checking tool (called M

            my $type = $RegTypes{$register};
            my $subtype = $2;
            my @values = split(/,/, $3);
                        
            my $result = {
                name => $name,
                type => $type,
                subtype => $subtype,
                register => $register,
                values => [ @values ]
            };

            push @results, $result;

            print qq|   $ArgTypes{$type} $name;\n|;
        }
        elsif ($result =~ /^(st[0-9]+)\.(ps|pd)\[([^\]]+)\]$/)
        {
            my $register = $1;
            my $type = "st";
            my $subtype = $2;
            my @values = split(/,/, $3);
                        
            my $result = {
                name => $name,
                type => $type,
                subtype => $subtype,
                register => $register,
                values => [ @values ]
            };

            push @results, $result;

            print qq|   $ArgTypes{$type} $name;\n|;
        }
        elsif ($result =~ /^eflags\[([^\]]+)\]$/)
        {
            my @values = split(/,/, $1);
            
            $values[0] = oct($values[0]) if $values[0] =~ /^0/;
            $values[1] = oct($values[1]) if $values[1] =~ /^0/;
            
            my $result = {
                name => $name,
                type => "eflags",
                subtype => "ud",
                values => [ map { sprintf "0x%08x", $_ } @values ]
            };

            push @results, $result;
            
            print qq|   $ArgTypes{eflags} $name;\n|;

            if (!defined($eflagsmask) && !defined($eflagsset))
            {
                $eflagsmask = sprintf "0x%08x", $values[0] ^ 0xffffffff;
                $eflagsset = sprintf "0x%08x", $values[0] & ~$values[1];
            }
        }
        elsif ($result =~ /^fpucw\[([^\]]+)\]$/)
        {
            my @values = split(/,/, $1);
            
            $values[0] = oct($values[0]) if $values[0] =~ /^0/;
            $values[1] = oct($values[1]) if $values[1] =~ /^0/;
            
            my $result = {
                name => $name,
                type => "fpucw",
                subtype => "ud",
                values => [ map { sprintf "0x%04x", $_ } @values ]
            };

            push @results, $result;
            
            print qq|   $ArgTypes{fpucw} $name;\n|;

            if (!defined($fpucwmask) && !defined($fpucwset))
            {
                $fpucwmask = sprintf "0x%04x", $values[0] ^ 0xffff;
                $fpucwset = sprintf "0x%04x", $values[0] & ~$values[1];
            }
        }
        elsif ($result =~ /^fpusw\[([^\]]+)\]$/)
        {
            my @values = split(/,/, $1);
            
            $values[0] = oct($values[0]) if $values[0] =~ /^0/;
            $values[1] = oct($values[1]) if $values[1] =~ /^0/;
            
            my $result = {
                name => $name,
                type => "fpusw",
                subtype => "ud",
                values => [ map { sprintf "0x%04x", $_ } @values ]
            };

            push @results, $result;
            
            print qq|   $ArgTypes{fpusw} $name;\n|;

            if (!defined($fpuswmask) && !defined($fpuswset))
            {
                $fpuswmask = sprintf "0x%04x", $values[0] ^ 0xffff;
                $fpuswset = sprintf "0x%04x", $values[0] & ~$values[1];
            }
        }
        else
        {
            die "Can't parse result $result";
        }
        
        $resultc++;
    }
    
    my $argnum = 0;

    foreach my $result (@results)
    {
        if ($result->{type} =~ /^(m(8|16|32|64|128)|st|eflags|fpu[cs]w)$/)
        {
            $result->{argnum} = $argnum++;
        }
    }
    
    foreach my $arg (@presets, @args)
    {
        if (defined($arg->{name}))
        {
            $arg->{argnum} = $argnum++;
        }
    }
    
    foreach my $result (@results)
    {
        if ($result->{type} =~ /^(r(8|16|32)|mm|xmm)$/)
        {
            $result->{argnum} = $argnum++;
        }
    }

    my $stateargnum = $argnum++;

    print qq|   char state\[108\];\n|;
    print qq|\n|;
    print qq|   if (sigsetjmp(catchpoint, 1) == 0)\n|;
    print qq|   \{\n|;
    print qq|      asm\(\n|;
    print qq|         \"fsave %$stateargnum\\n\"\n|;
    
    my @fpargs;

    foreach my $arg (@presets, @args)
    {
        if ($arg->{type} eq "r8")
        {
            print qq|         \"movb %$arg->{argnum}, %%$arg->{register}\\n\"\n|;
        }
        elsif ($arg->{type} eq "r16")
        {
            print qq|         \"movw %$arg->{argnum}, %%$arg->{register}\\n\"\n|;
        }
        elsif ($arg->{type} eq "r32")
        {
            print qq|         \"movl %$arg->{argnum}, %%$arg->{register}\\n\"\n|;
        }
        elsif ($arg->{type} eq "mm")
        {
            print qq|         \"movq %$arg->{argnum}, %%$arg->{register}\\n\"\n|;
        }
        elsif ($arg->{type} eq "xmm")
        {
            print qq|         \"movlps 0%$arg->{argnum}, %%$arg->{register}\\n\"\n|;
            print qq|         \"movhps 8%$arg->{argnum}, %%$arg->{register}\\n\"\n|;
        }
        elsif ($arg->{type} eq "st")
        {
            $fpargs[$RegNums{$arg->{register}}] = $arg;
        }
    }
    
    foreach my $arg (reverse @fpargs)
    {
        if (defined($arg))
        {
            if ($arg->{subtype} eq "ps")
            {
                print qq|         \"flds %$arg->{argnum}\\n\"\n|;
            }
            elsif ($arg->{subtype} eq "pd")
            {
                print qq|         \"fldl %$arg->{argnum}\\n\"\n|;
            }
        }
        else
        {
            print qq|         \"fldz\\n\"\n|;
        }
    }

    if (defined($eflagsmask) || defined($eflagsset))
    {
        print qq|         \"pushfl\\n\"\n|;
        print qq|         \"andl \$$eflagsmask, (%%esp)\\n\"\n| if defined($eflagsmask);
        print qq|         \"orl \$$eflagsset, (%%esp)\\n\"\n| if defined($eflagsset);
        print qq|         \"popfl\\n\"\n|;
    }

    if (defined($fpucwmask) || defined($fpucwset))
    {
        print qq|         \"subl \$2, %%esp\\n\"\n|;
        print qq|         \"fstcw (%%esp)\\n\"\n|;
        print qq|         \"andw \$$fpucwmask, (%%esp)\\n\"\n| if defined($fpucwmask);
        print qq|         \"orw \$$fpucwset, (%%esp)\\n\"\n| if defined($fpucwset);
        print qq|         \"fldcw (%%esp)\\n\"\n|;
        print qq|         \"addl \$2, %%esp\\n\"\n|;
    }

    print qq|         \"$insn|;
    
    my $prefix = " ";
    
    foreach my $arg (@args)
    {
        next if $arg->{type} eq "eflags";

        if ($arg->{type} =~ /^(r8|r16|r32|mm|xmm)$/)
        {
            print qq|$prefix%%$arg->{register}|;
        }
        elsif ($arg->{type} =~ /^st$/)
        {
            my $register = $arg->{register};

            $register =~ s/st(\d+)/st\($1\)/;

            print qq|$prefix%%$register|;
        }
        elsif ($arg->{type} =~ /^(m(8|16|32|64|128))$/)
        {
            if (exists($arg->{result}))
            {
                print qq|$prefix%$arg->{result}->{argnum}|;
            }
            else
            {
                print qq|$prefix%$arg->{argnum}|;
            }
        }
        elsif ($arg->{type} =~ /^imm(8|16|32)$/)
        {
            print qq|$prefix\$$arg->{value}|;
        }

        $prefix = ", ";
    }

    print qq|\\n\"\n|;

    my @fpresults;

    foreach my $result (@results)
    {
        if ($result->{type} eq "r8")
        {
            print qq|         \"movb %%$result->{register}, %$result->{argnum}\\n\"\n|;
        }
        elsif ($result->{type} eq "r16")
        {
            print qq|         \"movw %%$result->{register}, %$result->{argnum}\\n\"\n|;
        }
        elsif ($result->{type} eq "r32")
        {
            print qq|         \"movl %%$result->{register}, %$result->{argnum}\\n\"\n|;
        }
        elsif ($result->{type} eq "mm")
        {
            print qq|         \"movq %%$result->{register}, %$result->{argnum}\\n\"\n|;
        }
        elsif ($result->{type} eq "xmm")
        {
            print qq|         \"movlps %%$result->{register}, 0%$result->{argnum}\\n\"\n|;
            print qq|         \"movhps %%$result->{register}, 8%$result->{argnum}\\n\"\n|;
        }
        elsif ($result->{type} eq "st")
        {
            $fpresults[$RegNums{$result->{register}}] = $result;
        }
        elsif ($result->{type} eq "eflags")
        {
            print qq|         \"pushfl\\n\"\n|;
            print qq|         \"popl %$result->{argnum}\\n\"\n|;
        }
        elsif ($result->{type} eq "fpucw")
        {
            print qq|         \"fstcw %$result->{argnum}\\n\"\n|;
        }
        elsif ($result->{type} eq "fpusw")
        {
            print qq|         \"fstsw %$result->{argnum}\\n\"\n|;
        }
    }
    
    foreach my $result (@fpresults)
    {
        if (defined($result))
        {
            if ($result->{subtype} eq "ps")
            {
                print qq|         \"fstps %$result->{argnum}\\n\"\n|;
            }
            elsif ($result->{subtype} eq "pd")
            {
                print qq|         \"fstpl %$result->{argnum}\\n\"\n|;
            }
        }
        else
        {
            print qq|         \"fincstp\\n\"\n|;
        }
    }

    print qq|         \"frstor %$stateargnum\\n\"\n|;

    print qq|         :|;

    $prefix = " ";

    foreach my $result (@results)
    {
        if ($result->{type} =~ /^(m(8|16|32|64|128)|st|eflags|fpu[cs]w)$/)
        {
            print qq|$prefix\"=m\" \($result->{name}\)|;
            $prefix = ", ";
        }
    }

    print qq|\n|;
    
    $prefix = "         : ";
    
    foreach my $arg (@presets, @args)
    {
        if (defined($arg->{name}))
        {
            print qq|$prefix\"m\" \($arg->{name}\)|;
            $prefix = ", ";
        }
    }
    
    foreach my $result (@results)
    {
        if ($result->{type} =~ /^(r(8|16|32)|mm|xmm)$/)
        {
            print qq|$prefix\"m\" \($result->{name}\)|;
            $prefix = ", ";
        }
    }

    print qq|$prefix\"m\" \(state[0]\)\n|;

    $prefix = "         : ";

    foreach my $arg (@presets, @args)
    {
        if ($arg->{register} && $arg->{type} ne "st")
        {
            print qq|$prefix\"$arg->{register}\"|;
            $prefix = ", ";
        }
    }

    print qq|\n|;
    
    print qq|      \);\n|;                          
    print qq|\n|;
    
    if (@results)
    {
        print qq|      if \(|;
        
        $prefix = "";
        
        foreach my $result (@results)
        {
            my $type = $result->{type};
            my $subtype = $result->{subtype};
            my $suffix = $SubTypeSuffixes{$subtype};
            my @values = @{$result->{values}};
            
            if ($type eq "eflags")
            {
                print qq|${prefix}\($result->{name}.ud[0] & $values[0]UL\) == $values[1]UL|;
            }
            elsif ($type =~ /^fpu[cs]w$/)
            {
                print qq|${prefix}\($result->{name}.uw[0] & $values[0]\) == $values[1]|;
            }
            else
            {
                foreach my $value (0 .. $#values)
                {
                    if ($subtype eq "ps")
                    {
                        print qq|${prefix}eq_float($result->{name}.$subtype\[$value\], $values[$value]$suffix)|;
                    }
                    elsif ($subtype eq "pd")
                    {
                        print qq|${prefix}eq_double($result->{name}.$subtype\[$value\], $values[$value]$suffix)|;
                    }
                    else
                    {
                        print qq|${prefix}$result->{name}.$subtype\[$value\] == $values[$value]$suffix|;
                    }
                    
                    $prefix = " && ";
                }
            }
            
            $prefix = " &&\n          ";
        }
        
        print qq| \)\n|;
        print qq|      \{\n|;
        print qq|         printf("$test ... ok\\n");\n|;
        print qq|      \}\n|;
        print qq|      else\n|;
        print qq|      \{\n|;
        print qq|         printf("$test ... not ok\\n");\n|;
        
        foreach my $result (@results)
        {
            my $type = $result->{type};
            my $subtype = $result->{subtype};
            my $suffix = $SubTypeSuffixes{$subtype};
            my @values = @{$result->{values}};
            
            if ($type eq "eflags")
            {
                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|;
            }
            elsif ($type =~ /^fpu[cs]w$/)
            {
                print qq|         printf("  $type & 0x%x = 0x%x (expected 0x%x)\\n", $values[0], $result->{name}.uw\[0\] & $values[0], $values[1]);\n|;
            }
            else
            {
                foreach my $value (0 .. $#values)
                {
                    print qq|         printf("  $result->{name}.$subtype\[$value\] = $SubTypeFormats{$subtype} (expected $SubTypeFormats{$subtype})\\n", $result->{name}.$subtype\[$value\], $values[$value]$suffix);\n|;
                }
            }
        }
        
        print qq|      \}\n|;
    }
    else
    {
        print qq|      printf("$test ... ok\\n");\n|;
    }

    print qq|   \}\n|;
    print qq|   else\n|;
    print qq|   \{\n|;
    print qq|      printf("$test ... failed\\n");\n|;
    print qq|   \}\n|;
    print qq|\n|;
    print qq|   return;\n|;
    print qq|\}\n|;
    print qq|\n|;
}

print qq|int main(int argc, char **argv)\n|;
print qq|\{\n|;
print qq|   signal(SIGILL, handle_sigill);\n|;
print qq|\n|;

foreach my $test (@tests)
{
    print qq|   $test();\n|;
}

print qq|\n|;
print qq|   exit(0);\n|;
print qq|\}\n|;

exit 0;