1#!/usr/local/bin/perl 2 3package SWF::Builder::ActionScript::Compiler; 4 5use strict; 6 7use Carp; 8use SWF::Element; 9use SWF::Builder::ExElement; 10 11@SWF::Builder::ActionScript::Compiler::ISA = ('SWF::Builder::ActionScript::Compiler::Error'); 12 13our $VERSION = '0.01'; 14$VERSION = eval $VERSION; # see L<perlmodstyle> 15 16my $nl = "\x0a\x0d\x{2028}\x{2029}"; 17my $BE = (CORE::pack('s',1) eq CORE::pack('n',1)); 18my $INF = "\x00\x00\x00\x00\x00\x00\xf0\x7f"; 19my $NINF = "\x00\x00\x00\x00\x00\x00\xf0\xff"; 20if ($BE) { 21 $INF = reverse $INF; 22 $NINF = reverse $NINF; 23} 24my $MANTISSA = ~$NINF; 25my $INFINITY = unpack('d', $INF); 26 27our %O; 28 29BEGIN { 30 %O = 31 ( O_ALL => ~0, 32 O_PEEPHOLE => 1<<0, # peephole optimization 33 O_CONSTEXP => 1<<1, # calculate constant expressions 34 O_CONSTMATH => 1<<2, # calculate math funcs with constant args and constant properties 35 O_LEFTONCE => 1<<3, # evaluate the lefthand side of assignment expression only once 36 O_REGISTER => 1<<4, # assign local variables to registers. 37 O_LOCALREG => 1<<5, # assign local variables to local registers using ActionDefineFunction2. Need O_REGISTER. Flash player 6.0.65 and above only. 38 O_6R65 => 1<<5, 39 40 ); 41} 42 43use constant \%O; 44 45our %GLOBAL_OPTIONS; 46 47sub new { 48 my $class = shift; 49 my $text = shift; 50 my %option = (%GLOBAL_OPTIONS, @_); 51 52 my $new = bless { 53 text => $text, 54 line => 1, 55 ungets => [], 56 scope => [], 57 regvars => [], 58 stat => { 59 code => [], 60 label => 'A', 61 loop => [], 62 with => 0, 63 Trace => 'eval', 64 Warning => 1, 65 Optimize => O_ALL & ~O_REGISTER & ~O_LOCALREG, 66 Version => 6, 67 }, 68 }, $class; 69 my $stat = $new->{stat}; 70 71 for my $o (qw/Warning Version Trace/) { 72 $stat->{$o} = $option{$o} if defined $option{$o}; 73 } 74 if (defined(my $opt = $option{Optimize})) { 75 if ($opt =~ /^\d+$/) { 76 $stat->{Optimize} = $opt; 77 } else { 78 my $o = $stat->{Optimize}; 79 my @o = split /[\s|]+/, $opt; 80 81 for (@o) { 82 if (/^-/) { 83 s/^-//; 84 carp "Unknown optimize option '$_'" unless exists $O{$_}; 85 $o &= ~$O{$_}; 86 } else { 87 carp "Unknown optimize option '$_'" unless exists $O{$_}; 88 $o |= $O{$_}; 89 } 90 } 91 $stat->{Optimize} = $o; 92 } 93 } 94 if ($stat->{Optimize} & O_LOCALREG) { 95 $stat->{Optimize} |= O_REGISTER; 96 if ($new->{stat}{Version} < 6) { 97 $new->_error('O_LOCALREG can use SWF version 6 or later.'); 98 } 99 } 100 101 return $new; 102} 103 104sub compile { 105 my ($self, $actions) = @_; 106 my $tree = $self->source_elements; 107 my $option = $actions||''; 108 109 $tree->_tree_dump, return if $option eq 'tree'; 110 $tree->compile; 111 $self->_tidy_up; 112 $self->_code_print, return if $option eq 'text'; 113 $actions = SWF::Element::Array::ACTIONRECORDARRAY->new unless ref($actions); 114 $self->_encode($actions); 115 $actions->dumper, return if $option eq 'dump'; 116 $actions; 117} 118 119sub assemble { 120 my ($self, $actions) = @_; 121 my $option = $actions||''; 122 123 push @{$self->{stat}{code}}, grep /[^#]/, split /[$nl]/, $self->{text}; 124 $self->_tidy_up; 125 $self->_code_print, return if $option eq 'text'; 126 $actions = SWF::Element::Array::ACTIONRECORDARRAY->new unless ref($actions); 127 $self->_encode($actions); 128 $actions->dumper, return if $option eq 'dump'; 129 $actions; 130} 131 132### parser 133 134 135my %reserved = ( 136 null => ['', 'NULLLiteral'], 137 undefined => ['', 'UNDEFLiteral'], 138 true => [1, 'BooleanLiteral'], 139 false => [0, 'BooleanLiteral'], 140 newline => ["\n", 'StringLiteral'], 141 142 add => 'AddOp', 143 and => 'AndOp', 144 break => 'Statement', 145 case => 'Label', 146 continue => 'Statement', 147 default => 'Label', 148 delete => 'DeleteOp', 149 do => 'Statement', 150 else => 'Else', 151 eq => 'EqOp', 152 for => 'Statement', 153 function => 'Function', 154 ge => 'Relop', 155 gt => 'Relop', 156 if => 'Statement', 157 ifFrameLoaded 158 => 'Statement', 159 in => 'In', 160 instanceof => 'RelOp', 161 le => 'Relop', 162 lt => 'Relop', 163 ne => 'Eqop', 164 new => 'New', 165 not => 'UnaryOp', 166 or => 'OrOp', 167 return => 'Statement', 168 switch => 'Statement', 169 tellTarget => 'Statement', 170 typeof => 'UnaryOp', 171 var => 'Statement', 172 void => 'UnaryOp', 173 while => 'Statement', 174 with => 'Statement', 175 176 abstract => 'Reserved', 177# boolean => 'Reserved', 178 byte => 'Reserved', 179 catch => 'Reserved', 180 char => 'Reserved', 181 class => 'Reserved', 182 const => 'Reserved', 183 debugger => 'Reserved', 184 double => 'Reserved', 185 enum => 'Reserved', 186 export => 'Reserved', 187 extends => 'Reserved', 188 finally => 'Reserved', 189 final => 'Reserved', 190 float => 'Reserved', 191 goto => 'Reserved', 192 implements => 'Reserved', 193 import => 'Reserved', 194# int => 'Reserved', 195 interface => 'Reserved', 196 long => 'Reserved', 197 native => 'Reserved', 198 package => 'Reserved', 199 private => 'Reserved', 200 protected => 'Reserved', 201 public => 'Reserved', 202 short => 'Reserved', 203 static => 'Reserved', 204 synchronized 205 => 'Reserved', 206 throws => 'Reserved', 207 throw => 'Reserved', 208 transient => 'Reserved', 209 try => 'Reserved', 210 volatile => 'Reserved', 211 ); 212 213my %property; 214@property{ qw / _x _y _xscale _yscale 215 _currentframe _totalframes _alpha _visible 216 _width _height _rotation _target 217 _framesloaded _name _droptarget _url 218 _highquality _focusrect _soundbuftime _quality 219 _xmouse _ymouse / 220 } = (0..21); 221 222my %ops = ('=' => 'AssignmentOp', 223 '+' => 'AddOp', 224 '-' => 'AddOp', 225 '<' => 'RelOp', 226 '>' => 'RelOp', 227 '*' => 'MultOp', 228 '/' => 'MultOp', 229 '%' => 'MultOp', 230 '&' => 'BitAndOp', 231 '^' => 'BitXorOp', 232 '|' => 'BitOrOp', 233 '~' => 'UnaryOp', 234 '!' => 'UnaryOp', 235 '?' => 'ConditionalOp', 236 ':' => ':', 237 ); 238 239=begin comment 240 241$self->_get_token(@token); 242 243get the next token. return ($token_text, $token_type, $line_terminator_count). 244$num_line_terminator is a number of skipped line terminator or newline. 245it is used for automatic semicolon insertion. 246 247=cut 248 249sub _get_token { 250 my $self = shift; 251 my $ln = 0; 252 my @token; 253 254 if (@{$self->{ungets}}) { 255 @token = @{pop @{$self->{ungets}}}; 256 $self->{line}+=$token[2]; 257 return @token; 258 } 259 260 for ($self->{text}) { 261 s/\A(?:[\x09\x0b\x0c\x20\xa0\p{IsZs}]|\/\/.+?(?=[$nl])|\/\*[^$nl]*?\*\/)+//o 262 and redo; 263 s/\A((?:\/\*.*?[$nl].*?\*\/|[$nl])(?:\/\*.*?\*\/|\/\/.*?[$nl]|\s)*)//os 264 and do { 265 my $ln1 = scalar($1=~tr/\x0a\x0d\x{2028}\x{2029}/\x0a\x0d\x{2028}\x{2029}/); 266 $self->{line} += $ln1; 267 $ln += $ln1; 268 redo; 269 }; 270 s/\A([_\$\p{IsLl}\p{IsLu}\p{IsLt}\p{IsLm}\p{IsLo}\p{IsNl}][\$\w]*)// 271 and do { 272 my $key = $1; 273 return ((ref($reserved{$key})? @{$reserved{$key}} : ($key, $reserved{$key}||(exists $property{lc($key)} ? 'Property' : 'Identifier'))), $ln); 274 }; 275 s/\A\"((?>(?:[^\"\\]|\\.)*))\"//s 276 and do { 277 my $s = $1; 278 $self->{line}+=scalar($s=~tr/\x0a\x0d\x{2028}\x{2029}/\x0a\x0d\x{2028}\x{2029}/); 279 $s=~s/(\\*)\'/$1.(length($1)%2==1?"'":"\\'")/ge; 280 return ($s, 'StringLiteral', $ln); 281 }; 282 s/\A\'((?>(?:[^\'\\]|\\.)*))\'//s 283 and do { 284 my $s = $1; 285 $self->{line}+=scalar($s=~tr/\x0a\x0d\x{2028}\x{2029}/\x0a\x0d\x{2028}\x{2029}/); 286 return ($s, 'StringLiteral', $ln); 287 }; 288 289 m/\A0/ and 290 ( s/\A(0[0-7]+)//i or 291 s/\A(0x[0-9a-f]+)//i or 292 s/\A(0b[01]+)//i ) and return (oct($1), 'NumberLiteral', $ln); 293 s/\A((?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)// 294 and return ($1, 'NumberLiteral', $ln); 295 296 s/\A\;// and return (';', 'StatementTerminator', $ln); 297 s/\A([.,(){}\[\]])// and return ($1, $1, $ln); 298 s/\A\&&// and return ('&&', 'AndOp', $ln); 299 s/\A\|\|// and return ('||', 'OrOp', $ln); 300 s/\A\+\+// and return ('++', 'PrefixOp', $ln); 301 s/\A\-\-// and return ('--', 'PrefixOp', $ln); 302 s/\A([*\/%+\-&^|]=)// and return ($1, 'AssignmentOp', $ln); 303 s/\A\<<=// and return ('<<=', 'AssignmentOp', $ln); 304 s/\A\>>>=// and return ('>>>=', 'AssignmentOp', $ln); 305 s/\A\>>=// and return ('>>=', 'AssignmentOp', $ln); 306 s/\A\<<// and return ('<<', 'ShiftOp', $ln); 307 s/\A\>>>// and return ('>>>', 'ShiftOp', $ln); 308 s/\A\>>// and return ('>>', 'ShiftOp', $ln); 309 s/\A\<=// and return ('<=', 'RelOp', $ln); 310 s/\A\>=// and return ('>=', 'RelOp', $ln); 311 s/\A([!=]==?)// and return ($1, 'EqOp', $ln); 312 s/\A([=+\-<>*\/%&^|~!?:])// 313 and return ($1, $ops{$1}, $ln); 314 315 s/\A\#([^$nl]+)[$nl]//os 316 and do { 317 $self->{line}++; 318 return ($1, 'Pragma', $ln); 319 }; 320 } 321 322 return ('', '', $ln); 323 324} 325 326sub identifier { 327 my $self = shift; 328 my @token = $self->_get_token; 329 my $t = $token[1]; 330 331 unless ($t eq 'Identifier' or $t eq 'Property' or $t eq 'Reserved') { 332 $self->_unget_token(@token); 333 return; 334 } 335 if ($t eq 'Reserved') { 336 $self->_warn(2, '"%s" should not use as an identifier because it is reserved future', $token[0]); 337 } 338 return $token[0]; 339} 340 341=begin comment 342 343$self->_unget_token(@token); 344 345unget the token. 346 347=cut 348 349sub _unget_token { 350 my ($self, @token) = @_; 351 352 push @{$self->{ungets}}, [@token]; 353 $self->{line}-=$token[2]; 354} 355 356=begin comment 357 358$self->_check_token($tokens); 359 360take $tokens for the token type(s) to check. text for one token, 361and arrayref for two or more tokens. 362if $tokens matched the next token, read(skip) and return the token. 363if not match, unget the token and return undef. 364 365=cut 366 367sub _check_token { 368 my ($self, $tokens) = @_; 369 370 $tokens = [$tokens] unless ref($tokens); 371 my @token = $self->_get_token; 372 if (@token) { 373 for my $c (@$tokens) { 374 return @token if $c eq $token[1]; 375 } 376 $self->_unget_token(@token); 377 } 378 return; 379} 380 381sub _check_token_fatal { 382 my @token = &_check_token; 383 $_[0]->_error($_[2]||'Syntax error') unless $token[1]; 384 return @token; 385} 386 387=begin comment 388 389$keep = $self->_keep_context; 390 391keep the compiler context to $keep. 392 393=cut 394 395use Storable 'dclone'; 396 397sub _keep_context { 398 my $self = shift; 399 return { 400 text => $self->{text}, 401 line => $self->{line}, 402 scope => $self->{scope}[-1] ? dclone($self->{scope}) : [], 403 ungets => [@{$self->{ungets}}], 404 }; 405} 406 407=begin comment 408 409$self->_restore_context($keep); 410 411restore the kept context. 412 413=cut 414 415sub _restore_context { 416 my ($self, $keep) = @_; 417 $self->{text} = $keep->{text}; 418 $self->{line} = $keep->{line}; 419 $self->{scope} = $keep->{scope}; 420 $self->{ungets} = $keep->{ungets}; 421} 422 423sub new_node { 424 my ($self, $node) = @_; 425 426 bless { line => $self->{line}, stat => $self->{stat}, node => [], regvars => $self->{regvars}[-1]}, "SWF::Builder::ActionScript::SyntaxNode::$node"; 427} 428 429sub new_scope { 430 my $self = shift; 431 return unless $self->{stat}{Optimize} & O_REGISTER; 432 433 my $scope = { 434 vars => { 435 this => { count => 0, start => 0, end => 0, preload => 1 }, 436 arguments => { count => 0, start => 0, end => 0, preload => 1 }, 437 super => { count => 0, start => 0, end => 0, preload => 1 }, 438 _root => { count => 0, start => 0, end => 0, preload => 1 }, 439 _parent => { count => 0, start => 0, end => 0, preload => 1 }, 440 _global => { count => 0, start => 0, end => 0, preload => 1 }, 441 }, 442 count => 0, # node count 443 preload => [], # variables to need to preload 444 }; 445 push @{$self->{scope}}, $scope; 446 push @{$self->{regvars}}, {}; 447} 448 449sub exit_scope { # assign local variables to registers. 450 my $self = shift; 451 return unless $self->{stat}{Optimize} & O_REGISTER; 452 my $scope = pop @{$self->{scope}}; 453 my $regvars = pop @{$self->{regvars}}; 454 my $reg_count = ($self->{stat}{Optimize} & O_LOCALREG) ? 255 : 3; 455 my $node_count = $scope->{count}; 456 my $vars = $scope->{vars}; 457 458 my @vars; 459 my $null = pack("b$node_count", '0' x $node_count); 460 my @regmap = ($null) x $reg_count; 461 my $regno = 0; 462 463 if ($self->{stat}{Optimize} & O_LOCALREG) { 464 for my $prevar (qw/ this arguments super _root _parent _global /) { 465 next if $vars->{$prevar}{count} <= 0; 466 my $v_start = $vars->{$prevar}{start}; 467 my $v_end = $vars->{$prevar}{end}; 468 $regmap[$regno] |= pack("b$node_count", '0' x $v_start . '1' x ($v_end - $v_start + 1)); 469 $regvars->{$prevar} = ++$regno; 470 } 471 @vars = sort{$vars->{$b}{count}<=>$vars->{$a}{count}} grep {$vars->{$_}{count} > 0 and !exists($regvars->{$_})} keys %$vars; 472 } else { 473 @vars = sort{$vars->{$b}{count}<=>$vars->{$a}{count}} grep {$vars->{$_}{count} > $vars->{$_}{preload}} keys %$vars; 474 } 475 476 for my $v (@vars) { 477 my $v_start = $vars->{$v}{start}; 478 my $v_end = $vars->{$v}{end}; 479 my $v_bits = pack("b$node_count", '0' x $v_start . '1' x ($v_end - $v_start + 1)); 480 for (my $i = 0; $i < $reg_count; $i++) { 481 next if (($regmap[$i] & $v_bits) ne $null) ; 482 $regmap[$i] |= $v_bits; 483 $regvars->{$v} = $i+1; 484 last; 485 } 486 } 487 488 my $i = 0; 489 while ( $i < $reg_count ) { 490 last if ($regmap[$i++] eq $null) ; 491 } 492 $regvars->{' regcount'} = $i; 493} 494 495sub countup_node { 496 my $self = shift; 497 return unless $self->{stat}{Optimize} & O_REGISTER; 498 $self->{scope}[-1]{count}++; 499} 500 501sub add_var { 502 my ($self, $var, $initcount, $preload) = @_; 503 return unless $self->{stat}{Optimize} & O_REGISTER; 504 my $scope = $self->{scope}[-1]; 505 return unless defined $scope; # top level (not in function). 506 my $vars = $scope->{vars}; 507 $self->_error("Variable '%s' is already declared", $var) if exists $vars->{$var}; 508 $vars->{$var} = {count => $initcount, start => $scope->{count}, end => $scope->{count}, preload => $preload}; 509} 510 511sub use_var { 512 my ($self, $var) = @_; 513 return unless $self->{stat}{Optimize} & O_REGISTER; 514 my $scope = $self->{scope}[-1]; 515 return unless defined $scope; # top level (not in function). 516 517 my $vars = $scope->{vars}; 518 if (exists $vars->{$var}) { # if $var is declared in the current scope... 519 520# negative count means the var should not be assigned to register 521# (using in the inner scope). 522 523 return if ($vars->{$var}{count} < 0); 524 525# count up $var. 526# $_x are treated as register variables. weighted. 527 528 $vars->{$var}{end} = $scope->{count}; 529 if ($vars->{$var}{count} == 0 and !(($self->{stat}{Optimize} & O_LOCALREG) and $vars->{$var}{preload}) ) { 530 $vars->{$var}{start} = $scope->{count}; 531 push @{$scope->{preload}}, $var; 532 } 533 if ($var =~ /^\$_/) { 534 $vars->{$var}{count} += 100; 535 } else { 536 $vars->{$var}{count}++; 537 } 538 } else { # search outer scope. 539 my $i = -1; 540 while (defined($scope = $self->{scope}[--$i])) { 541 my $vars = $scope->{vars}; 542 if (exists $vars->{$var} and $vars->{$var}{count} >= 0) { 543 544# If the var is declared in the outer scope, 545# it should not be assigned to register. negate. 546 547 $vars->{$var}{count} = -$vars->{$var}{count}-1; 548 last; 549 } 550 } 551 } 552} 553 554sub source_elements { 555 my $self = shift; 556 my ($c, $cf); 557 my $node = $self->new_node('SourceElements'); 558 559 while($c = ($self->function_declaration || $self->statement)) { 560 if (ref($c)=~/:Function$/) { 561 $node->unshift_node($c); 562 } else { 563 $node->add_node($c); 564 } 565 $cf = 1; 566 } 567 return ((defined $cf) ? $node : undef); 568} 569 570sub function_declaration { 571 my $self = shift; 572 573 $self->_check_token('Function') or return; 574 575 my $name = $self->identifier; 576 $self->_error('Function name is necessary to declare function') unless $name; 577 578 $self->function_expression($name); 579} 580 581 582sub statement { 583 my $self = shift; 584 my @token = $self->_get_token; 585 return unless $token[1]; 586 for($token[1]) { 587 /^\{$/ and do { 588 my $statements = $self->new_node('StatementBlock'); 589 $statements->add_node($self->statement) until $self->_check_token('}'); 590 return $statements; 591 }; 592 /^StatementTerminator$/ and return $self->new_node('NullStatement'); 593 /^Statement$/ and do { 594 for ($token[0]) { 595 /^var$/ and do { 596 my $r = $self->variable_declaration_list; 597 $self->_statement_terminator; 598 return $r; 599 }; 600 /^if$/ and return $self->if_statement; 601 /^for$/ and return $self->for_statement; 602 /^do$/ and return $self->do_while_statement; 603 /^while$/ and return $self->while_statement; 604 /^with$/ and return $self->with_statement; 605 /^switch$/ and return $self->switch_statement; 606 607 /^ifFrameLoaded$/ and return $self->ifframeloaded_statement; 608 /^tellTarget$/ and return $self->telltarget_statement; 609 610# simple actions. 611 /^continue$/ and do { 612 $self->_statement_terminator; 613 return $self->new_node('ContinueStatement'); 614 615 }; 616 /^break$/ and do { 617 $self->_statement_terminator; 618 return $self->new_node('BreakStatement'); 619 }; 620 /^return$/ and do { 621 my $n = $self->new_node('ReturnStatement'); 622 eval{$self->_statement_terminator}; 623 if ($@) { 624 die if $@!~/^Syntax/; 625 my $e = $self->expression or $self->_error('Syntax error.'); 626 $n->add_node($e); 627 $self->_statement_terminator; 628 } 629 return $n; 630 }; 631 632 $self->_error('Syntax error'); 633 } 634 }; 635 /^Pragma$/ and do { 636 $self->_warn(2, 'Pragma is not supported'); 637 }; 638 } 639 $self->_unget_token(@token); 640 $self->expression_statement; 641} 642 643sub variable_declaration_list { 644 my $self = shift; 645 my $node = $self->new_node('VariableDeclarationList'); 646 do { 647 my $v = $self->variable_declaration; 648 $node->add_node($v); 649 } while ($self->_check_token(',')); 650 return $node; 651} 652 653sub variable_declaration { 654 my $self = shift; 655 my $i = $self->identifier or $self->_error("Error token '%s', identifier expected.", ($self->_get_token)[0]); 656 my $n = $self->new_node('VariableDeclaration'); 657 if (my @op = $self->_check_token('AssignmentOp')) { 658 $self->_error("Syntax error") if $op[0] ne '='; 659 $self->add_var($i, 1); 660 my $e = $self->assignment_expression or $self->_error("Syntax error"); 661 $n->add_node($i, $e); 662 return bless $n, 'SWF::Builder::ActionScript::SyntaxNode::VariableDeclarationWithParam'; 663 } else { 664 $self->add_var($i, 0); 665 $n->add_node($i); 666 return $n; 667 } 668} 669 670sub telltarget_statement { 671 my $self = shift; 672 673 $self->_warn_not_recommend("'tellTarget' action", "'with'"); 674 $self->_check_token_fatal('('); 675 my $e = $self->expression or $self->_error("Target movieclip is needed in 'tellTarget'."); 676 my $n = $self->new_node('TellTargetStatement'); 677 $n->add_node($e); 678 $self->_check_token_fatal(')'); 679 $n->add_node($self->statement); 680 return $n; 681} 682 683sub ifframeloaded_statement { 684 my $self = shift; 685 686 $self->_warn_not_recommend("'ifFrameLoaded' action", " property"); 687 $self->_check_token_fatal('('); 688 my $e = $self->expression or $self->_error("Frame number is needed in 'ifFrameLoaded'."); 689 my $n = $self->new_node('IfFrameLoadedStatement'); 690 $n->add_node($e); 691 $self->_check_token_fatal(')'); 692 $n->add_node($self->statement); 693 return $n; 694} 695 696sub switch_statement { 697 my $self = shift; 698 my $default; 699 $self->_check_token_fatal('('); 700 my $e = $self->expression or $self->_error("Object expression is needed in 'switch'."); 701 $self->_check_token_fatal(')'); 702 $self->_check_token_fatal('{'); 703 my $n = $self->new_node('SwitchStatement'); 704 $n->add_node($e); 705 706 while (my @token = $self->_check_token('Label')) { 707 if ($token[0] eq 'case') { 708 my $e = $self->expression or $self->_error('Missing case expression.'); 709 $self->_check_token_fatal(':'); 710 my $case = $self->new_node('CaseClause'); 711 $case->add_node($e); 712 my $statements = $self->new_node('StatementBlock'); 713 my @token; 714 until (@token = $self->_check_token(['Label', '}'])) { 715 $statements->add_node($self->statement); 716 } 717 $self->_unget_token(@token); 718 $case->add_node($statements); 719 $n->add_node($case); 720 } else { 721 $self->_check_token_fatal(':'); 722 $default = $self->new_node('StatementBlock'); 723 my @token; 724 until (@token = $self->_check_token(['Label', '}'])) { 725 $default->add_node($self->statement); 726 } 727 $self->_unget_token(@token); 728 last; 729 } 730 } 731 $self->_check_token_fatal('}'); 732 $n->add_node($default); 733 return $n; 734} 735 736sub with_statement { 737 my $self = shift; 738 $self->_check_token_fatal('('); 739 my $e = $self->expression or $self->_error("Object expression is needed in 'with'."); 740 $self->_check_token_fatal(')'); 741 my $n = $self->new_node('WithStatement'); 742 $n->add_node($e); 743 $self->{stat}{with}++; 744 $n->add_node($self->statement); 745 $self->{stat}{with}--; 746 return $n; 747} 748 749sub while_statement { 750 my $self = shift; 751 $self->_check_token_fatal('('); 752 my $e = undef; 753 unless ($self->_check_token(')')) { 754 $e = $self->expression or $self->_error('Syntax error'); 755 $self->_check_token_fatal(')'); 756 } 757 my $s = $self->statement; 758 if ($self->{stat}{Optimize} & O_CONSTEXP and $e and $e->isa('SWF::Builder::ActionScript::SyntaxNode::Literal')) { 759 if ($e->istrue) { 760 $e = undef; 761 } else { 762 return $self->new_node('NullStatement'); 763 } 764 } 765 my $n = $self->new_node('WhileStatement'); 766 $n->add_node($e, $s); 767 return $n; 768} 769 770sub do_while_statement { 771 my $self = shift; 772 773 my $s = $self->statement; 774 my @token = $self->_check_token_fatal('Statement'); 775 $self->_error("'do' without 'while'.") if $token[0] ne 'while'; 776 $self->_check_token_fatal('('); 777 my $e = undef; 778 unless ($self->_check_token(')')) { 779 $e = $self->expression or $self->_error('Syntax error'); 780 $self->_check_token_fatal(')'); 781 } 782 if ($self->{stat}{Optimize} & O_CONSTEXP and $e and $e->isa('SWF::Builder::ActionScript::SyntaxNode::Literal')) { 783 if ($e->istrue) { 784 $e = undef; 785 } else { 786 return $s; 787 } 788 } 789 my $n = $self->new_node('DoWhileStatement'); 790 $n->add_node($s, $e); 791 792 return $n; 793} 794 795sub if_statement { 796 my $self = shift; 797 my $line = $self->{line}; 798 799 $self->_check_token_fatal('('); 800 my $e = undef; 801 unless ($self->_check_token(')')) { 802 $e = $self->expression or $self->_error('Syntax error'); 803 $self->_check_token_fatal(')'); 804 } 805 my $then = $self->statement; 806 my $else; 807 if ($self->_check_token('Else')) { 808 $else = $self->statement; 809 } 810 if ($self->{stat}{Optimize} & O_CONSTEXP and $e and $e->isa('SWF::Builder::ActionScript::SyntaxNode::Literal')) { 811 if ($e->istrue) { 812 return $then; 813 } else { 814 return ($else || $self->new_node('NullStatement')); 815 } 816 } else { 817 my $n = $self->new_node('IfStatement'); 818 $n->add_node($e, $then); 819 $n->add_node($else) if $else; 820 return $n; 821 } 822} 823 824sub for_statement { 825 my $self = shift; 826 827 $self->_check_token_fatal('('); 828 my $keep = $self->_keep_context; 829 { 830 my $n = $self->new_node('ForStatement'); 831 if (my @token = $self->_check_token('Statement')) { 832 $self->_error('Syntax error.') if $token[0] ne 'var'; 833 $n->add_node($self->variable_declaration_list); 834 $self->_check_token('StatementTerminator') or last; 835 } else { 836 unless ($self->_check_token('StatementTerminator')) { 837 $n->add_node($self->expression); 838 $self->_check_token('StatementTerminator') or last; 839 } else { 840 $n->add_node(undef); 841 } 842 } 843 unless ($self->_check_token('StatementTerminator')) { 844 $n->add_node($self->expression); 845 $self->_check_token_fatal('StatementTerminator'); 846 } else { 847 $n->add_node(undef); 848 } 849 unless ($self->_check_token(')')) { 850 $n->add_node($self->expression); 851 $self->_check_token_fatal(')'); 852 } else { 853 $n->add_node(undef); 854 } 855 $n->add_node($self->statement); 856 return $n; 857 } 858 { 859 $self->_restore_context($keep); 860 861 my $n = $self->new_node('ForEachStatement'); 862 if (my @token = $self->_check_token('Statement')) { 863 $self->_error('Syntax error.') if $token[0] ne 'var'; 864 $n->add_node($self->variable_declaration); 865 } else { 866 my $l = ($self->call_or_member_expression); 867 for (defined($l) and ref($l->{node}[-1])||ref($l)) { 868 $self->_error("Left hand side of 'in' must be a variable or a property.") unless /:Variable$/ or /:Property$/ or /:Member$/ or ($self->{stat}{Version}<=5 and /:Arguments$/ and $l->{node}[0]{node}[0] eq 'eval'); 869 } 870 $n->add_node($l); 871 } 872 $self->_check_token_fatal('In'); 873 my $e = $self->expression or $self->_error('Syntax error.'); 874 $n->add_node($e); 875 $self->_check_token_fatal(')'); 876 $n->add_node($self->statement); 877 return $n; 878 } 879} 880 881sub assignment_expression { 882 my $self = shift; 883 884 if (my $l = $self->conditional_expression) { 885 my @op = $self->_get_token; 886 if ($op[1] eq 'AssignmentOp') { 887 $self->_error("$_ Left hand side of '%s' must be a variable or a property.", $op[0]) unless $l->_lhs; 888 my $v = $self->assignment_expression or $self->_error("Operator '%s' needs an operand.", $op[0]); 889 my $n = $self->new_node('AssignmentExpression'); 890 $n->add_node($l, $op[0], $v); 891 return $n; 892 } else { 893 $self->_unget_token(@op); 894 return $l; 895 } 896 } 897 return; 898} 899 900sub conditional_expression { 901 my $self = shift; 902 903 my $e = $self->binary_op_expression or return; 904 $self->_check_token('ConditionalOp') or return $e; 905 ( my $a1 = $self->assignment_expression and 906 $self->_check_token(':') and 907 my $a2 = $self->assignment_expression ) 908 or $self->_error('Syntax error'); 909 if ($self->{stat}{Optimize} & O_CONSTEXP and $e->isa('SWF::Builder::ActionScript::SyntaxNode::Literal')) { 910 return $e->istrue ? $a1 : $a2; 911 } 912 my $n = $self->new_node('ConditionalExpression'); 913 $n->add_node($e, $a1, $a2); 914 return $n; 915} 916 917{ 918 my @bin_op = (qw/ OrOp AndOp BitOrOp BitXorOp BitAndOp EqOp RelOp ShiftOp AddOp MultOp /); 919 my %literal_op_sub = 920 ( '*' => ['_binop_numbers', sub{$_[0] * $_[1]}], 921 '/' => ['_binop_numbers', 922 sub{ 923 my ($dividend, $divisor) = @_; 924 if ($divisor == 0) { 925 return $INFINITY * ($dividend <=> 0); 926 } else { 927 return $dividend / $divisor; 928 } 929 } 930 ], 931 '%' => ['_binop_numbers', sub{$_[0] % $_[1]}], 932 '+' => ['_binop_Add2'], 933 '-' => ['_binop_numbers', sub{$_[0] - $_[1]}], 934 '<<' => ['_binop_numbers', sub{(abs($_[0])<<$_[1])*($_[0]<=>0)}], 935 '>>>' => ['_binop_numbers', sub{$_[0] >> $_[1]}], 936 '>>' => ['_binop_numbers', sub{(abs($_[0])>>$_[1])*($_[0]<=>0)}], 937 '<=' => ['_binop_rel', sub {$_[0] <= $_[1]}, sub {$_[0] le $_[1]}], 938 '>=' => ['_binop_rel', sub {$_[0] >= $_[1]}, sub {$_[0] ge $_[1]}], 939 '<' => ['_binop_rel', sub {$_[0] < $_[1]}, sub {$_[0] lt $_[1]}], 940 '>' => ['_binop_rel', sub {$_[0] > $_[1]}, sub {$_[0] gt $_[1]}], 941 '===' => ['_binop_StrictEquals'], 942 '!==' => ['_binop_StrictEqualsNot'], 943 '==' => ['_binop_Equals2'], 944 '!=' => ['_binop_Equals2Not'], 945 '&' => ['_binop_numbers', sub{$_[0] & $_[1]}], 946 '^' => ['_binop_numbers', sub{$_[0] ^ $_[1]}], 947 '|' => ['_binop_numbers', sub{$_[0] | $_[1]}], 948 '&&' => ['_binop_LogicalAnd'], 949 '||' => ['_binop_LogicalOr'], 950 951 'add' => ['_binop_strings', sub{$_[0].$_[1]}], 952 'eq' => ['_binop_strings', sub{$_[0] eq $_[1]}], 953 'ne' => ['_binop_strings', sub{$_[0] ne $_[1]}], 954 'ge' => ['_binop_strings', sub{$_[0] ge $_[1]}], 955 'gt' => ['_binop_strings', sub{$_[0] gt $_[1]}], 956 'le' => ['_binop_strings', sub{$_[0] le $_[1]}], 957 'lt' => ['_binop_strings', sub{$_[0] lt $_[1]}], 958 'and' => ['_binop_booleans', sub{$_[0] && $_[1]}], 959 'or' => ['_binop_booleans', sub{$_[0] || $_[1]}], 960 ); 961 962 sub binary_op_expression { 963 my ($self, $step) = @_; 964 $step ||= 0; 965 { 966 my (@op, $f); 967 my $next = ($step >= 9) ? 'unary_expression' : 'binary_op_expression'; 968 my $e1 = $self->$next($step+1) or return; 969 my $n = $self->new_node('BinaryOpExpression'); 970 $n->add_node($e1); 971 while((@op = $self->_get_token)[1] eq $bin_op[$step]) { 972 my $e = $self->$next($step+1) or last; 973 if (!$f and $self->{stat}{Optimize} & O_CONSTEXP and 974 $e1->isa('SWF::Builder::ActionScript::SyntaxNode::Literal') and 975 ( 976 $e ->isa('SWF::Builder::ActionScript::SyntaxNode::Literal') or 977 $op[0] eq '&&' or 978 $op[0] eq '||')) { 979 my ($op, @op_param) = @{$literal_op_sub{$op[0]}}; 980 $e1 = $e1->$op($e, @op_param); 981 next; 982 } else { 983 $f = 1; 984 } 985 $n->add_node($e, $op[0]); 986 $e1=$e; 987 } 988 $self->_unget_token(@op); 989 unless ($f) { 990 return $e1; 991 } elsif ($step <= 1) { 992 return bless $n, 'SWF::Builder::ActionScript::SyntaxNode::'.$bin_op[$step].'Expression'; 993 } else { 994 return $n; 995 } 996 } 997 return; 998 } 999} 1000 1001{ 1002 my %literal_unaryop = 1003 ( '!' => sub { 1004 my $l = shift->toboolean; 1005 $l->{node}[0] = -($l->{node}[0] - 1); 1006 return $l; 1007 }, 1008 '~' => sub { 1009 my $l = shift->tonumber; 1010 return $l if $l->isa('SWF::Builder::ActionScript::SyntaxNode::NaN'); 1011 if ($l->isa('SWF::Builder::ActionScript::SyntaxNode::Infinity')) { 1012 $l->{node}[0] = -1; 1013 return bless $l, 'SWF::Builder::ActionScript::SyntaxNode::NumberLiteral'; 1014 } else { 1015 $l->{node}[0] = ~($l->{node}[0]); 1016 return $l; 1017 } 1018 }, 1019 '-' => sub { 1020 my $l = shift->tonumber; 1021 return $l if $l->isa('SWF::Builder::ActionScript::SyntaxNode::NaN'); 1022 $l->{node}[0] = -($l->{node}[0]); 1023 return $l; 1024 }, 1025 '+' => sub { 1026 return shift->tonumber; 1027 }, 1028 ); 1029 1030 sub unary_expression { 1031 my $self = shift; 1032 my @unaryop = $self->_get_token; 1033 1034 if ($unaryop[1] eq 'UnaryOp' or $unaryop[0] eq '-' or $unaryop[0] eq '+') { 1035 my $e = $self->unary_expression or $self->_error('Syntax error'); 1036 if ($self->{stat}{Optimize} & O_CONSTEXP and 1037 $e->isa('SWF::Builder::ActionScript::SyntaxNode::Literal')) { 1038 return $literal_unaryop{$unaryop[0]}->($e); 1039 } else { 1040 my $n = $self->new_node('UnaryExpression'); 1041 $n->add_node($e, $unaryop[0]); 1042 return $n; 1043 } 1044 } elsif ($unaryop[1] eq 'PrefixOp') { 1045 my $e = $self->unary_expression; 1046 $self->_error("Operator '%s' can modify only a variable or a property.", $unaryop[0]) unless $e->_lhs; 1047 my $n = $self->new_node('PrefixExpression'); 1048 $n->add_node($e, $unaryop[0]); 1049 return $n; 1050 } elsif ($unaryop[1] eq 'DeleteOp') { 1051 my $n = $self->new_node('DeleteExpression'); 1052 $n->add_node($self->unary_expression, $unaryop[0]); 1053 return $n; 1054 } else { 1055 $self->_unget_token(@unaryop); 1056 return $self->postfix_expression; 1057 } 1058 } 1059} 1060 1061sub postfix_expression { 1062 my $self = shift; 1063 1064 my $e = ($self->call_or_member_expression) or return; 1065 my @postop = $self->_get_token; 1066 if ($postop[0] eq '++' or $postop[0] eq '--') { 1067 if ($postop[2]>=1) { 1068 $self->_unget_token(@postop); 1069 $self->_unget_token(';', 'StatementTerminator', 0); 1070 return $e; 1071 } else { 1072 my $n = $self->new_node('PostfixExpression'); 1073 $n->add_node($e, $postop[0]); 1074 return $n; 1075 } 1076 } else { 1077 $self->_unget_token(@postop); 1078 return $e; 1079 } 1080} 1081 1082sub call_or_member_expression { 1083 my $self = shift; 1084 1085 my $name = $self->member_expression or return; 1086 1087 return $name unless ($self->_check_token('(')); 1088 1089 my $args = $self->arguments or $self->_error('Syntax error'); 1090 my (@members, @methods, @token); 1091 1092 CALL_MEMBER_LOOP: 1093 for(;;) { 1094 my $m; 1095 @token = $self->_get_token; 1096 for ($token[1]) { 1097 /^\($/ and do { 1098 $m = $self->arguments or $self->_error('Arguments are needed'); 1099 push @methods, $m; 1100 if (@members == 0 or ref($members[-1])=~/:MethodCall$/) { 1101 push @members, $self->new_node('MethodCall'); 1102 $members[-1]->add_node(''); 1103 } else { 1104 bless $members[-1], 'SWF::Builder::ActionScript::SyntaxNode::MethodCall'; 1105 } 1106 last; 1107 }; 1108 /^\.$/ and do { 1109 $m = $self->member or $self->_error('Member identifier is needed'); 1110 push @members, $m; 1111 last; 1112 }; 1113 /^\[$/ and do { 1114 $m = $self->subscript or $self->_error('Member expression is needed'); 1115 push @members, $m; 1116 last; 1117 }; 1118 last CALL_MEMBER_LOOP; 1119 } 1120 } 1121 $self->_unget_token(@token); 1122 1123 FUNCtoLITERAL: 1124 { 1125 if (@members == 0 and @methods == 0 and $self->{stat}{Optimize} & O_CONSTMATH) { 1126 my $sub; 1127 if (ref($name)=~/:Variable$/) { 1128 $sub = '_f_'.lc($name->{node}[0]); 1129 } elsif (ref($name)=~/:MemberExpression/ and lc($name->{node}[0]{node}[0]) eq 'math' and @{$name->{node}} == 2) { 1130 $sub = '_math_'.lc($name->{node}[1]{node}[0]); 1131 } else { 1132 last FUNCtoLITERAL; 1133 } 1134 my @args; 1135 for my $a (@{$args->{node}}) { 1136 last FUNCtoLITERAL unless ($a->isa('SWF::Builder::ActionScript::SyntaxNode::Literal')); 1137 push @args, $a; 1138 } 1139 last FUNCtoLITERAL if @args<=0; 1140 last FUNCtoLITERAL unless $sub = $args[0]->can($sub); 1141 return &$sub(@args); 1142 } 1143 } 1144 my $n = $self->new_node('CallExpression'); 1145 $n->add_node($name, $args, \@members, \@methods); 1146 return $n; 1147} 1148 1149{ 1150 my %const_prop = ( 1151 key_backspace => 8, 1152 key_capslock => 20, 1153 key_control => 17, 1154 key_deletekey => 46, 1155 key_down => 40, 1156 key_end => 35, 1157 key_enter => 13, 1158 key_escape => 27, 1159 key_home => 36, 1160 key_insert => 45, 1161 key_left => 37, 1162 key_pgdn => 34, 1163 key_pgup => 33, 1164 key_right => 39, 1165 key_shift => 16, 1166 key_space => 32, 1167 key_tab => 9, 1168 key_up => 38, 1169 1170 math_e => 2.71828182845905, 1171 math_ln2 => 0.693147180559945, 1172 math_ln10 => 2.30258509299405, 1173 math_log2e => 1.44269504088896, 1174 math_log10e => 0.434294481903252, 1175 math_pi => 3.14159265358979, 1176 math_sqrt1_2 => 0.707106781186548, 1177 math_sqrt2 => 1.4142135623731, 1178 1179 number_max_value => 1.79769313486231e+308, 1180 number_min_value => 4.94065645841247e-324, 1181 number_nan => 'NaN', 1182 number_negative_infinity => -$INFINITY, 1183 number_positive_infinity => $INFINITY, 1184 1185 ); 1186 1187 sub member_expression { 1188 my $self = shift; 1189 1190 my @tree; 1191 my @token = $self->_get_token; 1192 for ($token[1]) { 1193 (/^Identifier$/ or /^Reserved$/) and do { 1194 my $n = $self->new_node('Variable'); 1195 $n->add_node($token[0]); 1196 $self->use_var($token[0]); 1197 push @tree, $n; 1198 last; 1199 }; 1200 /Literal$/ and do { 1201 my $n = $self->new_node($token[1]); 1202 $n->add_node($token[0]); 1203 push @tree, $n; 1204 last; 1205 }; 1206 /^Function$/ and do{ 1207 push @tree, $self->function_expression(''); 1208 last; 1209 }; 1210 /^New$/ and do { 1211 my $m = $self->member_expression or $self->_error("Invalid expression in 'new'"); 1212 my $newex = $self->new_node('NewExpression'); 1213 if ($self->_check_token('(')) { 1214 my $args = $self->arguments or $self->_error('Syntax error00'); 1215 $newex->add_node($m, $args); 1216 } else { 1217 $newex->add_node($m, $self->new_node('Arguments')); 1218 } 1219 push @tree, $newex; 1220 last; 1221 }; 1222 /^\(/ and do { 1223 my $e = $self->expression; 1224 $self->_check_token_fatal(')'); 1225 push @tree, $e; 1226 last; 1227 }; 1228 /^\{/ and do { 1229 push @tree, $self->object_literal; 1230 last; 1231 }; 1232 /^\[/ and do { 1233 push @tree, $self->array_literal; 1234 last; 1235 }; 1236 /^Property$/ and do { 1237 my $n = $self->new_node($self->{stat}{with}>0 ? 'Variable' : 'Property'); 1238 $n->add_node($token[0]); 1239 push @tree, $n; 1240 last; 1241 }; 1242 $self->_unget_token(@token); 1243 return; 1244 } 1245 1246 MEMBER_LOOP: 1247 for (;;){ 1248 @token = $self->_get_token; 1249 my $m; 1250 for ($token[1]) { 1251 /^\.$/ and do { 1252 $m = $self->member or $self->_error('Syntax error'); 1253 last; 1254 }; 1255 /^\[$/ and do { 1256 $m = $self->subscript or $self->_error('Syntax error'); 1257 last; 1258 }; 1259 last MEMBER_LOOP; 1260 } 1261 push @tree, $m; 1262 } 1263 $self->_unget_token(@token); 1264 1265 PROPERTYtoLITERAL: 1266 { 1267 last if @tree != 2 or !($self->{stat}{Optimize} & O_CONSTMATH); 1268 last unless (ref($tree[0])=~/:Variable/ and ref($tree[1])=~/:Member/); 1269 my $prop = lc($tree[0]->{node}[0].'_'.$tree[1]->{node}[0]); 1270 last unless exists $const_prop{$prop}; 1271 my $n = $self->new_node('NumberLiteral'); 1272 $n->add_node($const_prop{$prop}); 1273 $n->_chk_inf_nan; 1274 return $n; 1275 } 1276 return $tree[0] if @tree <= 1; 1277 my $n = $self->new_node('MemberExpression'); 1278 $n->add_node(@tree); 1279 return $n; 1280 } 1281} 1282 1283sub subscript { 1284 my $self = shift; 1285 my $e = $self->expression or return; 1286 my $n = $self->new_node('Member'); 1287 $n->add_node($e); 1288 return ($self->_check_token(']') and $n); 1289} 1290 1291sub arguments { 1292 my $self = shift; 1293 my $n = $self->new_node('Arguments'); 1294 1295 ARGUMENTS: 1296 { 1297 my @token; 1298 $self->_check_token(')') 1299 and return $n; 1300 do { 1301 my $e = $self->assignment_expression or last ARGUMENTS; 1302 $n->add_node($e); 1303 @token = $self->_get_token; 1304 } while ($token[1] eq ','); 1305 last ARGUMENTS unless $token[1] eq ')'; 1306 return $n; 1307 } 1308 $self->_error('Syntax error'); 1309} 1310 1311sub member { 1312 my $self = shift; 1313 1314 if (my $i = $self->identifier) { 1315 my $n = $self->new_node('Member'); 1316 $n->add_node($i); 1317 return $n; 1318 } else { 1319 return; 1320 } 1321} 1322 1323sub function_expression { 1324 my ($self, $name) = @_; 1325 1326 $self->_check_token_fatal('(', "'(' is needed after 'function'"); 1327 1328 $self->new_scope; 1329 1330 my $params = $self->new_node('FunctionParameter'); 1331 my @token; 1332 unless ($self->_check_token(')')) { 1333 do { 1334 my $i = $self->identifier or $self->_error('Identifier is needed in the argument list'); 1335 $params->add_node($i); 1336 $self->add_var($i, 0, 1); 1337 @token = $self->_get_token; 1338 } while ($token[1] eq ','); 1339 $self->_error("Missing ')'") unless $token[1] eq ')'; 1340 } 1341 $self->_check_token_fatal('{', "Missing '{' for function '$name'"); 1342 1343 my $statements = $self->new_node('SourceElements'); 1344 until($self->_check_token('}')) { 1345 my $c = ($self->function_declaration || $self->statement) 1346 or $self->_error("Syntax error. Missing '}' for function."); 1347 if ($self->{scope}[-1]) { 1348 for my $var (@{$self->{scope}[-1]{preload}}) { 1349 my $n = $self->new_node('PreloadVar'); 1350 $n->add_node($var); 1351 $statements->add_node($n); 1352 } 1353 $self->{scope}[-1]{preload} = []; 1354 } 1355 if (ref($c)=~/:Function$/) { 1356 $statements->unshift_node($c); 1357 } else { 1358 $statements->add_node($c); 1359 } 1360 $self->countup_node; 1361 } 1362 my $node = $self->new_node('Function'); 1363 $node->add_node($name, $params, $statements); 1364 $self->exit_scope($node); 1365 1366 return $node; 1367} 1368 1369sub object_literal { 1370 my $self = shift; 1371 my $n = $self->new_node('ObjectLiteral'); 1372 1373 OBJECT: 1374 { 1375 my @tree; 1376 my @token; 1377 $self->_check_token('}') 1378 and $self->_get_token, return $n; 1379 do { 1380 my $i = $self->identifier; 1381 last OBJECT unless $i; 1382 last OBJECT unless ($self->_get_token)[1] eq ':'; 1383 my $e = $self->assignment_expression; 1384 last OBJECT unless $e; 1385 $n->add_node($i, $e); 1386 @token = $self->_get_token; 1387 } while ($token[1] eq ','); 1388 last OBJECT unless $token[1] eq '}'; 1389 return $n; 1390 } 1391 $self->_error('Syntax error'); 1392} 1393 1394sub array_literal { 1395 my $self = shift; 1396 my $n = $self->new_node('ArrayLiteral'); 1397 1398 ARRAY: 1399 { 1400 my @tree; 1401 my @token; 1402 $self->_check_token(']') 1403 and $self->_get_token, return $n; 1404 do { 1405 my $e = $self->assignment_expression or last ARRAY; 1406 $n->add_node($e); 1407 @token = $self->_get_token; 1408 } while ($token[1] eq ','); 1409 last ARRAY unless $token[1] eq ']'; 1410 return $n; 1411 } 1412 $self->_error('Syntax error'); 1413} 1414 1415sub expression { 1416 my $self = shift; 1417 my @tree; 1418 my @comma; 1419 1420 my $e = $self->assignment_expression; 1421 while((@comma = $self->_get_token)[1] eq ',' ) { 1422 push @tree, $self->assignment_expression; 1423 } 1424 $self->_unget_token(@comma); 1425 if (@tree <= 0) { 1426 return $e; 1427 } else { 1428 my $n = $self->new_node('Expression'); 1429 $n->add_node($e, @tree); 1430 return $n; 1431 } 1432} 1433 1434sub expression_statement { 1435 my $self = shift; 1436 my $e = $self->expression or $self->_error('Syntax error'); 1437 $self->_statement_terminator; 1438 my $n = $self->new_node('ExpressionStatement'); 1439 $n->add_node($e); 1440 return $n; 1441} 1442 1443sub _statement_terminator { 1444 my $self = shift; 1445 my @token = $self->_get_token; 1446 unless ($token[1] eq 'StatementTerminator') { 1447 if ($token[1] eq '}' or $token[2]>=1 or $token[1] eq '') { 1448 $self->_unget_token(@token); 1449 return 1; 1450 } 1451 $self->_unget_token(@token); 1452 $self->_error("Syntax error. ';' is expected."); 1453 } 1454 return 1; 1455} 1456 1457### code generator 1458 1459sub _code_print { 1460 my $self = shift; 1461 my $code = $self->{stat}{code}; 1462 for (@$code) { 1463 print "$_\n"; 1464 } 1465} 1466 1467{ 1468 my %encode = ( 1469 GotoFrame => [qw/ Frame /], 1470 GetURL => [qw/ $UrlString $TargetString /], 1471 WaitForFrame => [qw/ Frame : SkipCount /], 1472 SetTarget => [qw/ $TargetName /], 1473 GotoLabel => [qw/ $Label /], 1474 WaitForFrame2 => [qw/ : SkipCount /], 1475 Jump => [qw/ : BranchOffset /], 1476 GetURL2 => [qw/ Method /], 1477 If => [qw/ : BranchOffset /], 1478 GotoFrame2 => [qw/ PlayFlag /], 1479 StoreRegister => [qw/ Register /], 1480 With => [qw/ : CodeSize /], 1481 ); 1482 1483 sub _encode { 1484 my ($self, $actions) = @_; 1485 my $code = $self->{stat}{code}; 1486 my $lhash = $self->{stat}{labelhash}; 1487 my @constant = map {_unescape($_)} grep {$self->{stat}{strings}{$_} >=2} keys %{$self->{stat}{strings}}; 1488 my %constant; 1489 @constant{@constant} = (0..$#constant); 1490 1491 if (@constant > 0) { 1492 push @$actions, SWF::Element::ACTIONRECORD->new 1493 ( Tag=>'ActionConstantPool', 1494 ConstantPool => \@constant 1495 ); 1496 } 1497 1498 my $labelf = 0; 1499 my $p = 0; 1500 1501 for my $c (@$code) { 1502 my ($action, $param) = ($c=~/^([^ ]+) *(.+)?$/); 1503 my $tag; 1504 1505 if ($action =~ /^:/) { 1506 $labelf = 1; 1507 next; 1508 } elsif ($action eq 'Push') { 1509 $tag = SWF::Element::ACTIONRECORD->new( Tag => 'ActionPush'); 1510 my $dl = $tag->DataList; 1511 while(($param =~ / *([^ ]+) +\'((:?\\.|[^\'])*)\' */g)) { 1512 my ($type, $value) = ($1, $2); 1513 if ($type eq 'String') { 1514 $value = _unescape($value); 1515 if (exists $constant{$value}) { 1516 push @$dl, SWF::Element::ACTIONDATA::Lookup->new($constant{$value}); 1517 } else { 1518 push @$dl, SWF::Element::ACTIONDATA::String->new($value); 1519 } 1520 } elsif ($type eq 'Number') { 1521 if ( $value=~/^-?\d+$/ and -2147483648<=$value and $value<2147483648 ) { 1522 push @$dl, SWF::Element::ACTIONDATA::Integer->new($value); 1523 } else { 1524 push @$dl, SWF::Element::ACTIONDATA::Double->new($value); 1525 } 1526 } else { 1527 push @$dl, "SWF::Element::ACTIONDATA::$type"->new($value); 1528 } 1529 } 1530 } elsif ($action eq 'DefineFunction') { 1531 $tag = SWF::Element::ACTIONRECORD->new( Tag => 'ActionDefineFunction'); 1532 $param =~ s/ *\'((?:\\.|[^\'])*)\' *//; 1533 my $fname = $1; 1534 utf2bin($fname); 1535 my @args = split ' ', $param; 1536 utf2bin($_) for @args; 1537 $tag->CodeSize( $self->{stat}{labelhash}{$self->{stat}{labelhash}{pop @args}} ); 1538 $tag->FunctionName($fname); 1539 $tag->Params(\@args); 1540 } elsif ($action eq 'DefineFunction2') { 1541 $tag = SWF::Element::ACTIONRECORD->new( Tag => 'ActionDefineFunction2'); 1542 $param =~ s/ *\'((?:\\.|[^\'])*)\' *//; 1543 my $fname = $1; 1544 utf2bin($fname); 1545 my ($regcount, $flag, @args) = split ' ', $param; 1546 utf2bin($_) for @args; 1547 $tag->CodeSize( $self->{stat}{labelhash}{$self->{stat}{labelhash}{pop @args}} ); 1548 $tag->FunctionName($fname); 1549 $tag->RegisterCount($regcount); 1550 $tag->Flags($flag); 1551 my $regp = $tag->Parameters; 1552 for my $arg (@args) { 1553 my $n = $regp->new_element; 1554 my @r = split /=/, $arg; 1555 $n->ParamName($r[0]); 1556 $n->Register($r[1]); 1557 push @$regp, $n; 1558 } 1559 } elsif (exists $encode{$action}) { 1560 my @args = ($param =~ /\'((?:\\.|[^\'])*)\'/g); 1561 $tag = SWF::Element::ACTIONRECORD->new( Tag => $action); 1562 for my $e (@{$encode{$action}}) { 1563 if ($e eq ':') { 1564 $args[0] = $self->{stat}{labelhash}{$self->{stat}{labelhash}{$args[0]}}; 1565 } elsif ($e=~/^\$/) { 1566 $e=~s/^\$//; 1567 my $str = shift @args; 1568 utf2bin($str); 1569 $tag->$e($str); 1570 } else { 1571 $tag->$e(shift @args); 1572 } 1573 } 1574 } else { 1575 $tag = SWF::Element::ACTIONRECORD->new( Tag => $action); 1576 } 1577 1578 if ($labelf) { 1579 $tag->LocalLabel($self->{stat}{labelhash}{$p}); 1580 $labelf = 0; 1581 } 1582 push @$actions, $tag; 1583 } continue { 1584 $p++; 1585 } 1586 my $tag = SWF::Element::ACTIONRECORD->new ( Tag => 'ActionEnd' ); 1587 if ($labelf) { 1588 $tag->LocalLabel($self->{stat}{labelhash}{$p}); 1589 } 1590 push @$actions, $tag; 1591 return $actions; 1592 } 1593} 1594 1595{ 1596 my %escchar = ( 1597 'b' => "\x08", 1598 'f' => "\x0c", 1599 'n' => "\x0a", 1600 'r' => "\x0d", 1601 't' => "\x09", 1602 'u' => 'u', 1603 'x' => 'x', 1604 '"' => '"', 1605 "'" => "'", 1606 ); 1607 1608 sub _unescape { 1609 my $str = shift; 1610 1611 $str =~s[\\(u([0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F])|x([0-9a-fA-F][0-9a-fA-F])|([0-3][0-7][0-7])|.)][ 1612 if ($2||$3) { 1613 eval(qq("\\x{).($2||$3).qq(}")); 1614 } elsif ($4) { 1615 eval(qq("\\$4")); 1616 } else { 1617 $escchar{$1} || '\\'; 1618 } 1619 ]eg; 1620 utf2bin($str); 1621 $str; 1622 } 1623} 1624 1625sub _tidy_up { 1626 my $self = shift; 1627 my $code = $self->{stat}{code}; 1628 1629TIDYUP: 1630 for (my $p = 0; $p < @$code; $p++) { 1631 for ($code->[$p]) { 1632 if ($self->{stat}{Optimize} & O_PEEPHOLE) { 1633# delete double not 1634 (/^Not$/ and $code->[$p+1] eq 'Not') and do { 1635 splice(@$code, $p, 2); 1636 $p-- if $p>0; 1637 redo TIDYUP; 1638 }; 1639# delete push and following pop 1640 (/^Push / and $code->[$p+1] eq 'Pop') and do { 1641 s/ *[^ ]+ +\'(\\.|[^\'])*\' *$//; 1642 if (/^Push$/) { 1643 splice(@$code, $p, 2); 1644 $p-- if $p>0; 1645 } else { 1646 splice(@$code, $p+1, 1); 1647 } 1648 redo TIDYUP; 1649 }; 1650# delete jump to the next step 1651 (/^Jump\s+'(.+)'/ and $code->[$p+1] eq ":$1") and do { 1652 splice(@$code, $p, 1); 1653 $p-- if $p>0; 1654 redo TIDYUP; 1655 }; 1656# delete the actions after jump 1657 (/^Jump / and $code->[$p+1]!~/^:/) and do { 1658 splice(@$code, $p+1, 1) while($code->[$p+1]!~/^:/); 1659 redo TIDYUP; 1660 }; 1661 } 1662 1663 (/^Push / and $code->[$p+1]=~/^Push /) and do { 1664 (my $push = $code->[$p+1]) =~s/Push//; 1665 $code->[$p].=$push; 1666 splice(@$code, $p+1, 1); 1667 redo TIDYUP; 1668 }; 1669 /^:(.+)$/ and do { 1670 my $q = $p; 1671 my $l = $1; 1672 $q++ until($code->[$q]!~/^:/ or $q >= @$code); 1673 $self->{stat}{labelhash}{$l} = $q; 1674 $self->{stat}{labelhash}{$q} = "L_$l"; 1675 last; 1676 }; 1677 (/^Push / and / String /) and do { 1678 my @strings = / String +'((?:\\.|[^'])*)\'/g; 1679 $self->{stat}{strings}{$_}++ for (@strings); 1680 last; 1681 }; 1682 if ($self->{stat}{Version}<=5) { 1683 /^StrictEquals$/ and do{ 1684 $self->_warn(0, "ActionStrictEquals is only available for version 6 or higher. ActionEquals2 is used instead."); 1685 $code->[$p] = 'Equals2'; 1686 last; 1687 }; 1688 /^Greater$/ and splice(@$code, $p, 1, 'StackSwap', 'Less2'), last; 1689 /^StringGreater$/ and splice(@$code, $p, 1, 'StackSwap', 'StringLess'), last; 1690 /^InstanceOf$/ and $self->_error("'instanceof' op is only available for version 6 or higher."); 1691 } 1692 } 1693 } 1694} 1695 1696{ 1697 package SWF::Builder::ActionScript::Compiler::Error; 1698 1699 sub _error { 1700 my $self = shift; 1701 my $msgform = shift; 1702# my ($t) = ($self->{text}=~/([^\n]+)/); 1703 die sprintf($msgform, @_)." in ".$self->{line}."\n"; 1704 } 1705 1706 sub _warn { 1707 my $self = shift; 1708 my $level = shift; 1709 my $msgform = shift; 1710 1711 warn sprintf($msgform, @_)." in ".$self->{line}."\n" if $level >= $self->{stat}{Warning}; 1712 } 1713 1714 sub _warn_not_recommend { 1715 my ($self, $not, $instead) = @_; 1716 1717 $self->_warn(0, "$not is not recommended to use. Use $instead instead."); 1718 } 1719 1720 sub _error_param { 1721 my ($self, $command) = @_; 1722 1723 $self->_error("Wrong parameter for '%s'.", $command); 1724 } 1725} 1726 1727{ 1728 package SWF::Builder::ActionScript::SyntaxNode; 1729 our @ISA = ('SWF::Builder::ActionScript::Compiler::Error'); 1730 1731 sub add_node { 1732 my $self = shift; 1733 push @{$self->{node}}, @_; 1734 } 1735 1736 sub unshift_node { 1737 my $self = shift; 1738 unshift @{$self->{node}}, @_; 1739 } 1740 1741 1742 sub _tree_dump { 1743 my ($self, $indent, $line)=@_; 1744 my ($nodename) = (ref($self)=~/([^:]+)$/); 1745 1746 $indent ||= 0; 1747 print ((($self->{line} != $line) ? sprintf('%3d: ', $self->{line}) : ' '), ' ' x ($indent*4), "$nodename [\n"); 1748 for my $node (@{$self->{node}}) { 1749 if (ref($node)) { 1750 eval{$node->_tree_dump($indent+1, $self->{line})}; 1751 if ($@) { 1752 print STDERR "\n",ref($self),"\n",ref($node),"\n"; 1753 die; 1754 } 1755 } else { 1756 print ' ', ' ' x (($indent+1)*4), "'$node'\n"; 1757 } 1758 } 1759 print ' ', ' ' x ($indent*4), "]\n"; 1760 } 1761 1762 sub _lhs { 1763 } 1764} 1765 1766{ 1767 package SWF::Builder::ActionScript::SyntaxNode::NullStatement; 1768 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 1769 1770 sub compile {} 1771} 1772 1773{ 1774 package SWF::Builder::ActionScript::SyntaxNode::List; 1775 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 1776 1777 sub compile { 1778 my $self = shift; 1779 1780 for my $s (@{$self->{node}}) { 1781 $s->compile; 1782 } 1783 } 1784} 1785@SWF::Builder::ActionScript::SyntaxNode::SourceElements::ISA=('SWF::Builder::ActionScript::SyntaxNode::List'); 1786@SWF::Builder::ActionScript::SyntaxNode::StatementBlock::ISA=('SWF::Builder::ActionScript::SyntaxNode::List'); 1787@SWF::Builder::ActionScript::SyntaxNode::VariableDeclarationList::ISA=('SWF::Builder::ActionScript::SyntaxNode::List'); 1788 1789{ 1790 package SWF::Builder::ActionScript::SyntaxNode::VariableDeclaration; 1791 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 1792 1793 sub compile { 1794 my ($self, $context) = @_; # $context = lvalue if 'for var x in ...' 1795 my $code = $self->{stat}{code}; 1796 my $regvars = $self->{regvars}; 1797 my $var = $self->{node}[0]; 1798 1799 if ($regvars and exists $regvars->{$var}) { 1800 push @$code, "StoreRegister '".$regvars->{$var}."'", 'Pop', -2 if defined($context) and $context eq 'lvalue'; 1801 } else { 1802 push @$code, "Push String '$var'", ($context eq 'lvalue' ? ("DefineLocal", -1) : ("DefineLocal2")); 1803 } 1804 } 1805} 1806 1807{ 1808 package SWF::Builder::ActionScript::SyntaxNode::VariableDeclarationWithParam; 1809 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 1810 1811 sub compile { 1812 my $self = shift; 1813 my $code = $self->{stat}{code}; 1814 my $regvars = $self->{regvars}; 1815 my $var = $self->{node}[0]; 1816 1817 if ($regvars and exists $regvars->{$var}) { 1818 $self->{node}[1]->compile('value'); 1819 push @$code, "StoreRegister '".$regvars->{$var}."'", 'Pop'; 1820 } else { 1821 push @$code, "Push String '$var'"; 1822 $self->{node}[1]->compile('value'); 1823 push @$code, "DefineLocal"; 1824 } 1825 } 1826} 1827 1828{ 1829 package SWF::Builder::ActionScript::SyntaxNode::BinaryOpExpression; 1830 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 1831 1832 my %bin_ops = 1833 ( '*' => ['Multiply'], 1834 '/' => ['Divide'], 1835 '%' => ['Modulo'], 1836 '+' => ['Add2'], 1837 '-' => ['Subtract'], 1838 '<<' => ['BitLShift'], 1839 '>>>' => ['BitURShift'], 1840 '>>' => ['BitRShift'], 1841 '<=' => ['Greater', 'Not'], 1842 '>=' => ['Less2', 'Not'], 1843 '<' => ['Less2'], 1844 '>' => ['Greater'], 1845 'instanceof' => ['InstanceOf'], 1846 '===' => ['StrictEquals'], 1847 '!==' => ['StrictEquals', 'Not'], 1848 '==' => ['Equals2'], 1849 '!=' => ['Equals2', 'Not'], 1850 '&' => ['BitAnd'], 1851 '^' => ['BitXor'], 1852 '|' => ['BitOr'], 1853 1854 'add' => ['StringAdd'], 1855 'eq' => ['StringEquals'], 1856 'ne' => ['StringEquals', 'Not'], 1857 'ge' => ['StringLess', 'Not'], 1858 'gt' => ['StringGreater'], 1859 'le' => ['StringGreater', 'Not'], 1860 'lt' => ['StringLess'], 1861 1862 ); 1863 my %obsolete = (add=>'+', eq=>'==', ne=>'!=', ge=>'>=', gt=>'>', le=>'<=', lt=>'<'); 1864 1865 sub compile { 1866 my ($self, $context) = @_; 1867 my $node = $self->{node}; 1868 my $code = $self->{stat}{code}; 1869 1870 shift(@$node)->compile($context); 1871 1872 while(@$node) { 1873 my $term = shift(@$node); 1874 my $op = shift(@$node); 1875 $self->_warn_not_recommend("'$op' op", "'$obsolete{$op}'") if exists($obsolete{$op}); 1876 $term->compile($context); 1877 if ($context) { 1878 push @$code, @{$bin_ops{$op}}; 1879 } else { 1880 $self->_warn(1, "Useless use of '$op' in void context."); 1881 } 1882 } 1883 } 1884} 1885 1886{ 1887 package SWF::Builder::ActionScript::SyntaxNode::Expression; 1888 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 1889 1890 sub compile { 1891 my ($self, $context) = @_; 1892 my $last = pop @{$self->{node}}; 1893 1894 for my $e (@{$self->{node}}) { 1895 $e->compile; 1896 } 1897 $last->compile($context); 1898 } 1899} 1900 1901{ 1902 package SWF::Builder::ActionScript::SyntaxNode::ExpressionStatement; 1903 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 1904 1905 sub compile { 1906 my $self = shift; 1907 1908 $self->{node}[0]->compile; 1909 } 1910} 1911 1912{ 1913 package SWF::Builder::ActionScript::SyntaxNode::Literal; 1914 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 1915 1916 sub compile { 1917 my ($self, $context) = @_; 1918 1919 my ($type) = (ref($self) =~/([A-Za-z]+)Literal/); 1920 ($context =~/lc?value/) and $self->_error("Can't modify literal item"); 1921 push @{$self->{stat}{code}}, "Push $type '".$self->{node}[0]."'" if $context; 1922 $self; 1923 } 1924 1925 sub toboolean { 1926 my $self = shift; 1927 $self->{node}[0] = $self->istrue; 1928 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::BooleanLiteral'; 1929 } 1930 1931 sub _totrue { 1932 my $self = shift; 1933 $self->{node}[0] = 1; 1934 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::BooleanLiteral'; 1935 } 1936 1937 sub _tofalse { 1938 my $self = shift; 1939 $self->{node}[0] = 0; 1940 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::BooleanLiteral'; 1941 } 1942 1943 sub isvalue {1} 1944 1945 sub _binop_numbers { 1946 my ($self, $term, $opsub) = @_; 1947 $self->tonumber; 1948 $term->tonumber; 1949 return $term if $term->isa('SWF::Builder::ActionScript::SyntaxNode::NaN'); 1950 $self->{node}[0] = &$opsub($self->{node}[0], $term->{node}[0]); 1951 $self->_chk_inf_nan; 1952 } 1953 1954 sub _binop_rel { 1955 my ($self) = @_; 1956 &_binop_numbers; 1957 $self->toboolean; 1958 } 1959 1960 sub _binop_strings { 1961 my ($self, $term, $opsub) = @_; 1962 $self->tostring; 1963 $term->tostring; 1964 1965 $self->{node}[0] = &$opsub($self->{node}[0], $term->{node}[0]); 1966 $self; 1967 } 1968 1969 sub _binop_booleans { 1970 my ($self, $term, $opsub) = @_; 1971 $self->toboolean; 1972 $term->toboolean; 1973 1974 $self->{node}[0] = &$opsub($self->{node}[0], $term->{node}[0]); 1975 $self; 1976 } 1977 1978 sub _binop_Add2 { 1979 my ($self, $term) = @_; 1980 1981 if ($term->isa('SWF::Builder::ActionScript::SyntaxNode::StringLiteral')) { 1982 $self->tostring->_binop_Add2($term); 1983 } else { 1984 $self->tonumber->_binop_Add2($term); 1985 } 1986 } 1987 1988 sub _binop_LogicalAnd { 1989 my ($self, $term) = @_; 1990 1991 if ($self->istrue) { 1992 $term; 1993 } else { 1994 $self->toboolean; 1995 } 1996 } 1997 1998 sub _binop_LogicalOr { 1999 my ($self, $term) = @_; 2000 2001 return ($self->istrue ? $self : $term); 2002 } 2003 2004 sub _binop_Equals2Not { 2005 my ($self, $term) = @_; 2006 $self->_binop_Equals2($term); 2007 $self->{node}[0] = 1-$self->{node}[0]; 2008 $self; 2009 } 2010 2011 sub _binop_StrictEquals2Not { 2012 my ($self, $term) = @_; 2013 $self->_binop_StrictEquals2($term); 2014 $self->{node}[0] = 1-$self->{node}[0]; 2015 $self; 2016 } 2017 2018 sub _binop_StrictEquals { 2019 my ($self, $term) = @_; 2020 my ($t_self) = (ref($self)=~/([^:]+)$/); 2021 my ($t_term) = (ref($term)=~/([^:]+)$/); 2022 2023 return $self->_tofalse if ($t_self ne $t_term) or ($t_self eq 'NaN') or ($t_term eq 'NaN'); 2024 if ($t_self eq 'NumberLiteral') { 2025 if ($self->{node}[0] == $term->{node}[0]) { 2026 return $self->_totrue; 2027 } else { 2028 return $self->_tofalse; 2029 } 2030 } else { 2031 if ($self->{node}[0] eq $term->{node}[0]) { 2032 return $self->_totrue; 2033 } else { 2034 return $self->_tofalse; 2035 } 2036 } 2037 } 2038 2039 sub __nf1 { 2040 my $fnn = shift; 2041 my $fns = shift; 2042 my $num = shift; 2043 $num->_error_param($fnn) if @_; 2044 2045 $num->tonumber; 2046 return $num if $num->isa('SWF::Builder::ActionScript::SyntaxNode::NaN'); 2047 $num->{node}[0] = &$fns($num->{node}[0]); 2048 $num->tostring->tonumber; 2049 } 2050 2051 sub _f_int {__nf1('int', sub{int shift}, @_)} 2052 2053 sub _math_abs {__nf1('Math.abs', sub{abs shift}, @_)} 2054 sub _math_acos {__nf1('Math.acos', 2055 sub{ 2056 my $x = shift; 2057 return 'NaN' if abs($x)>1; 2058 return atan2(1-$x*$x, $x); 2059 }, 2060 @_)} 2061 sub _math_asin {__nf1('Math.asin', 2062 sub{ 2063 my $x = shift; 2064 return 'NaN' if abs($x)>1; 2065 return atan2($x, 1-$x*$x); 2066 }, 2067 @_)} 2068 sub _math_atan {__nf1('Math.atan', sub{atan2(1, shift)}, @_)} 2069 sub _math_ceil {__nf1('Math.ceil', 2070 sub{ 2071 my $x = shift; 2072 my $ix = int($x); 2073 return $x if $x == $ix; 2074 return $ix+($x>0); 2075 }, 2076 @_)} 2077 sub _math_cos {__nf1('Math.cos', sub{cos shift}, @_)} 2078 sub _math_exp {__nf1('Math.exp', sub{exp shift}, @_)} 2079 sub _math_floor{__nf1('Math.floor', 2080 sub{ 2081 my $x = shift; 2082 my $ix = int($x); 2083 return $x if $x == $ix; 2084 return $ix-($x<0); 2085 }, 2086 @_)} 2087 sub _math_log {__nf1('Math.log', 2088 sub{ 2089 my $x = shift; 2090 return 'NaN' if $x<0; 2091 return '-Infinity' if $x == 0; 2092 return log($x); 2093 }, 2094 @_)} 2095 sub _math_round{__nf1('Math.round', 2096 sub{ 2097 my $x = shift; 2098 my $ix = int($x+0.5*($x<=>0)); 2099 return ($ix==$x-0.5)?int($x):$ix; 2100 }, 2101 @_)} 2102 sub _math_sin {__nf1('Math.sin', sub{sin shift}, @_)} 2103 sub _math_sqrt {__nf1('Math.sqrt', 2104 sub{ 2105 my $x = shift; 2106 return 'NaN' if $x<0; 2107 return sqrt($x); 2108 }, 2109 @_)} 2110 sub _math_tan {__nf1('Math.tan', 2111 sub{ 2112 my $r = shift; 2113 return ($r<0 ? '-Infinity':'Infinity') if cos($r)==0; 2114 return sin($r)/cos($r); 2115 }, 2116 @_)} 2117 2118 sub __nf2 { 2119 my $fnn = shift; 2120 my $fns = shift; 2121 my $num1 = shift; 2122 my $num2 = shift; 2123 $num1->_error_param($fnn) if @_; 2124 2125 $num1->tonumber; 2126 $num2->tonumber; 2127 return $num1 if $num1->isa('SWF::Builder::ActionScript::SyntaxNode::NaN') or $num2->isa('SWF::Builder::ActionScript::SyntaxNode::NaN'); 2128 $num1->{node}[0] = &$fns($num1->{node}[0], $num2->{node}[0]); 2129 $num1->tostring->tonumber; 2130 } 2131 2132 sub _math_atan2 {__nf2('Math.atan2', sub{atan2($_[0], $_[1])}, @_)} 2133 sub _math_max {__nf2('Math.max', sub{my($a,$b)=@_;$a>$b?$a:$b}, @_)} 2134 sub _math_min {__nf2('Math.min', sub{my($a,$b)=@_;$a>$b?$b:$a}, @_)} 2135 sub _math_pow {__nf2('Math.pow', 2136 sub { 2137 my ($base, $exp) = @_; 2138 if ($base < 0 and $exp != int($exp)) { 2139 return 'NaN'; 2140 } else { 2141 return $base ** $exp; 2142 } 2143 }, 2144 @_)} 2145 2146 2147} 2148 2149{ 2150 package SWF::Builder::ActionScript::SyntaxNode::BooleanLiteral; 2151 our @ISA=('SWF::Builder::ActionScript::SyntaxNode::Literal'); 2152 2153 sub tonumber { 2154 bless shift, 'SWF::Builder::ActionScript::SyntaxNode::NumberLiteral'; 2155 } 2156 2157 sub tostring { 2158 my $self = shift; 2159 $self->{node}[0] = $self->{node}[0] ? 'true' : 'false'; 2160 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::StringLiteral'; 2161 } 2162 2163 sub toboolean {shift} 2164 sub istrue { 2165 my $self = shift; 2166 return ($self->{node}[0] != 0)? 1 : 0; 2167 } 2168 2169 sub _binop_Equals2 { 2170 my ($self, $term) = @_; 2171 2172 unless ($term->isvalue) { 2173 $self->{node}[0] = 0; 2174 $self; 2175 } elsif ($term->isa('SWF::Builder::ActionScript::SyntaxNode::BooleanLiteral')) { 2176 $self->{node}[0] = ($self->{node}[0] == $term->{node}[0]) ? 1:0; 2177 $self; 2178 } else { 2179 $self->tonumber->_binop_Equals2($term); 2180 } 2181 } 2182} 2183 2184{ 2185 package SWF::Builder::ActionScript::SyntaxNode::NaN; 2186 our @ISA=('SWF::Builder::ActionScript::SyntaxNode::NumberLiteral'); 2187 2188 sub compile { 2189 my ($self, $context) = @_; 2190 2191 ($context =~/lc?value/) and $self->_error("Can't modify literal item"); 2192 push @{$self->{stat}{code}}, "Push Number 'NaN'" if $context; 2193 $self; 2194 } 2195 2196 sub istrue {0} 2197 sub isvalue {0} 2198 sub _binop_Equals2 {shift->_tofalse} 2199 sub _binop_numbers {shift} 2200 sub _binop_rel {shift->_tofalse} 2201 2202 sub _binop_Add2 { 2203 my ($self, $term) = @_; 2204 2205 if ($term->isa('SWF::Builder::ActionScript::SyntaxNode::StringLiteral')) { 2206 $self->tostring->_binop_Add2($term); 2207 } else { 2208 $self; 2209 } 2210 } 2211 2212} 2213 2214{ 2215 package SWF::Builder::ActionScript::SyntaxNode::Infinity; 2216 our @ISA=('SWF::Builder::ActionScript::SyntaxNode::NumberLiteral'); 2217 2218 sub compile { 2219 my ($self, $context) = @_; 2220 2221 ($context =~/lc?value/) and $self->_error("Can't modify literal item"); 2222 my $value = $self->{node}[0]; 2223 my $packed = pack('d', $value); 2224 2225 if ($packed eq $NINF) { 2226 $value = '-Infinity'; 2227 } elsif ($packed eq $INF) { 2228 $value = 'Infinity'; 2229 } 2230 push @{$self->{stat}{code}}, "Push Number '$value'" if $context; 2231 $self; 2232 } 2233 2234 sub istrue {1} 2235 2236 sub _binop_Add2 { 2237 my ($self, $term) = @_; 2238 2239 if ($term->isa('SWF::Builder::ActionScript::SyntaxNode::StringLiteral')) { 2240 return $self->tostring->_binop_Add2($term); 2241 } elsif ($term->isa('SWF::Builder::ActionScript::SyntaxNode::Infinity') && 2242 $self->{node}[0] ne $term->{node}[0]) { 2243 $self->{node}[0] = 'NaN'; 2244 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::NaN'; 2245 } else { 2246 $self; 2247 } 2248 } 2249 2250 sub _binop_Equals2 { 2251 my ($self, $term) = @_; 2252 $term->tonumber; 2253 if ($self->{node}[0] eq $term->{node}[0]) { 2254 $self->_totrue; 2255 } else { 2256 $self->_tofalse; 2257 } 2258 } 2259} 2260 2261{ 2262 package SWF::Builder::ActionScript::SyntaxNode::NumberLiteral; 2263 our @ISA=('SWF::Builder::ActionScript::SyntaxNode::Literal'); 2264 2265 sub tonumber{shift} 2266 2267 sub tostring { 2268 bless shift, 'SWF::Builder::ActionScript::SyntaxNode::StringLiteral'; 2269 } 2270 2271 sub istrue { 2272 my $self = shift; 2273 return ($self->{node}[0] != 0)? 1 : 0; 2274 } 2275 2276 sub _chk_inf_nan { 2277 my $self = shift; 2278 my $value = $self->{node}[0]; 2279 2280 return bless $self, 'SWF::Builder::ActionScript::SyntaxNode::NaN' if $value eq 'NaN'; 2281 2282 my $packed = pack('d', $value); 2283 return $self if (($packed & $INF) ne $INF); 2284 2285 if (($packed & $MANTISSA) ne "\x00" x 8) { 2286 $self->{node}[0] = 'NaN'; 2287 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::NaN'; 2288 } else { 2289 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::Infinity'; 2290 } 2291 $self; 2292 } 2293 2294 sub _binop_Add2 { 2295 my ($self, $term) = @_; 2296 2297 if ($term->isa('SWF::Builder::ActionScript::SyntaxNode::StringLiteral')) { 2298 $self->tostring->_binop_Add2($term); 2299 } else { 2300 $term->tonumber; 2301 return $term 2302 if ($term->isa('SWF::Builder::ActionScript::SyntaxNode::NaN') || 2303 $term->isa('SWF::Builder::ActionScript::SyntaxNode::Infinity')); 2304 2305 $self->{node}[0] += $term->{node}[0]; 2306 $self->_chk_inf_nan; 2307 } 2308 } 2309 2310 sub _binop_Equals2 { 2311 my ($self, $term) = @_; 2312 2313 unless ($term->isvalue) { 2314 return $self->_tofalse; 2315 } elsif ($term->isa('SWF::Builder::ActionScript::SyntaxNode::Infinity')) { 2316 return $self->_tofalse; 2317 } else { 2318 $term->tonumber; 2319 if ($self->{node}[0] == $term->{node}[0]) { 2320 return $self->_totrue; 2321 } else { 2322 return $self->_tofalse; 2323 } 2324 } 2325 } 2326} 2327 2328{ 2329 package SWF::Builder::ActionScript::SyntaxNode::StringLiteral; 2330 our @ISA=('SWF::Builder::ActionScript::SyntaxNode::Literal'); 2331 2332 sub compile { 2333 my ($self, $context) = @_; 2334 2335 ($context =~/lc?value/) and $self->_error("Can't modify literal item"); 2336 my $value = $self->{node}[0]; 2337 $value =~ s/([\x00-\x1f\x7f-\xff])/sprintf('\\x%2.2x', ord($1))/eg; 2338 push @{$self->{stat}{code}}, "Push String '".$value."'" if $context; 2339 $self; 2340 } 2341 2342 sub tostring{shift} 2343 2344 sub _getnumber { 2345 my $self = shift; 2346 my $value = $self->{node}[0]; 2347 if ($value=~/^0[0-7]+$/ or $value=~/^0x[0-9a-f]$/i) { 2348 $value = oct($value); 2349 } elsif ($value !~ /^(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ and $value !~ /^[-+]?Infinity$/) { 2350 $value = ''; 2351 } 2352 return $value; 2353 } 2354 2355 sub tonumber { 2356 my $self = shift; 2357 my $value = $self->_getnumber; 2358 $self->{node}[0] = $value; 2359 2360 if ($value =~ /^([-+]?)Infinity$/) { 2361 $self->{node}[0] = ($1 eq '-' ? -$INFINITY: $INFINITY); 2362 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::Infinity'; 2363 } elsif ($value eq '') { 2364 $self->{node}[0] = 'NaN'; 2365 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::NaN'; 2366 } else { 2367 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::NumberLiteral'; 2368 } 2369 } 2370 2371 sub istrue { 2372 my $self = shift; 2373 return ($self->_getnumber ? 1 : 0); 2374 } 2375 2376 sub _binop_rel { 2377 my ($self, $term, $opsub, $opsub2) = @_; 2378 2379 unless ($term->isa('SWF::Builder::ActionScript::SyntaxNode::StringLiteral')) { 2380 $self->tonumber->_binop_rel($term, $opsub); 2381 } else { 2382 $self->{node}[0] = &$opsub2($self->{node}[0], $term->{node}[0]); 2383 $self->toboolean; 2384 } 2385 } 2386 2387 sub _binop_Equals2 { 2388 my ($self, $term) = @_; 2389 2390 unless ($term->isvalue) { 2391 return $self->_tofalse; 2392 } elsif ($term->isa('SWF::Builder::ActionScript::SyntaxNode::StringLiteral')) { 2393 if ($self->{node}[0] eq $term->{node}[0]) { 2394 return $self->_totrue; 2395 } else { 2396 return $self->_tofalse; 2397 } 2398 } else { 2399 $self->tonumber->_binop_Equals2($term); 2400 } 2401 } 2402 2403 sub _binop_Add2 { 2404 my ($self, $term) = @_; 2405 $self->{node}[0] .= $term->{node}[0]; 2406 $self; 2407 } 2408} 2409 2410{ 2411 package SWF::Builder::ActionScript::SyntaxNode::NULLLiteral; 2412 our @ISA=('SWF::Builder::ActionScript::SyntaxNode::Literal'); 2413 2414 sub tostring { 2415 my $self = shift; 2416 $self->{node}[0] = 'null'; 2417 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::StringLiteral'; 2418 } 2419 2420 sub tonumber { 2421 my $self = shift; 2422 $self->{node}[0] = 0; 2423 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::NumberLiteral'; 2424 } 2425 2426 sub istrue {0} 2427 sub isvalue {0} 2428 sub _binop_Equals2 { 2429 my ($self, $term) = @_; 2430 if ($term->isa('SWF::Builder::ActionScript::SyntaxNode::UNDEFLiteral') or 2431 $term->isa('SWF::Builder::ActionScript::SyntaxNode::NULLLiteral')) { 2432 $self->_totrue; 2433 } else { 2434 $self->_tofalse; 2435 } 2436 } 2437} 2438 2439{ 2440 package SWF::Builder::ActionScript::SyntaxNode::UNDEFLiteral; 2441 our @ISA=('SWF::Builder::ActionScript::SyntaxNode::Literal'); 2442 2443 sub tostring { 2444 bless shift, 'SWF::Builder::ActionScript::SyntaxNode::StringLiteral'; 2445 } 2446 2447 sub tonumber { 2448 my $self = shift; 2449 $self->{node}[0] = 0; 2450 bless $self, 'SWF::Builder::ActionScript::SyntaxNode::NumberLiteral'; 2451 } 2452 2453 sub istrue {0} 2454 sub isvalue {0} 2455 sub _binop_Equals2 { 2456 my ($self, $term) = @_; 2457 if ($term->isa('SWF::Builder::ActionScript::SyntaxNode::UNDEFLiteral') or 2458 $term->isa('SWF::Builder::ActionScript::SyntaxNode::NULLLiteral')) { 2459 $self->_totrue; 2460 } else { 2461 $self->_tofalse; 2462 } 2463 } 2464 2465} 2466 2467 2468{ 2469 package SWF::Builder::ActionScript::SyntaxNode::ObjectLiteral; 2470 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2471 2472 sub compile { 2473 my ($self, $context) = @_; 2474 my $node = $self->{node}; 2475 2476 ($context =~/lc?value/) and SWF::Builder::ActionScript::SyntaxNode::_error("Can't modify literal item"); 2477 my $code = $self->{stat}{code}; 2478 my $count = @$node / 2; 2479 while (@$node) { 2480 my $prop = shift @$node; 2481 my $value = shift @$node; 2482 push @$code, "Push String '$prop'"; 2483 $value->compile('value'); 2484 } 2485 push @$code, "Push Number '$count'", "InitObject"; 2486 push @$code, "Pop" unless $context; 2487 } 2488} 2489{ 2490 package SWF::Builder::ActionScript::SyntaxNode::ArrayLiteral; 2491 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2492 2493 sub compile { 2494 my ($self, $context) = @_; 2495 ($context =~/lc?value/) and SWF::Builder::ActionScript::SyntaxNode::_error("Can't modify literal item"); 2496 my $code = $self->{stat}{code}; 2497 my $count = @{$self->{node}}; 2498 for my $value (reverse @{$self->{node}}) { 2499 $value->compile('value'); 2500 } 2501 push @$code, "Push Number '$count'", "InitArray"; 2502 push @$code, "Pop" unless $context; 2503 } 2504} 2505{ 2506 package SWF::Builder::ActionScript::SyntaxNode::PreloadVar; 2507 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2508 2509 sub compile { 2510 my $self = shift; 2511 my $var = $self->{node}[0]; 2512 my $regvars = $self->{regvars}; 2513 if ($regvars and exists $regvars->{$var}) { 2514 push @{$self->{stat}{code}}, "Push String '$var'" 2515 , "GetVariable" 2516 , "StoreRegister '".$regvars->{$var}."'" 2517 , "Pop"; 2518 } 2519 $self; 2520 } 2521} 2522{ 2523 package SWF::Builder::ActionScript::SyntaxNode::Variable; 2524 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2525 2526 sub compile { 2527 my ($self, $context) = @_; 2528 my $code = $self->{stat}{code}; 2529 my $regvars = $self->{regvars}; 2530 my $var = $self->{node}[0]; 2531 2532 if ($regvars and exists $regvars->{$var}) { 2533 push @$code, "Push Register '".$regvars->{$var}."'" if $context ne 'lvalue'; 2534 push @$code, "StoreRegister '".$regvars->{$var}."'", 'Pop', -2 if $context eq 'lvalue' or $context eq 'lcvalue'; 2535 } else { 2536 push @$code, "Push String '$var'"; 2537 push @$code, 'GetVariable' if $context eq 'value' or not $context; 2538 push @$code, 'SetVariable', -1 if $context eq 'lvalue'; 2539 push @$code, 'PushDuplicate', 'GetVariable', 'SetVariable', -1 if $context eq 'lcvalue'; 2540 } 2541 push @$code, "Pop" unless $context; 2542 $self; 2543 } 2544 2545 sub _lhs {1} 2546} 2547{ 2548 package SWF::Builder::ActionScript::SyntaxNode::Property; 2549 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2550 2551 sub compile { 2552 my ($self, $context) = @_; 2553 my $code = $self->{stat}{code}; 2554 push @$code, "Push String '' "; 2555 push @$code, "Push Property '".lc($self->{node}[0])."'"; 2556 push @$code, 'GetProperty' if $context eq 'value' or not $context; 2557 push @$code, 'SetProperty', -1 if $context eq 'lvalue'; 2558 push @$code, "Push String '' ", "Push Property '".lc($self->{node}[0])."'", 'GetProperty', 'SetProperty', -1 if $context eq 'lcvalue'; 2559 push @$code, "Pop" unless $context; 2560 $self; 2561 } 2562 2563 sub _lhs {1} 2564} 2565 2566{ 2567 package SWF::Builder::ActionScript::SyntaxNode::MemberExpression; 2568 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2569 2570 sub compile { 2571 my ($self, $context) = @_; 2572 my @node = @{$self->{node}}; 2573 my $code = $self->{stat}{code}; 2574 2575 shift(@node)->compile('value'); 2576 return unless @node; 2577 my $last = pop @node; 2578 for my $member (@node){ 2579 $member->compile('value'); 2580 } 2581 $last->compile($context); 2582 } 2583 2584 sub _lhs {1} 2585} 2586 2587{ 2588 package SWF::Builder::ActionScript::SyntaxNode::Member; 2589 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2590 2591 sub compile { 2592 my ($self, $context) = @_; 2593 my $code = $self->{stat}{code}; 2594 my $member = $self->{node}[0]; 2595 2596 push @$code, 'PushDuplicate' if $context eq 'lcvalue'; 2597 if (ref($member)) { 2598 $member->compile('value'); 2599 } else { 2600 push @$code, "Push String '".$member."'"; 2601 } 2602 if ($context eq 'lvalue') { 2603 push @$code, 'SetMember', -1; 2604 } elsif ($context eq 'value') { 2605 push @$code, 'GetMember'; 2606 } elsif ($context eq 'lcvalue') { 2607 push @$code, "StoreRegister '0'",'GetMember', "Push Register '0'", 'StackSwap', 'SetMember', -1; 2608 } elsif (not defined $context) { 2609 push @$code, 'GetMember', 'Pop'; 2610 } 2611 } 2612} 2613 2614{ 2615 package SWF::Builder::ActionScript::SyntaxNode::AssignmentExpression; 2616 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2617 use constant \%O; 2618 2619 my %as_ops = 2620 ( '*=' => 'Multiply', 2621 '/=' => 'Divide', 2622 '%=' => 'Modulo', 2623 '+=' => 'Add2', 2624 '-=' => 'Subtract', 2625 '<<=' => 'BitLShift', 2626 '>>>=' => 'BitURShift', 2627 '>>=' => 'BitRShift', 2628 '&=' => 'BitAnd', 2629 '^=' => 'BitXor', 2630 '|=' => 'BitOr', 2631 ); 2632 2633 sub compile { 2634 my ($self, $context) = @_; 2635 my ($lhe, $op, $e) = @{$self->{node}}; 2636 my $code = $self->{stat}{code}; 2637 my $opt = $self->{stat}{Optimize} & O_LEFTONCE; 2638 my $as_context = ($op eq '=' or !$opt)? 'lvalue' : 'lcvalue'; 2639 2640 $lhe->compile($as_context); 2641 my $lv = pop @$code; 2642 my @lv = splice(@$code, $lv); 2643 $lhe->compile('value') if (!$opt and $op ne '='); 2644 $e->compile('value'); 2645 push @$code, $as_ops{$op} if exists $as_ops{$op}; 2646 push @$code, "StoreRegister '0'" if $context; 2647 push @$code, @lv; 2648 push @$code, "Push Register '0'" if $context; 2649 } 2650} 2651 2652{ 2653 package SWF::Builder::ActionScript::SyntaxNode::AndOpExpression; 2654 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2655 2656 sub compile { 2657 my ($self, $context) = @_; 2658 my $node = $self->{node}; 2659 my $label = $self->{stat}{label}++; 2660 my $code = $self->{stat}{code}; 2661 2662 shift(@$node)->compile('value'); 2663 2664 my ($term, $op); 2665 while(@$node) { 2666 $term = shift @$node; 2667 $op = shift @$node; 2668 if ($op eq '&&') { 2669 push @$code, 'PushDuplicate', 'Not', "If '$label'", 'Pop'; 2670 $term->compile('value'); 2671 } else { # $op eq 'and' 2672 $self->_warn_not_recommend("'and' op", "'&&'"); 2673 $term->compile('value'); 2674 push @$code, 'And'; 2675 } 2676 } 2677 push @$code, ":$label"; 2678 push @$code, "Pop" unless $context; 2679 } 2680} 2681{ 2682 package SWF::Builder::ActionScript::SyntaxNode::OrOpExpression; 2683 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2684 2685 sub compile { 2686 my ($self, $context) = @_; 2687 my $node = $self->{node}; 2688 my $label = $self->{stat}{label}++; 2689 my $code = $self->{stat}{code}; 2690 2691 shift(@$node)->compile('value'); 2692 2693 my ($term, $op); 2694 while(@$node) { 2695 $term = shift @$node; 2696 $op = shift @$node; 2697 if ($op eq '||') { 2698 push @$code, 'PushDuplicate', "If '$label'", 'Pop'; 2699 $term->compile('value'); 2700 } else { # $op eq 'or' 2701 $self->_warn_not_recommend("'or' op", "'||'"); 2702 $term->compile('value'); 2703 push @$code, 'Or'; 2704 } 2705 } 2706 push @$code, ":$label"; 2707 push @$code, "Pop" unless $context; 2708 } 2709} 2710{ 2711 package SWF::Builder::ActionScript::SyntaxNode::ConditionalExpression; 2712 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2713 2714 sub compile { 2715 my ($self, $context) = @_; 2716 my $node = $self->{node}; 2717 my $label1 = $self->{stat}{label}++; 2718 my $label2 = $self->{stat}{label}++; 2719 my $code = $self->{stat}{code}; 2720 2721 $node->[0]->compile('value'); 2722 push @$code, "If '$label1'"; 2723 $node->[2]->compile($context); 2724 push @$code, "Jump '$label2'", ":$label1"; 2725 $node->[1]->compile($context); 2726 push @$code, ":$label2"; 2727 } 2728} 2729{ 2730 package SWF::Builder::ActionScript::SyntaxNode::ReturnStatement; 2731 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2732 use constant \%O; 2733 2734 sub compile { 2735 my $self = shift; 2736 my $ret = shift(@{$self->{node}}); 2737 my $opt = $self->{stat}{Optimize}; 2738 my $code = $self->{stat}{code}; 2739 2740 2741 if (defined($ret)) { 2742 $ret->compile('value'); 2743 } else { 2744 push @$code, "Push UNDEF ''"; 2745 } 2746 2747 if (($opt & O_REGISTER) and !($opt & O_LOCALREG) and (my $regcount = $self->{regvars}{' regcount'}) > 0) { 2748 push @$code, "StoreRegister '0'", "Pop"; 2749 for (my $i = $regcount; $i >= 1; $i--) { 2750 push @$code, "StoreRegister '$i'", "Pop"; 2751 } 2752 push @$code, "Push Register '0'"; 2753 } 2754 2755 push @$code, "Return"; 2756 } 2757} 2758 2759{ 2760 package SWF::Builder::ActionScript::SyntaxNode::IfStatement; 2761 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2762 2763 sub compile { 2764 my $self = shift; 2765 my $stat = $self->{stat}; 2766 my $label1 = $stat->{label}++; 2767 my $code = $stat->{code}; 2768 my $node = $self->{node}; 2769 2770 $node->[0]->compile('value'); 2771 if ($node->[2]) { # else block 2772 my $label2 = $stat->{label}++; 2773 push @$code, "If '$label2'"; 2774 $node->[2]->compile; 2775 push @$code, "Jump '$label1'", ":$label2"; 2776 } else { 2777 push @$code, "Not", "If '$label1'"; 2778 } 2779 $node->[1]->compile; 2780 push @$code, ":$label1"; 2781 } 2782} 2783{ 2784 package SWF::Builder::ActionScript::SyntaxNode::ContinueStatement; 2785 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2786 2787 sub compile { 2788 my $self = shift; 2789 my $code = $self->{stat}{code}; 2790 my $loop = $self->{stat}{loop}; 2791 my $actions; 2792 $actions = $loop->[-1][0] if (defined $loop->[-1]); 2793 $self->_error("Can't \"continue\" outside a loop block ") unless defined $actions; 2794 push @$code, @$actions; 2795 } 2796} 2797{ 2798 package SWF::Builder::ActionScript::SyntaxNode::BreakStatement; 2799 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2800 2801 sub compile { 2802 my $self = shift; 2803 my $code = $self->{stat}{code}; 2804 my $loop = $self->{stat}{loop}; 2805 my $actions; 2806 if (defined $loop->[-1]) { 2807 $actions = $loop->[-1][1]; 2808 $loop->[-1][-1]++; 2809 } 2810 $self->_error("Can't \"break\" outside a loop block ") unless defined $actions; 2811 push @$code, @$actions; 2812 } 2813} 2814 2815{ 2816 package SWF::Builder::ActionScript::SyntaxNode::WhileStatement; 2817 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2818 2819 sub compile { 2820 my $self = shift; 2821 my $stat = $self->{stat}; 2822 my ($cond, $block) = @{$self->{node}}; 2823 my $enter_label = $stat->{label}++; 2824 my $break_label = $stat->{label}++; 2825 my $code = $stat->{code}; 2826 my $loop = $stat->{loop}; 2827 2828 push @$loop, [["Jump '$enter_label'"], ["Jump '$break_label'"], 0 ]; 2829 push @$code, ":$enter_label"; 2830 if ($cond) { 2831 $cond->compile('value'); 2832 push @$code, 'Not', "If '$break_label'"; 2833 } 2834 $block->compile; 2835 push @$code, "Jump '$enter_label'", ":$break_label"; 2836 pop @$loop; 2837 } 2838} 2839{ 2840 package SWF::Builder::ActionScript::SyntaxNode::DoWhileStatement; 2841 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2842 2843 sub compile { 2844 my $self = shift; 2845 my $stat = $self->{stat}; 2846 my ($block, $cond) = @{$self->{node}}; 2847 my $enter_label = $stat->{label}++; 2848 my $cont_label = $stat->{label}++; 2849 my $break_label = $stat->{label}++; 2850 my $code = $stat->{code}; 2851 my $loop = $stat->{loop}; 2852 2853 push @$loop, [["Jump '$cont_label'"], ["Jump '$break_label'"], 0 ]; 2854 push @$code, ":$enter_label"; 2855 $block->compile; 2856 push @$code, ":$cont_label"; 2857 if ($cond) { 2858 $cond->compile('value'); 2859 push @$code, "If '$enter_label'"; 2860 } else { 2861 push @$code, "Jump '$enter_label'"; 2862 } 2863 push @$code, ":$break_label"; 2864 pop @$loop; 2865 } 2866} 2867{ 2868 package SWF::Builder::ActionScript::SyntaxNode::ForEachStatement; 2869 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2870 2871 sub compile { 2872 my $self = shift; 2873 my $stat = $self->{stat}; 2874 my ($var, $obj, $statements) = @{$self->{node}}; 2875 my $loop_out = $stat->{label}++; 2876 my $break_label = $stat->{label}++; 2877 my $cont_label = $stat->{label}++; 2878 my $code = $stat->{code}; 2879 my $loop = $stat->{loop}; 2880 2881 push @$loop, [["Jump '$cont_label'"], ["Jump '$break_label'"], 0]; 2882 2883 $obj->compile('value'); 2884 push @$code, "Enumerate2", ":$cont_label", "StoreRegister '0'", "Push NULL ''", "Equals2", "If '$loop_out'"; 2885 $var->compile('lvalue'); 2886 my $lv = pop @$code; 2887 my @lv = splice(@$code, $lv); 2888 push @$code, "Push Register '0'", @lv; 2889 $statements->compile; 2890 push @$code, "Jump '$cont_label'"; 2891 if ($loop->[-1][-1]>0) { 2892 push @$code, ":$break_label", "Push NULL ''", "Equals2", "Not", "If '$break_label'", ; 2893 } 2894 push @$code, ":$loop_out"; 2895 pop @$loop; 2896 } 2897} 2898 2899{ 2900 package SWF::Builder::ActionScript::SyntaxNode::SwitchStatement; 2901 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2902 2903 sub compile { 2904 my $self = shift; 2905 my $stat = $self->{stat}; 2906 my ($cond, @cases) = @{$self->{node}}; 2907 my $default = pop @cases; 2908 my $break_label = $stat->{label}++; 2909 my $code = $stat->{code}; 2910 my $loop = $stat->{loop}; 2911 2912 push @$loop, [(defined ($loop->[-1]) ? [ "Pop", @{$loop->[-1][0]}] : undef), ["Jump '$break_label'"], 0 ]; 2913 $cond->compile('value'); 2914 for my $case (@cases) { 2915 my $label = $stat->{label}++; 2916 push @$code, "PushDuplicate"; 2917 $case->{node}[0]->compile('value'); 2918 push @$code, "StrictEquals", "If '$label'"; 2919 $case->{label} = $label; 2920 } 2921 my $default_label = $stat->{label}++; 2922 push @$code, "Jump '$default_label'"; 2923 for my $case (@cases) { 2924 push @$code, ":".$case->{label}; 2925 $case->{node}[1]->compile; 2926 } 2927 push @$code, ":$default_label"; 2928 $default->compile if $default; 2929 push @$code, ":$break_label", "Pop"; 2930 pop @$loop; 2931 } 2932} 2933{ 2934 package SWF::Builder::ActionScript::SyntaxNode::CaseClause; 2935 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2936 2937 sub compile { 2938 my $self = shift; 2939 my $stat = $self->{stat}; 2940 my ($cond, $statements) = @{$self->{node}}; 2941 my $label = $stat->{label}; 2942 my $code = $stat->{code}; 2943 2944 push @$code, "dup"; 2945 $cond->compile('value'); 2946 push @$code, "StrictEquals", "Not", "If '$label'"; 2947 if (@$statements) { 2948 $statements->compile; 2949 push @$code, ":$label"; 2950 $stat->{label}++; 2951 } 2952 } 2953} 2954{ 2955 package SWF::Builder::ActionScript::SyntaxNode::ForStatement; 2956 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2957 2958 sub compile { 2959 my $self = shift; 2960 my $stat = $self->{stat}; 2961 my ($init, $cond, $rep, $block) = @{$self->{node}}; 2962 my $enter_label = $stat->{label}++; 2963 my $cont_label = $stat->{label}++; 2964 my $break_label = $stat->{label}++; 2965 my $code = $stat->{code}; 2966 my $loop = $stat->{loop}; 2967 2968 push @$loop, [["Jump '$cont_label'"], ["Jump '$break_label'"]]; 2969 $init->compile if $init; 2970 push @$code, ":$enter_label"; 2971 if ($cond) { 2972 $cond->compile('value'); 2973 push @$code, 'Not'; 2974 push @$code, "If '$break_label'"; 2975 } 2976 $block->compile; 2977 push @$code, ":$cont_label"; 2978 $rep->compile if $rep; 2979 push @$code, "Jump '$enter_label'", ":$break_label"; 2980 pop @$loop; 2981 } 2982} 2983 2984@SWF::Builder::ActionScript::SyntaxNode::FunctionParameter::ISA=('SWF::Builder::ActionScript::SyntaxNode'); 2985{ 2986 package SWF::Builder::ActionScript::SyntaxNode::Function; 2987 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 2988 use constant \%O; 2989 2990 sub compile { 2991 my ($self, $context) = @_; 2992 my $stat = $self->{stat}; 2993 my $code = $stat->{code}; 2994 my $node = $self->{node}; 2995 2996 if ($context and $node->[0]) { 2997 $self->_error('Can\'t declare named function in the expression'); 2998 } elsif(!$context and !$node->[0]) { 2999 $self->_error('Function name is necessary to declare function'); 3000 } 3001 3002 my $label = $stat->{label}++; 3003 my @args = (defined $node->[1]{node}) ? @{$node->[1]{node}} : (); 3004 3005 if ($stat->{Optimize} & O_LOCALREG) { 3006 my $flags = 0; 3007 my $bit = 0; 3008 my $regvars = $self->{regvars}; 3009 for my $prevar (qw/ this arguments super /) { 3010 if (exists $regvars->{$prevar}) { 3011 $flags |= 1<<$bit; 3012 $bit += 2; 3013 } else { 3014 $bit++; 3015 $flags |= 1<<$bit; 3016 $bit++; 3017 } 3018 } 3019 for my $prevar (qw/ _root _parent _global /) { 3020 if (exists $regvars->{$prevar}) { 3021 $flags |= 1<<$bit; 3022 $bit ++; 3023 } 3024 } 3025 for my $arg (@args) { 3026 $arg .= '='.$regvars->{$arg} if exists $regvars->{$arg}; 3027 } 3028 push @$code, "DefineFunction2 '".$node->[0]."' ".join(' ', $regvars->{' regcount'}, $flags, @args, $label); 3029 $node->[2]->compile; 3030 } else { 3031 push @$code, "DefineFunction '".$node->[0]."' ".join(' ', @args, $label); 3032 if (($stat->{Optimize} & O_REGISTER) and (my $regcount = $self->{regvars}{' regcount'}) > 0) { 3033 3034 my $push = 'Push '; 3035 for (1..$regcount) { 3036 $push .= "Register '$_', "; 3037 } 3038 $push =~ s/, $//; 3039 push @$code, $push; 3040 3041 $node->[2]->compile; 3042 3043 for (my $i = $regcount; $i >= 1; $i--) { 3044 push @$code, "StoreRegister '$i'", "Pop"; 3045 } 3046 } else { 3047 $node->[2]->compile; 3048 } 3049 } 3050 push @$code, ":$label"; 3051 } 3052} 3053{ 3054 package SWF::Builder::ActionScript::SyntaxNode::MethodCall; 3055 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 3056 3057 sub compile { 3058 my ($self, $context) = @_; 3059 my $code = $self->{stat}{code}; 3060 my $method = $self->{node}[0]; 3061 3062 if (ref($method)) { 3063 $method->compile('value'); 3064 } else { 3065 if ($method) { 3066 push @$code, "Push String '".$method."'"; 3067 } else { 3068 push @$code, "Push UNDEF ''"; 3069 } 3070 } 3071 push @$code, 'CallMethod'; 3072 push @$code, 'Pop' unless $context; 3073 } 3074} 3075{ 3076 package SWF::Builder::ActionScript::SyntaxNode::CallExpression; 3077 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 3078 3079 sub compile { 3080 my ($self, $context) = @_; 3081 my $code = $self->{stat}{code}; 3082 my $node = $self->{node}; 3083 my ($func, $args, $members, $methods) = @$node; 3084 3085 while (my $callarg = pop @$methods) { 3086 $callarg->compile('value'); 3087 } 3088 3089 { # special function call ? 3090 if (ref($func) =~/:Variable$/) { 3091 my $spf = 'spf_'.lc($func->{node}[0]); 3092 if ($self->can($spf)) { 3093 $self->$spf($args, (@$members == 0 and @$methods == 0) ? $context : 'value'); 3094 last; 3095 } 3096 } 3097 # not special. 3098 $args->compile; 3099 $func->compile('name'); 3100 if (ref($func) =~/:MemberExpression$/) { 3101 push @$code, "CallMethod"; 3102 } else { 3103 push @$code, "CallFunction"; 3104 } 3105 } 3106 unless (@$members) { 3107 push @$code, 'Pop' unless $context; 3108 return; 3109 } 3110 3111 my $last = pop @$members; 3112 3113 for my $member (@$members) { 3114 $member->compile('value'); 3115 } 3116 $last->compile($context); 3117 } 3118 3119 sub _lhs { 3120 my ($name, $args, $members, $methods) = @{shift->{node}}; 3121 3122 if (lc($name->{node}[0]) eq 'eval' and @$members == 0 and @$methods == 0) { 3123 return $name->{stat}{Version}<=5; 3124 } 3125 return (ref($members->[-1])=~/:Member$/); 3126 } 3127 3128 3129 sub spf_call { 3130 my ($self, $args) = @_; 3131 my $code = $self->{stat}{code}; 3132 $self->_error_param('call') if @{$args->{node}} != 1; 3133 3134 $args->{node}[0]->compile('value'); 3135 push @$code, 'Call', "Push UNDEF ''"; 3136 } 3137 3138 sub spf_duplicatemovieclip { 3139 my ($self, $args) = @_; 3140 my $code = $self->{stat}{code}; 3141 $self->_error_param('duplicateMovieClip') if @{$args->{node}} != 3; 3142 my ($target, $name, $depth) = @{$args->{node}}; 3143 3144 $target->compile('value'); 3145 $name->compile('value'); 3146 if (ref($depth)=~/:NumberLiteral$/) { 3147 my $d = $depth->{node}[0] + 16384; 3148 push @$code, "Push Number '$d'"; 3149 } else { 3150 push @$code, "Push Number '16384'"; 3151 $depth->compile('depth'); 3152 push @$code, 'Add2'; 3153 } 3154 push @$code, 'CloneSprite', "Push UNDEF ''"; 3155 } 3156 3157 sub spf_eval { 3158 my ($self, $args, $context) = @_; 3159 my $code = $self->{stat}{code}; 3160 $self->_error_param('eval') if @{$args->{node}} != 1; 3161 $args->{node}[0]->compile('value'); 3162 if ($context eq 'value' or not $context) { 3163 push @$code, 'GetVariable'; 3164 } elsif ($context eq 'lvalue') { 3165 push @$code, 'SetVariable', -1; 3166 } elsif ($context eq 'lcvalue') { 3167 push @$code, 'PushDuplicate', 'GetVariable', 'SetVariable', -1; 3168 } 3169 } 3170 3171 sub spf_set { 3172 my ($self, $args, $context) = @_; 3173 3174 $self->_warn(0, "'set' is not recommended to use."); 3175 3176 my $code = $self->{stat}{code}; 3177 $self->_error_param('eval') if @{$args->{node}} != 2; 3178 $args->{node}[0]->compile('value'); 3179 $args->{node}[1]->compile('value'); 3180 push @$code, "StoreRegister '0'" if $context; 3181 push @$code, 'SetVariable'; 3182 push @$code, "Push Register '0'" if $context; 3183 } 3184 3185 sub spf_fscommand { 3186 my ($self, $args) = @_; 3187 my $code = $self->{stat}{code}; 3188 $self->_error_param("fscommand") if @{$args->{node}} != 2; 3189 my ($command, $param) = @{$args->{node}}; 3190 3191 if ($command->isa('SWF::Builder::ActionScript::SyntaxNode::Literal') and 3192 $param->isa('SWF::Builder::ActionScript::SyntaxNode::Literal')) { 3193 push @$code, "GetURL 'FSCommand:".$command->{node}[0]."' '".$param->{node}[0]."'"; 3194 } else { 3195 if ($command->isa('SWF::Builder::ActionScript::SyntaxNode::Literal')) { 3196 push @$code, "Push String 'FSCommand:".$command->{node}[0]."'"; 3197 } else { 3198 push @$code, "Push String 'FSCommand:'"; 3199 $command->compile('value'); 3200 push @$code, 'StringAdd'; 3201 } 3202 $param->compile('value'); 3203 push @$code, "GetURL2 '0'"; 3204 } 3205 push @$code, "Push UNDEF ''"; 3206 } 3207 3208 sub spf_getproperty { 3209 my ($self, $args) = @_; 3210 my $code = $self->{stat}{code}; 3211 my $target = $args->{node}[0]; 3212 my $property = lc($args->{node}[1]{node}[0]); 3213 3214 $self->_error_param('getProperty') if @{$args->{node}} != 2; 3215 $self->_error("'%s' is not a property identifier.", $property) unless exists $property{$property}; 3216 $self->_warn(0, "'getProperty' is not recommended to use."); 3217 $target->compile('value'); 3218 push @$code, "Push Property '".$property."'", 'GetProperty'; 3219 } 3220 3221 sub spf_setproperty { 3222 my ($self, $args) = @_; 3223 $self->_error_param('setProperty') if @{$args->{node}} != 3; 3224 3225 my $code = $self->{stat}{code}; 3226 my $target = $args->{node}[0]; 3227 my $property = lc($args->{node}[1]{node}[0]); 3228 my $value = $args->{node}[2]; 3229 3230 $self->_error("'%s' is not a property identifier.", $property) unless exists $property{$property}; 3231 $self->_warn(0, "'setProperty' is not recommended to use."); 3232 $target->compile('value'); 3233 push @$code, "Push Property '".$property."'"; 3234 $value->compile('value'); 3235 push @$code, 'SetProperty', "Push UNDEF ''"; 3236 } 3237 3238 sub spf_gettimer { 3239 my ($self, $args) = @_; 3240 my $code = $self->{stat}{code}; 3241 $self->_error_param('getTimer') if @{$args->{node}} != 0; 3242 push @$code, "GetTime"; 3243 } 3244 3245 sub spf_geturl { 3246 my ($self, $args, $context, $fname, $ext) = @_; 3247 my $code = $self->{stat}{code}; 3248 $self->_error_param($fname||'getURL') if @{$args->{node}} > 3 or @{$args->{node}} <= 0; 3249 my ($url, $target, $method) = @{$args->{node}}; 3250 3251 if (!$ext and !defined $method and $url->isa('SWF::Builder::ActionScript::SyntaxNode::Literal') and (!defined $target or $target->isa('SWF::Builder::ActionScript::SyntaxNode::Literal'))) { 3252 $target = $target->{node}[0] if defined $target; 3253 push @$code, "GetURL '".$url->{node}[0]."' '$target'"; 3254 } else { 3255 if (defined $method) { 3256 $self->_error("Third parameter of 'getURL' must be 'GET' or 'POST'.") unless ref($method) =~/:StringLiteral/; 3257 $method = lc($method->{node}[0]); 3258 $self->_error("Third parameter of 'getURL' must be 'GET' or 'POST'.") unless $method eq 'get' or $method eq 'post'; 3259 $method = $method eq 'get' ? 1 : 2; 3260 } else { 3261 $method = 0; 3262 } 3263 $method |= $ext; 3264 $url->compile('value'); 3265 if (defined $target) { 3266 $target->compile('value'); 3267 } else { 3268 push @$code, "Push String ''"; 3269 } 3270 push @$code, "GetURL2 '$method'"; 3271 } 3272 push @$code, "Push UNDEF ''"; 3273 } 3274 3275 sub spf_getversion { 3276 my ($self, $args) = @_; 3277 my $code = $self->{stat}{code}; 3278 $self->_error_param('getVersion') if @{$args->{node}} != 0; 3279 push @$code, "Push String '/:\$version'", 'GetVariable'; 3280 } 3281 3282 sub spf_gotoandplay { 3283 my ($self, $args) = @_; 3284 my $code = $self->{stat}{code}; 3285 $self->_error_param('gotoAndPlay') if @{$args->{node}} > 2 or @{$args->{node}} <= 0; 3286 $self->_error("Scene is not supported.") if @{$args->{node}} == 2; 3287 my $frame = $args->{node}[0]; 3288 3289 if (ref($frame) =~/:NumberLiteral/) { 3290 $frame = int($frame->{node}[0])-1; 3291 $frame = 0 if $frame < 0; 3292 push @$code, "GotoFrame '$frame'", "Play"; 3293 } elsif (ref($frame) =~/:StringLiteral/) { 3294 push @$code, "GotoLabel '".$frame->{node}[0]."'", "Play"; 3295 } else { 3296 $frame->compile('value'); 3297 push @$code, "GotoFrame2 '1'"; 3298 } 3299 push @$code, "Push UNDEF ''"; 3300 } 3301 3302 sub spf_gotoandstop { 3303 my ($self, $args) = @_; 3304 my $code = $self->{stat}{code}; 3305 $self->_error_param('gotoAndStop') if @{$args->{node}} > 2 or @{$args->{node}} <= 0; 3306 $self->_error("Scene is not supported.") if @{$args->{node}} == 2; 3307 my $frame = $args->{node}[0]; 3308 3309 if (ref($frame) =~/:NumberLiteral/) { 3310 $frame = int($frame->{node}[0])-1; 3311 $frame = 0 if $frame < 0; 3312 push @$code, "GotoFrame '$frame'"; 3313 } elsif (ref($frame) =~/:StringLiteral/) { 3314 push @$code, "GotoLabel '".$frame->{node}[0]."'"; 3315 } else { 3316 $frame->compile('value'); 3317 push @$code, "GotoFrame2 '0'"; 3318 } 3319 push @$code, "Push UNDEF ''"; 3320 } 3321 3322 sub spf_loadmovie { 3323 push @_, 'loadMovie', 64; 3324 &spf_geturl; 3325 } 3326 3327 sub spf_unloadmovie { 3328 my ($self, $args) = @_; 3329 3330 unshift @{$args->{node}}, bless {stat=> $self->{stat}, node=>['']}, 'SWF::Builder::ActionScript::SyntaxNode::StringLiteral'; 3331 push @_, 'unloadMovie', 64; 3332 &spf_geturl; 3333 } 3334 3335 sub spf_loadmovienum { 3336 my ($self, $args) = @_; 3337 3338 _level2target($args, 1); 3339 $_[3]='loadMovieNum' unless $_[3];; 3340 &spf_geturl; 3341 } 3342 3343 sub spf_unloadmovienum { 3344 my ($self, $args) = @_; 3345 3346 unshift @{$args->{node}}, bless {stat=> $self->{stat}, node=>['']}, 'SWF::Builder::ActionScript::SyntaxNode::StringLiteral'; 3347 _level2target($args, 1); 3348 $_[3]='unloadMovieNum' unless $_[3];; 3349 &spf_geturl; 3350 } 3351 3352 sub _level2target { 3353 my $args = shift; 3354 my $n = shift; 3355 my $num = $args->{node}[$n]; 3356 3357 if (ref($num)=~/:NumberLiteral/) { 3358 $args->{node}[$n] = bless { 3359 line => $num->{line}, 3360 stat => $num->{stat}, 3361 node => ['_level'.int($num->{node}[0])] 3362 }, 'SWF::Builder::ActionScript::SyntaxNode::StringLiteral'; 3363 } else { 3364 $args->{node}[$n] = bless { 3365 line => $num->{line}, 3366 stat => $num->{stat}, 3367 node => 3368 [ 3369 (bless { 3370 line => $num->{line}, 3371 stat => $num->{stat}, 3372 node => ['_level'] 3373 }, 'SWF::Builder::ActionScript::SyntaxNode::StringLiteral'), 3374 $num, 'add' 3375 ] 3376 }, 'SWF::Builder::ActionScript::SyntaxNode::BinaryOpExpression'; 3377 } 3378 3379 } 3380 3381 sub spf_loadvariables { 3382 push @_, 'loadVariables', 192; 3383 &spf_geturl; 3384 } 3385 3386 sub spf_loadvariablesnum { 3387 push @_, 'loadVariablesNum', 128; 3388 &spf_loadmovienum; 3389 } 3390 3391 sub spf_nextframe { 3392 my ($self, $args) = @_; 3393 my $code = $self->{stat}{code}; 3394 $self->_error_param('nextFrame') if @{$args->{node}} != 0; 3395 push @$code, "NextFrame", "Push UNDEF ''"; 3396 } 3397 3398 sub spf_prevframe { 3399 my ($self, $args) = @_; 3400 my $code = $self->{stat}{code}; 3401 $self->_error_param('prevFrame') if @{$args->{node}} != 0; 3402 push @$code, "PrevFrame", "Push UNDEF ''"; 3403 } 3404 3405 sub spf_nextscene { 3406 shift->_error("Scene is not supported."); 3407 } 3408 3409 sub spf_prevscene { 3410 shift->_error("Scene is not supported."); 3411 } 3412 3413 sub spf_number { 3414 my ($self, $args) = @_; 3415 my $code = $self->{stat}{code}; 3416 $self->_error_param('Number') if @{$args->{node}} != 1; 3417 3418 $args->{node}[0]->compile('value'); 3419 push @$code, 'ToNumber'; 3420 } 3421 sub spf_play { 3422 my ($self, $args) = @_; 3423 my $code = $self->{stat}{code}; 3424 $self->_error_param('play') if @{$args->{node}} != 0; 3425 push @$code, "Play", "Push UNDEF ''"; 3426 } 3427 3428 sub spf_stop { 3429 my ($self, $args) = @_; 3430 my $code = $self->{stat}{code}; 3431 $self->_error_param('stop') if @{$args->{node}} != 0; 3432 push @$code, "Stop", "Push UNDEF ''"; 3433 } 3434 3435 sub spf_print { 3436 my ($self, $args, $context, $scheme) = @_; 3437 $scheme||='print'; 3438 my $code = $self->{stat}{code}; 3439 $self->_error_param($scheme) if @{$args->{node}} != 2; 3440 my ($target, $bbox) = @{$args->{node}}; 3441 3442 $self->_error("Second parameter of '$scheme' must be 'bframe', 'bmax' or 'bmovie'.") unless ref($bbox) =~/:StringLiteral/; 3443 $bbox = lc($bbox->{node}[0]); 3444 $self->_error("Second parameter of '$scheme' must be 'bframe', 'bmax' or 'bmovie'.") unless $bbox eq 'bframe' or $bbox eq 'bmax' or $bbox eq 'bmovie'; 3445 3446 ($scheme = lc($scheme)) =~s/num$//; 3447 if ($bbox eq 'bmovie') { 3448 push @$code, "Push String '$scheme:'"; 3449 } else { 3450 push @$code, "Push String '$scheme:#$bbox'"; 3451 } 3452 $target->compile('value'); 3453 push @$code, "GetURL2 '0'", "Push UNDEF ''"; 3454 } 3455 3456 sub spf_printasbitmap { 3457 push @_, 'printAsBitmap'; 3458 &spf_print; 3459 } 3460 3461 sub spf_printnum { 3462 my ($self, $args) = @_; 3463 3464 _level2target($args,0); 3465 $_[3]='printNum' unless $_[3]; 3466 &spf_print; 3467 } 3468 3469 sub spf_printasbitmapnum { 3470 push @_, 'printAsBitmapNum'; 3471 &spf_printnum; 3472 } 3473 3474 sub spf_removemovieclip { 3475 my ($self, $args) = @_; 3476 my $code = $self->{stat}{code}; 3477 $self->_error_param('removeMovieClip') if @{$args->{node}} != 1; 3478 3479 $args->{node}[0]->compile('value'); 3480 push @$code, 'RemoveSprite', "Push UNDEF ''"; 3481 } 3482 3483 sub spf_startdrag { 3484 my ($self, $args) = @_; 3485 my $code = $self->{stat}{code}; 3486 my $n = @{$args->{node}}; 3487 $self->_error_param('startDrag') unless $n == 1 or $n == 2 or $n == 6; 3488 3489 my $target = shift(@{$args->{node}}); 3490 my $lockcenter = shift(@{$args->{node}}); 3491 3492 if ($n == 6) { 3493 for my $e(@{$args->{node}}) { 3494 $e->compile('value'); 3495 } 3496 push @$code, "Push Boolean '1'"; 3497 } else { 3498 push @$code, "Push Boolean '0'"; 3499 } 3500 if ($n > 1) { 3501 $lockcenter->compile('value'); 3502 } else { 3503 push @$code, "Push Boolean '0'"; 3504 } 3505 $target->compile('value'); 3506 push @$code, 'StartDrag', "Push UNDEF ''"; 3507 } 3508 3509 sub spf_stopallsounds { 3510 my ($self, $args) = @_; 3511 my $code = $self->{stat}{code}; 3512 $self->_error_param('stopAllSounds') if @{$args->{node}} != 0; 3513 push @$code, "StopSounds", "Push UNDEF ''"; 3514 } 3515 3516 sub spf_stopdrag { 3517 my ($self, $args) = @_; 3518 my $code = $self->{stat}{code}; 3519 $self->_error_param('stopDrag') if @{$args->{node}} != 0; 3520 push @$code, 'EndDrag', "Push UNDEF ''"; 3521 } 3522 3523 sub spf_string { 3524 my ($self, $args) = @_; 3525 my $code = $self->{stat}{code}; 3526 $self->_error_param('String') if @{$args->{node}} != 1; 3527 3528 $args->{node}[0]->compile('value'); 3529 push @$code, 'ToString'; 3530 } 3531 3532 sub spf_targetpath { 3533 my ($self, $args) = @_; 3534 my $code = $self->{stat}{code}; 3535 $self->_error_param('targetPath') if @{$args->{node}} != 1; 3536 3537 $args->{node}[0]->compile('value'); 3538 push @$code, 'TargetPath'; 3539 } 3540 3541 sub spf_togglehighquality { 3542 my ($self, $args) = @_; 3543 my $code = $self->{stat}{code}; 3544 $self->_error_param('toggleHighQuality') if @{$args->{node}} != 0; 3545 $self->_warn_not_recommend("'toggleHighQuality'", "'_quality' property"); 3546 push @$code, 'ToggleQuality', "Push UNDEF ''"; 3547 } 3548 3549 sub spf_trace { 3550 my ($self, $args) = @_; 3551 my $code = $self->{stat}{code}; 3552 my $trace = $self->{stat}{Trace}; 3553 $self->_error_param('trace') if @{$args->{node}} != 1; 3554 3555 if ($trace eq 'none') { 3556 push @$code, "Push UNDEF ''"; 3557 return; 3558 } 3559 $args->{node}[0]->compile('value'); 3560 return if $trace eq 'eval'; 3561 if ($trace eq 'lcwin') { 3562 push @$code, "Push String 'trace'", "Push String '__trace'", "Push Number '3'", "Push Number '0'", "Push String 'LocalConnection'", 'NewObject', "Push String 'send'", 'CallMethod'; 3563 } else { 3564 push @$code, "Trace"; 3565 push @$code, "Push UNDEF ''"; 3566 } 3567 3568 } 3569 3570 3571# FLASH4 math/string functions 3572 3573 sub _flash4_fn { 3574 my ($self, $args, $context, $fname, $bytecode, $replace) = @_; 3575 my $code = $self->{stat}{code}; 3576 $self->_error_param($fname) if @{$args->{node}} != 1; 3577 $self->_warn_not_recommend("'$fname'", "'$replace'"); 3578 3579 $args->{node}[0]->compile('value'); 3580 push @$code, $bytecode; 3581 } 3582 3583 sub spf_chr { 3584 push @_, 'chr', 'AsciiToChar', 'String.fromCharCode'; 3585 &_flash4_fn; 3586 } 3587 3588 sub spf_int { 3589 push @_, 'int', 'ToInteger', 'Math.floor/ceil/round'; 3590 &_flash4_fn; 3591 } 3592 3593 sub spf_length { 3594 push @_, 'length', 'StringLength', 'String.length'; 3595 &_flash4_fn; 3596 } 3597 3598 sub spf_mbchr { 3599 push @_, 'mbchr', 'MBAsciiToChar', 'String.fromCharCode'; 3600 &_flash4_fn; 3601 } 3602 3603 sub spf_mblength { 3604 push @_, 'mblength', 'MBStringLength', 'String.length'; 3605 &_flash4_fn; 3606 } 3607 3608 sub spf_mbord { 3609 push @_, 'mbord', 'MBCharToAscii', 'String.charCodeAt'; 3610 &_flash4_fn; 3611 } 3612 3613 sub spf_ord { 3614 push @_, 'ord', 'CharToAscii', 'String.charCodeAt'; 3615 &_flash4_fn; 3616 } 3617 3618 sub spf_random { 3619 push @_, 'random', 'RandomNumber', 'Math.random'; 3620 &_flash4_fn; 3621 } 3622 3623 sub spf_substring { 3624 my ($self, $args) = @_; 3625 my $code = $self->{stat}{code}; 3626 $self->_error_param('substring') if @{$args->{node}} != 3; 3627 $self->_warn_not_recommend("'substring'", "'String.substr'"); 3628 3629 for my $a (@{$args->{node}}) { 3630 $a->compile('value'); 3631 } 3632 push @$code, 'StringExtract'; 3633 } 3634 3635 sub spf_mbsubstring { 3636 my ($self, $args) = @_; 3637 my $code = $self->{stat}{code}; 3638 $self->_error_param('mbsubstring') if @{$args->{node}} != 3; 3639 $self->_warn_not_recommend("'mbsubstring'", "'String.substr'"); 3640 3641 for my $a (@{$args->{node}}) { 3642 $a->compile('value'); 3643 } 3644 push @$code, 'MBStringExtract'; 3645 } 3646 3647 3648} 3649 3650{ 3651 package SWF::Builder::ActionScript::SyntaxNode::NewExpression; 3652 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 3653 3654 sub compile { 3655 my $self = shift; 3656 my $code = $self->{stat}{code}; 3657 my $node = $self->{node}; 3658 my $func = shift @$node; 3659 my $args = shift @$node; 3660 3661 $args->compile; 3662 $func->compile('name'); 3663 if ($func->isa('SWF::Builder::ActionScript::SyntaxNode::MemberExpression')) { 3664 push @$code, "NewMethod"; 3665 } else { 3666 push @$code, "NewObject"; 3667 } 3668 } 3669} 3670 3671{ 3672 package SWF::Builder::ActionScript::SyntaxNode::Arguments; 3673 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 3674 3675 sub compile { 3676 my $self = shift; 3677 my $node = $self->{node}; 3678 3679 for my $s (reverse @$node) { 3680 $s->compile('value'); 3681 } 3682 push @{$self->{stat}{code}}, "Push Number '".@$node."'"; 3683 } 3684} 3685 3686{ 3687 package SWF::Builder::ActionScript::SyntaxNode::PrefixExpression; 3688 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 3689 3690 sub compile { 3691 my ($self, $context) = @_; 3692 my $code = $self->{stat}{code}; 3693 3694 $self->{node}[0]->compile('lcvalue'); 3695 my $lv = pop @$code; 3696 my @lv = splice(@$code, $lv); 3697 push @$code, $self->{node}[1] eq '++' ? 'Increment' : 'Decrement'; 3698 push @$code, "StoreRegister '0'" if $context; 3699 push @$code, @lv; 3700 push @$code, "Push Register '0'" if $context; 3701 } 3702} 3703 3704{ 3705 package SWF::Builder::ActionScript::SyntaxNode::PostfixExpression; 3706 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 3707 3708 sub compile { 3709 my ($self, $context) = @_; 3710 my $code = $self->{stat}{code}; 3711 3712 $self->{node}[0]->compile('lcvalue'); 3713 my $lv = pop @$code; 3714 my @lv = splice(@$code, $lv); 3715 push @$code, "StoreRegister '0'" if $context; 3716 push @$code, $self->{node}[1] eq '++' ? 'Increment' : 'Decrement'; 3717 push @$code, @lv; 3718 push @$code, "Push Register '0'" if $context; 3719 } 3720} 3721 3722{ 3723 package SWF::Builder::ActionScript::SyntaxNode::UnaryExpression; 3724 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 3725 3726 my %unary_op = ( 3727 'void' => ['Pop', "Push UNDEF ''"], 3728 'typeof' => ['TypeOf'], 3729 '-' => ['Subtract'], 3730 '~' => ["Push Number '4294967295'", 'BitXor'], 3731 '!' => ['Not'], 3732 ); 3733 3734 sub compile { 3735 my ($self, $context) = @_; 3736 my ($e, $op) = @{$self->{node}}; 3737 my $code = $self->{stat}{code}; 3738 3739 push @$code, "Push Number '0'" if ($op eq '-' and $context); 3740 $e->compile($context); 3741 push @$code, @{$unary_op{$op}} if ($op ne '+' and $context); 3742 } 3743} 3744{ 3745 package SWF::Builder::ActionScript::SyntaxNode::DeleteExpression; 3746 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 3747 3748 sub compile { 3749 my ($self, $context) = @_; 3750 my $code = $self->{stat}{code}; 3751 3752 $self->{node}[0]->compile('name'); 3753 if ($self->{node}[0]->isa('SWF::Builder::ActionScript::SyntaxNode::MemberExpression')) { 3754 push @$code, "Delete"; 3755 } else { 3756 push @$code, "Delete2"; 3757 } 3758 push @$code, "Pop" unless $context; 3759 } 3760} 3761 3762{ 3763 package SWF::Builder::ActionScript::SyntaxNode::IfFrameLoadedStatement; 3764 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 3765 3766 sub compile { 3767 my $self = shift; 3768 my $code = $self->{stat}{code}; 3769 my $node = $self->{node}; 3770 my $label = $self->{stat}{label}++; 3771 my $e = $node->[0]; 3772 3773 if (ref($e) =~ /NumberLiteral$/ and $e->{node}[0] =~ /^\d+$/) { 3774 push @$code, "WaitForFrame '".$e->{node}[0]."' '$label'"; 3775 } else { 3776 $e->compile('value'); 3777 push @$code, "WaitForFrame2 '$label'"; 3778 } 3779 $node->[1]->compile; 3780 push @$code, ":$label"; 3781 } 3782} 3783{ 3784 package SWF::Builder::ActionScript::SyntaxNode::TellTargetStatement; 3785 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 3786 3787 sub compile { 3788 my $self = shift; 3789 my $code = $self->{stat}{code}; 3790 my $node = $self->{node}; 3791 my $e = $node->[0]; 3792 my $refe = ref($e); 3793 3794 if ($refe =~ /StringLiteral$/) { 3795 push @$code, "SetTarget '".$e->{node}[0]."'"; 3796 } else { 3797 $e->compile('value'); 3798 push @$code, "SetTarget2"; 3799 } 3800 $node->[1]->compile; 3801 push @$code, "SetTarget ''"; 3802 } 3803} 3804 3805{ 3806 package SWF::Builder::ActionScript::SyntaxNode::WithStatement; 3807 our @ISA = ('SWF::Builder::ActionScript::SyntaxNode'); 3808 3809 sub compile { 3810 my $self = shift; 3811 my $code = $self->{stat}{code}; 3812 my $node = $self->{node}; 3813 my $label = $self->{stat}{label}++; 3814 3815 $node->[0]->compile('value'); 3816 push @$code, "With '$label'"; 3817 $node->[1]->compile; 3818 push @$code, ":$label"; 3819 } 3820} 3821 38221; 3823