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