nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 1 | #!/usr/bin/perl |
| 2 | |
thughes | f8260d4 | 2004-11-02 09:49:19 +0000 | [diff] [blame] | 3 | use 5.006; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 4 | use strict; |
| 5 | use warnings; |
| 6 | |
| 7 | our %ArgTypes = ( |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 8 | r8 => "reg8_t", |
| 9 | r16 => "reg16_t", |
| 10 | r32 => "reg32_t", |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 11 | mm => "reg64_t", |
| 12 | xmm => "reg128_t", |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 13 | m8 => "reg8_t", |
| 14 | m16 => "reg16_t", |
| 15 | m32 => "reg32_t", |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 16 | m64 => "reg64_t", |
| 17 | m128 => "reg128_t", |
| 18 | eflags => "reg32_t", |
| 19 | st => "reg64_t", |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 20 | fpucw => "reg16_t", |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 21 | fpusw => "reg16_t" |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 22 | ); |
| 23 | |
| 24 | our %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 | |
| 37 | our %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 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 50 | our %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, |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 58 | dh => 7, |
| 59 | st0 => 0, st1 => 1, st2 => 2, st3 => 3, |
| 60 | st4 => 4, st5 => 5, st6 => 6, st7 => 7 |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 61 | ); |
| 62 | |
| 63 | our %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 | |
| 70 | our @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 | ); |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 80 | |
| 81 | print <<EOF; |
| 82 | #include <math.h> |
| 83 | #include <setjmp.h> |
| 84 | #include <signal.h> |
| 85 | #include <stdio.h> |
| 86 | #include <stdlib.h> |
| 87 | |
| 88 | typedef union { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 89 | char sb[1]; |
| 90 | unsigned char ub[1]; |
| 91 | } reg8_t; |
| 92 | |
| 93 | typedef union { |
| 94 | char sb[2]; |
| 95 | unsigned char ub[2]; |
| 96 | short sw[1]; |
| 97 | unsigned short uw[1]; |
| 98 | } reg16_t; |
| 99 | |
| 100 | typedef union { |
| 101 | char sb[4]; |
| 102 | unsigned char ub[4]; |
| 103 | short sw[2]; |
| 104 | unsigned short uw[2]; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 105 | long int sd[1]; |
| 106 | unsigned long int ud[1]; |
| 107 | float ps[1]; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 108 | } reg32_t; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 109 | |
| 110 | typedef 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]; |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 121 | } reg64_t __attribute__ ((aligned (8))); |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 122 | |
| 123 | typedef 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]; |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 134 | } reg128_t __attribute__ ((aligned (16))); |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 135 | |
| 136 | static sigjmp_buf catchpoint; |
| 137 | |
| 138 | static void handle_sigill(int signum) |
| 139 | { |
| 140 | siglongjmp(catchpoint, 1); |
| 141 | } |
| 142 | |
nethercote | 5a98408 | 2004-02-14 16:53:53 +0000 | [diff] [blame] | 143 | __attribute__((unused)) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 144 | static int eq_float(float f1, float f2) |
| 145 | { |
| 146 | return f1 == f2 || fabsf(f1 - f2) < fabsf(f1) * 1.5 * pow(2,-12); |
| 147 | } |
| 148 | |
nethercote | 5a98408 | 2004-02-14 16:53:53 +0000 | [diff] [blame] | 149 | __attribute__((unused)) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 150 | static int eq_double(double d1, double d2) |
| 151 | { |
| 152 | return d1 == d2 || fabs(d1 - d2) < fabs(d1) * 1.5 * pow(2,-12); |
| 153 | } |
| 154 | |
| 155 | EOF |
| 156 | |
| 157 | my %tests; |
| 158 | my @tests; |
| 159 | |
| 160 | while (<>) |
| 161 | { |
| 162 | next if /^#/; |
| 163 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 164 | my $insn; |
| 165 | my $presets; |
| 166 | my $args; |
| 167 | my $results; |
| 168 | |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 169 | if (/^(\S+)\s+(?:(\S+(?:\s+\S+)*)\s+:\s+)?((?:\S+\s+)*?)(?:=>\s+(\S+(?:\s+\S+)*))?$/) |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 170 | { |
| 171 | $insn = $1; |
| 172 | $presets = $2 || ""; |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 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"; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 180 | } |
| 181 | else |
| 182 | { |
| 183 | die "Can't parse test $_"; |
| 184 | } |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 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 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 195 | my @intregs = @IntRegs; |
sewardj | 43cecdf | 2004-12-06 00:37:59 +0000 | [diff] [blame] | 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); |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 199 | |
| 200 | my @presets; |
| 201 | my $presetc = 0; |
| 202 | my $eflagsmask; |
| 203 | my $eflagsset; |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 204 | my $fpucwmask; |
| 205 | my $fpucwset; |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 206 | my $fpuswmask; |
| 207 | my $fpuswset; |
| 208 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 209 | foreach my $preset (split(/\s+/, $presets)) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 210 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 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 | |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 233 | print qq| $ArgTypes{$type} $name = \{ .$subtype = \{|; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 234 | |
| 235 | my $valuec = 0; |
| 236 | |
| 237 | foreach my $value (@values) |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 238 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 239 | print qq|,| if $valuec > 0; |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 240 | print qq| $value$SubTypeSuffixes{$subtype}|; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 241 | $valuec++; |
| 242 | } |
| 243 | |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 244 | print qq| \} \};\n|; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 245 | |
| 246 | $presetc++; |
| 247 | } |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 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 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 285 | elsif ($preset =~ /^(eflags)\[([^\]]+)\]$/) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 286 | { |
| 287 | my $type = $1; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 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 | |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 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]; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 306 | } |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 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 | |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 315 | $fpuswmask = sprintf "0x%04x", $values[0] ^ 0xffff; |
| 316 | $fpuswset = sprintf "0x%04x", $values[1]; |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 317 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 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); |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 336 | my $subtype = $2; |
| 337 | my @values = split(/,/, $3); |
| 338 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 339 | die "Register $1 already used" if defined($regnum) && !defined($register); |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 340 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 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 | |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 355 | print qq| $ArgTypes{$type} $name = \{ .$subtype = \{|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 356 | |
| 357 | my $valuec = 0; |
| 358 | |
| 359 | foreach my $value (@values) |
| 360 | { |
| 361 | print qq|,| if $valuec > 0; |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 362 | print qq| $value$SubTypeSuffixes{$subtype}|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 363 | $valuec++; |
| 364 | } |
| 365 | |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 366 | print qq| \} \};\n|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 367 | } |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 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 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 405 | elsif ($arg =~ /^(imm8|imm16|imm32)\[([^\]]+)\]$/) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 406 | { |
| 407 | my $type = $1; |
| 408 | my $value = $2; |
| 409 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 410 | my $arg = { |
| 411 | type => $type, |
| 412 | value => $value |
| 413 | }; |
| 414 | |
| 415 | push @args, $arg; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 416 | } |
| 417 | else |
| 418 | { |
| 419 | die "Can't parse argument $arg"; |
| 420 | } |
| 421 | |
| 422 | $argc++; |
| 423 | } |
| 424 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 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 | } |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 444 | elsif ($arg->{type} =~ /^st$/) |
| 445 | { |
| 446 | while (!exists($arg->{register}) || !defined($arg->{register})) |
| 447 | { |
| 448 | $arg->{register} = shift @fpregs; |
| 449 | } |
| 450 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 451 | } |
| 452 | |
| 453 | my @results; |
| 454 | my $resultc = 0; |
| 455 | |
| 456 | foreach my $result (split(/\s+/, $results)) |
| 457 | { |
| 458 | my $name = "result$resultc"; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 459 | |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 460 | if ($result =~ /^(\d+)\.(sb|ub|sw|uw|sd|ud|sq|uq|ps|pd)\[([^\]]+)\]$/) |
| 461 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 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|; |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 504 | } |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 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 | } |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 524 | elsif ($result =~ /^eflags\[([^\]]+)\]$/) |
| 525 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 526 | my @values = split(/,/, $1); |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 527 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 528 | $values[0] = oct($values[0]) if $values[0] =~ /^0/; |
| 529 | $values[1] = oct($values[1]) if $values[1] =~ /^0/; |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 530 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 531 | my $result = { |
| 532 | name => $name, |
| 533 | type => "eflags", |
| 534 | subtype => "ud", |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 535 | values => [ map { sprintf "0x%08x", $_ } @values ] |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 536 | }; |
| 537 | |
| 538 | push @results, $result; |
| 539 | |
| 540 | print qq| $ArgTypes{eflags} $name;\n|; |
| 541 | |
| 542 | if (!defined($eflagsmask) && !defined($eflagsset)) |
| 543 | { |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 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]; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 570 | } |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 571 | } |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 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", |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 583 | values => [ map { sprintf "0x%04x", $_ } @values ] |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 584 | }; |
| 585 | |
| 586 | push @results, $result; |
| 587 | |
| 588 | print qq| $ArgTypes{fpusw} $name;\n|; |
| 589 | |
| 590 | if (!defined($fpuswmask) && !defined($fpuswset)) |
| 591 | { |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 592 | $fpuswmask = sprintf "0x%04x", $values[0] ^ 0xffff; |
| 593 | $fpuswset = sprintf "0x%04x", $values[0] & ~$values[1]; |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 594 | } |
| 595 | } |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 596 | else |
| 597 | { |
| 598 | die "Can't parse result $result"; |
| 599 | } |
| 600 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 601 | $resultc++; |
| 602 | } |
| 603 | |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 604 | my $argnum = 0; |
| 605 | |
| 606 | foreach my $result (@results) |
| 607 | { |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 608 | if ($result->{type} =~ /^(m(8|16|32|64|128)|st|eflags|fpu[cs]w)$/) |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 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 | |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 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|; |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 637 | print qq| \"fsave %$stateargnum\\n\"\n|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 638 | |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 639 | my @fpargs; |
| 640 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 641 | foreach my $arg (@presets, @args) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 642 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 643 | if ($arg->{type} eq "r8") |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 644 | { |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 645 | print qq| \"movb %$arg->{argnum}, %%$arg->{register}\\n\"\n|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 646 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 647 | elsif ($arg->{type} eq "r16") |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 648 | { |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 649 | print qq| \"movw %$arg->{argnum}, %%$arg->{register}\\n\"\n|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 650 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 651 | elsif ($arg->{type} eq "r32") |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 652 | { |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 653 | print qq| \"movl %$arg->{argnum}, %%$arg->{register}\\n\"\n|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 654 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 655 | elsif ($arg->{type} eq "mm") |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 656 | { |
| 657 | print qq| \"movq %$arg->{argnum}, %%$arg->{register}\\n\"\n|; |
| 658 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 659 | elsif ($arg->{type} eq "xmm") |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 660 | { |
| 661 | print qq| \"movlps 0%$arg->{argnum}, %%$arg->{register}\\n\"\n|; |
| 662 | print qq| \"movhps 8%$arg->{argnum}, %%$arg->{register}\\n\"\n|; |
| 663 | } |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 664 | elsif ($arg->{type} eq "st") |
| 665 | { |
| 666 | $fpargs[$RegNums{$arg->{register}}] = $arg; |
| 667 | } |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 668 | } |
| 669 | |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 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 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 689 | if (defined($eflagsmask) || defined($eflagsset)) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 690 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 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|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 695 | } |
| 696 | |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 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 | |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 707 | print qq| \"$insn|; |
| 708 | |
| 709 | my $prefix = " "; |
| 710 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 711 | foreach my $arg (@args) |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 712 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 713 | next if $arg->{type} eq "eflags"; |
| 714 | |
| 715 | if ($arg->{type} =~ /^(r8|r16|r32|mm|xmm)$/) |
| 716 | { |
| 717 | print qq|$prefix%%$arg->{register}|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 718 | } |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 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 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 727 | elsif ($arg->{type} =~ /^(m(8|16|32|64|128))$/) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 728 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 729 | if (exists($arg->{result})) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 730 | { |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 731 | print qq|$prefix%$arg->{result}->{argnum}|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 732 | } |
| 733 | else |
| 734 | { |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 735 | print qq|$prefix%$arg->{argnum}|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 736 | } |
| 737 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 738 | elsif ($arg->{type} =~ /^imm(8|16|32)$/) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 739 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 740 | print qq|$prefix\$$arg->{value}|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 741 | } |
| 742 | |
| 743 | $prefix = ", "; |
| 744 | } |
| 745 | |
| 746 | print qq|\\n\"\n|; |
| 747 | |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 748 | my @fpresults; |
| 749 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 750 | foreach my $result (@results) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 751 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 752 | if ($result->{type} eq "r8") |
| 753 | { |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 754 | print qq| \"movb %%$result->{register}, %$result->{argnum}\\n\"\n|; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 755 | } |
| 756 | elsif ($result->{type} eq "r16") |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 757 | { |
| 758 | print qq| \"movw %%$result->{register}, %$result->{argnum}\\n\"\n|; |
| 759 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 760 | elsif ($result->{type} eq "r32") |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 761 | { |
| 762 | print qq| \"movl %%$result->{register}, %$result->{argnum}\\n\"\n|; |
| 763 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 764 | elsif ($result->{type} eq "mm") |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 765 | { |
| 766 | print qq| \"movq %%$result->{register}, %$result->{argnum}\\n\"\n|; |
| 767 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 768 | elsif ($result->{type} eq "xmm") |
| 769 | { |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 770 | print qq| \"movlps %%$result->{register}, 0%$result->{argnum}\\n\"\n|; |
| 771 | print qq| \"movhps %%$result->{register}, 8%$result->{argnum}\\n\"\n|; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 772 | } |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 773 | elsif ($result->{type} eq "st") |
| 774 | { |
| 775 | $fpresults[$RegNums{$result->{register}}] = $result; |
| 776 | } |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 777 | elsif ($result->{type} eq "eflags") |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 778 | { |
| 779 | print qq| \"pushfl\\n\"\n|; |
| 780 | print qq| \"popl %$result->{argnum}\\n\"\n|; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 781 | } |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 782 | elsif ($result->{type} eq "fpucw") |
| 783 | { |
| 784 | print qq| \"fstcw %$result->{argnum}\\n\"\n|; |
| 785 | } |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 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 | } |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 809 | } |
| 810 | |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 811 | print qq| \"frstor %$stateargnum\\n\"\n|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 812 | |
| 813 | print qq| :|; |
| 814 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 815 | $prefix = " "; |
| 816 | |
| 817 | foreach my $result (@results) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 818 | { |
thughes | 975d6e6 | 2004-03-31 22:47:52 +0000 | [diff] [blame] | 819 | if ($result->{type} =~ /^(m(8|16|32|64|128)|st|eflags|fpu[cs]w)$/) |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 820 | { |
| 821 | print qq|$prefix\"=m\" \($result->{name}\)|; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 822 | $prefix = ", "; |
| 823 | } |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 824 | } |
| 825 | |
| 826 | print qq|\n|; |
| 827 | |
| 828 | $prefix = " : "; |
| 829 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 830 | foreach my $arg (@presets, @args) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 831 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 832 | if (defined($arg->{name})) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 833 | { |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 834 | print qq|$prefix\"m\" \($arg->{name}\)|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 835 | $prefix = ", "; |
| 836 | } |
| 837 | } |
| 838 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 839 | foreach my $result (@results) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 840 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 841 | if ($result->{type} =~ /^(r(8|16|32)|mm|xmm)$/) |
| 842 | { |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 843 | print qq|$prefix\"m\" \($result->{name}\)|; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 844 | $prefix = ", "; |
| 845 | } |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 846 | } |
| 847 | |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 848 | print qq|$prefix\"m\" \(state[0]\)\n|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 849 | |
| 850 | $prefix = " : "; |
| 851 | |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 852 | foreach my $arg (@presets, @args) |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 853 | { |
thughes | b76f0dc | 2004-03-27 18:02:37 +0000 | [diff] [blame] | 854 | if ($arg->{register} && $arg->{type} ne "st") |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 855 | { |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 856 | print qq|$prefix\"$arg->{register}\"|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 857 | $prefix = ", "; |
| 858 | } |
| 859 | } |
| 860 | |
| 861 | print qq|\n|; |
| 862 | |
| 863 | print qq| \);\n|; |
| 864 | print qq|\n|; |
| 865 | |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 866 | if (@results) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 867 | { |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 868 | print qq| if \(|; |
| 869 | |
| 870 | $prefix = ""; |
| 871 | |
| 872 | foreach my $result (@results) |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 873 | { |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 874 | my $type = $result->{type}; |
| 875 | my $subtype = $result->{subtype}; |
| 876 | my $suffix = $SubTypeSuffixes{$subtype}; |
| 877 | my @values = @{$result->{values}}; |
| 878 | |
| 879 | if ($type eq "eflags") |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 880 | { |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 881 | print qq|${prefix}\($result->{name}.ud[0] & $values[0]UL\) == $values[1]UL|; |
| 882 | } |
| 883 | elsif ($type =~ /^fpu[cs]w$/) |
| 884 | { |
| 885 | print qq|${prefix}\($result->{name}.uw[0] & $values[0]\) == $values[1]|; |
| 886 | } |
| 887 | else |
| 888 | { |
| 889 | foreach my $value (0 .. $#values) |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 890 | { |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 891 | if ($subtype eq "ps") |
| 892 | { |
| 893 | print qq|${prefix}eq_float($result->{name}.$subtype\[$value\], $values[$value]$suffix)|; |
| 894 | } |
| 895 | elsif ($subtype eq "pd") |
| 896 | { |
| 897 | print qq|${prefix}eq_double($result->{name}.$subtype\[$value\], $values[$value]$suffix)|; |
| 898 | } |
| 899 | else |
| 900 | { |
| 901 | print qq|${prefix}$result->{name}.$subtype\[$value\] == $values[$value]$suffix|; |
| 902 | } |
| 903 | |
| 904 | $prefix = " && "; |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 905 | } |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 906 | } |
| 907 | |
| 908 | $prefix = " &&\n "; |
| 909 | } |
| 910 | |
| 911 | print qq| \)\n|; |
| 912 | print qq| \{\n|; |
| 913 | print qq| printf("$test ... ok\\n");\n|; |
| 914 | print qq| \}\n|; |
| 915 | print qq| else\n|; |
| 916 | print qq| \{\n|; |
| 917 | print qq| printf("$test ... not ok\\n");\n|; |
| 918 | |
| 919 | foreach my $result (@results) |
| 920 | { |
| 921 | my $type = $result->{type}; |
| 922 | my $subtype = $result->{subtype}; |
| 923 | my $suffix = $SubTypeSuffixes{$subtype}; |
| 924 | my @values = @{$result->{values}}; |
| 925 | |
| 926 | if ($type eq "eflags") |
| 927 | { |
| 928 | 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|; |
| 929 | } |
| 930 | elsif ($type =~ /^fpu[cs]w$/) |
| 931 | { |
| 932 | print qq| printf(" $type & 0x%x = 0x%x (expected 0x%x)\\n", $values[0], $result->{name}.uw\[0\] & $values[0], $values[1]);\n|; |
| 933 | } |
| 934 | else |
| 935 | { |
| 936 | foreach my $value (0 .. $#values) |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 937 | { |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 938 | print qq| printf(" $result->{name}.$subtype\[$value\] = $SubTypeFormats{$subtype} (expected $SubTypeFormats{$subtype})\\n", $result->{name}.$subtype\[$value\], $values[$value]$suffix);\n|; |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 939 | } |
mueller | 5b6e3af | 2004-02-23 22:09:54 +0000 | [diff] [blame] | 940 | } |
| 941 | } |
| 942 | |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 943 | print qq| \}\n|; |
nethercote | 1018bdd | 2004-02-11 23:33:29 +0000 | [diff] [blame] | 944 | } |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 945 | else |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 946 | { |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 947 | print qq| printf("$test ... ok\\n");\n|; |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 948 | } |
thughes | 829878e | 2004-07-25 15:18:21 +0000 | [diff] [blame] | 949 | |
nethercote | 288b766 | 2004-01-20 09:24:53 +0000 | [diff] [blame] | 950 | print qq| \}\n|; |
| 951 | print qq| else\n|; |
| 952 | print qq| \{\n|; |
| 953 | print qq| printf("$test ... failed\\n");\n|; |
| 954 | print qq| \}\n|; |
| 955 | print qq|\n|; |
| 956 | print qq| return;\n|; |
| 957 | print qq|\}\n|; |
| 958 | print qq|\n|; |
| 959 | } |
| 960 | |
| 961 | print qq|int main(int argc, char **argv)\n|; |
| 962 | print qq|\{\n|; |
| 963 | print qq| signal(SIGILL, handle_sigill);\n|; |
| 964 | print qq|\n|; |
| 965 | |
| 966 | foreach my $test (@tests) |
| 967 | { |
| 968 | print qq| $test();\n|; |
| 969 | } |
| 970 | |
| 971 | print qq|\n|; |
| 972 | print qq| exit(0);\n|; |
| 973 | print qq|\}\n|; |
| 974 | |
| 975 | exit 0; |