File Coverage

blib/lib/WAP/wmls/optim.pm
Criterion Covered Total %
statement 18 806 2.2
branch 0 656 0.0
condition 0 162 0.0
subroutine 6 38 15.7
pod 0 30 0.0
total 24 1692 1.4


line stmt bran cond sub pod time code
1            
2             package WAP::wmls::parser;
3            
4 1     1   6 use strict;
  1         1  
  1         39  
5 1     1   5 use warnings;
  1         1  
  1         30  
6 1     1   5 use bigint;
  1         2  
  1         8  
7 1     1   948 use bignum;
  1         2  
  1         10  
8            
9 1     1   1248 use Carp;
  1         2  
  1         125  
10            
11             my $OneMoreTime;
12             my $OneMoreExpr;
13            
14             sub optWarning {
15 0     0 0   my $parser = shift;
16 0           my ($node, $msg) = @_;
17            
18 0   0       $msg ||= ".\n";
19            
20 0 0         if (exists $parser->YYData->{nb_warning}) {
21 0           $parser->YYData->{nb_warning} ++;
22             }
23             else {
24 0           $parser->YYData->{nb_warning} = 1;
25             }
26            
27 0 0 0       print STDOUT '#',$parser->YYData->{filename},':',$node->{OpCode}->{Lineno},'#Warning: ',$msg
28             if ( exists $parser->YYData->{verbose_warning}
29             and $parser->YYData->{verbose_warning});
30 0           return;
31             }
32            
33             sub optInfo {
34 0     0 0   my $parser = shift;
35 0           my ($node, $msg) = @_;
36            
37 0   0       $msg ||= ".\n";
38            
39 0 0         if (exists $parser->YYData->{nb_info}) {
40 0           $parser->YYData->{nb_info} ++;
41             } else {
42 0           $parser->YYData->{nb_info} = 1;
43             }
44            
45 0 0 0       print STDOUT '#',$parser->YYData->{filename},':',$node->{OpCode}->{Lineno},'#Info: ',$msg
46             if ( exists $parser->YYData->{verbose_info}
47             and $parser->YYData->{verbose_info});
48 0           return;
49             }
50            
51             sub optDebug {
52 0     0 0   my $parser = shift;
53 0           my ($node, $msg) = @_;
54            
55 0   0       $msg ||= ".\n";
56            
57 0 0 0       print STDOUT '#',$parser->YYData->{filename},':',$node->{OpCode}->{Lineno},'#Debug: ',$msg
58             if ( exists $parser->YYData->{verbose_debug}
59             and $parser->YYData->{verbose_debug});
60 0           return;
61             }
62            
63             sub checkRangeInteger {
64 0     0 0   my $parser = shift;
65 0           my ($opcode) = @_;
66 0           my $value = $opcode->{Value};
67 0 0 0       if ($value > 2147483647 or $value < -2147483648) {
68 0           $parser->Error("Integer $value is out of range.\n");
69 0           $opcode->{TypeDef} = 'TYPE_INVALID';
70             }
71 0           return;
72             }
73            
74             sub checkRangeFloat {
75 0     0 0   my $parser = shift;
76 0           my ($opcode) = @_;
77 0           my $value = $opcode->{Value};
78 0           my $abs_v = abs $value;
79 0 0         if ($abs_v > 3.40282347e+38) {
    0          
80 0           $parser->Error("Float $value is out of range.\n");
81 0           $opcode->{TypeDef} = 'TYPE_INVALID';
82             }
83             elsif ($abs_v < 1.17549435e-38) {
84 0           $parser->Warning("Float $value is underflow.\n");
85 0           $opcode->{Value} = 0.0;
86             }
87 0           return;
88             }
89            
90             sub evalUnopInteger {
91 0     0 0   my $parser = shift;
92 0           my ($op, $cst) = @_;
93 0           my $opcode = $cst->{OpCode};
94 0           my $oper = $op->{OpCode}->{Operator};
95 0 0         if ($oper eq 'typeof') {
    0          
    0          
    0          
    0          
    0          
    0          
96 0           $opcode->{TypeDef} = 'TYPE_INTEGER';
97 0           $opcode->{Value} = 0;
98 0           $op->del();
99 0           $OneMoreExpr = 1;
100             }
101             elsif ($oper eq 'isvalid') {
102 0           $opcode->{TypeDef} = 'TYPE_BOOLEAN';
103 0           $opcode->{Value} = 1;
104 0           $op->del();
105 0           $OneMoreExpr = 1;
106             }
107             elsif ($oper eq '-') {
108 0           $opcode->{Value} = - $opcode->{Value};
109 0           $parser->checkRangeInteger($opcode);
110 0           $op->del();
111 0           $OneMoreExpr = 1;
112             }
113             elsif ($oper eq '~') {
114 0           $opcode->{Value} = ~ $opcode->{Value};
115 0           $parser->checkRangeInteger($opcode);
116 0           $op->del();
117 0           $OneMoreExpr = 1;
118             }
119             elsif ($oper eq '!') {
120 0 0         $opcode->{Value} = ($opcode->{Value}) ? 0 : 1;
121 0           $opcode->{TypeDef} = 'TYPE_BOOLEAN';
122 0           $op->del();
123 0           $OneMoreExpr = 1;
124             }
125             elsif ($oper eq '++') {
126 0           $opcode->{Value} ++;
127 0           $parser->checkRangeInteger($opcode);
128 0           $op->del();
129 0           $OneMoreExpr = 1;
130             }
131             elsif ($oper eq '--') {
132 0           $opcode->{Value} --;
133 0           $parser->checkRangeInteger($opcode);
134 0           $op->del();
135 0           $OneMoreExpr = 1;
136             }
137             else {
138 0           croak "INTERNAL ERROR evalUnopInteger (op:$oper)\n";
139             }
140 0           return;
141             }
142            
143             sub evalUnopFloat {
144 0     0 0   my $parser = shift;
145 0           my ($op, $cst) = @_;
146 0           my $opcode = $cst->{OpCode};
147 0           my $oper = $op->{OpCode}->{Operator};
148 0 0         if ($oper eq 'typeof') {
    0          
    0          
    0          
    0          
    0          
    0          
149             # if (interpreter supports float)
150             # integer(1)
151             # else
152             # invalid
153             }
154             elsif ($oper eq 'isvalid') {
155             # if (interpreter supports float)
156             # boolean(true)
157             # else
158             # invalid
159             }
160             elsif ($oper eq '-') {
161 0           $opcode->{Value} = - $opcode->{Value};
162 0           $parser->checkRangeFloat($opcode);
163 0           $op->del();
164 0           $OneMoreExpr = 1;
165             }
166             elsif ($oper eq '~') {
167             }
168             elsif ($oper eq '!') {
169             # if (interpreter supports float)
170             # boolean
171             # else
172             # invalid
173             }
174             elsif ($oper eq '++') {
175 0           $opcode->{Value} ++;
176 0           $parser->checkRangeFloat($opcode);
177 0           $op->del();
178 0           $OneMoreExpr = 1;
179             }
180             elsif ($oper eq '--') {
181 0           $opcode->{Value} --;
182 0           $parser->checkRangeFloat($opcode);
183 0           $op->del();
184 0           $OneMoreExpr = 1;
185             }
186             else {
187 0           croak "INTERNAL ERROR evalUnopFloat (op:$oper)\n";
188             }
189 0           return;
190             }
191            
192             sub evalUnopString {
193 0     0 0   my $parser = shift;
194 0           my ($op, $cst) = @_;
195 0           my $opcode = $cst->{OpCode};
196 0           my $oper = $op->{OpCode}->{Operator};
197 0 0         if ($oper eq 'typeof') {
    0          
    0          
    0          
    0          
    0          
    0          
198 0           $opcode->{TypeDef} = 'TYPE_INTEGER';
199 0           $opcode->{Value} = 2;
200 0           $op->del();
201 0           $OneMoreExpr = 1;
202             }
203             elsif ($oper eq 'isvalid') {
204 0           $opcode->{TypeDef} = 'TYPE_BOOLEAN';
205 0           $opcode->{Value} = 1;
206 0           $op->del();
207 0           $OneMoreExpr = 1;
208             }
209             elsif ($oper eq '-') {
210             }
211             elsif ($oper eq '~') {
212             }
213             elsif ($oper eq '!') {
214 0 0         $opcode->{Value} = (length $opcode->{Value}) ? 0 : 1;
215 0           $opcode->{TypeDef} = 'TYPE_BOOLEAN';
216 0           $op->del();
217 0           $OneMoreExpr = 1;
218             }
219             elsif ($oper eq '++') {
220             }
221             elsif ($oper eq '--') {
222             }
223             else {
224 0           croak "INTERNAL ERROR evalUnopString (op:$oper)\n";
225             }
226 0           return;
227             }
228            
229             sub evalUnopBoolean {
230 0     0 0   my $parser = shift;
231 0           my ($op, $cst) = @_;
232 0           my $opcode = $cst->{OpCode};
233 0           my $oper = $op->{OpCode}->{Operator};
234 0 0         if ($oper eq 'typeof') {
    0          
    0          
    0          
    0          
    0          
    0          
235 0           $opcode->{TypeDef} = 'TYPE_INTEGER';
236 0           $opcode->{Value} = 3;
237 0           $op->del();
238 0           $OneMoreExpr = 1;
239             }
240             elsif ($oper eq 'isvalid') {
241 0           $opcode->{Value} = 1;
242 0           $op->del();
243 0           $OneMoreExpr = 1;
244             }
245             elsif ($oper eq '-') {
246             }
247             elsif ($oper eq '~') {
248             }
249             elsif ($oper eq '!') {
250 0 0         $opcode->{Value} = ($opcode->{Value}) ? 0 : 1;
251 0           $op->del();
252 0           $OneMoreExpr = 1;
253             }
254             elsif ($oper eq '++') {
255             }
256             elsif ($oper eq '--') {
257             }
258             else {
259 0           croak "INTERNAL ERROR evalUnopBoolean (op:$oper)\n";
260             }
261 0           return;
262             }
263            
264             sub evalUnopInvalid {
265 0     0 0   my $parser = shift;
266 0           my ($op, $cst) = @_;
267 0           my $opcode = $cst->{OpCode};
268 0           my $oper = $op->{OpCode}->{Operator};
269 0 0         if ($oper eq 'typeof') {
    0          
    0          
    0          
    0          
    0          
    0          
270 0           $opcode->{TypeDef} = 'TYPE_INTEGER';
271 0           $opcode->{Value} = 4;
272 0           $op->del();
273 0           $OneMoreExpr = 1;
274             }
275             elsif ($oper eq 'isvalid') {
276 0           $opcode->{TypeDef} = 'TYPE_BOOLEAN';
277 0           $opcode->{Value} = 0;
278 0           $op->del();
279 0           $OneMoreExpr = 1;
280             }
281             elsif ($oper eq '-') {
282 0           $op->del();
283 0           $OneMoreExpr = 1;
284             }
285             elsif ($oper eq '~') {
286 0           $op->del();
287 0           $OneMoreExpr = 1;
288             }
289             elsif ($oper eq '!') {
290 0           $op->del();
291 0           $OneMoreExpr = 1;
292             }
293             elsif ($oper eq '++') {
294 0           $op->del();
295 0           $OneMoreExpr = 1;
296             }
297             elsif ($oper eq '--') {
298 0           $op->del();
299 0           $OneMoreExpr = 1;
300             }
301             else {
302 0           croak "INTERNAL ERROR evalUnopInvalid (op:$oper)\n";
303             }
304 0           return;
305             }
306            
307             sub evalBinopInteger {
308 0     0 0   my $parser = shift;
309 0           my ($op, $left, $right) = @_;
310 0           my $oper = $op->{OpCode}->{Operator};
311 0 0         if ($oper eq '+') {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
312 0           $left->{OpCode}->{Value} += $right->{OpCode}->{Value};
313 0           $parser->checkRangeInteger($left->{OpCode});
314 0           $right->del();
315 0           $op->del();
316 0           $OneMoreExpr = 1;
317             }
318             elsif ($oper eq '-') {
319 0           $left->{OpCode}->{Value} -= $right->{OpCode}->{Value};
320 0           $parser->checkRangeInteger($left->{OpCode});
321 0           $right->del();
322 0           $op->del();
323 0           $OneMoreExpr = 1;
324             }
325             elsif ($oper eq '*') {
326 0           $left->{OpCode}->{Value} *= $right->{OpCode}->{Value};
327 0           $parser->checkRangeInteger($left->{OpCode});
328 0           $right->del();
329 0           $op->del();
330 0           $OneMoreExpr = 1;
331             }
332             elsif ($oper eq '/') {
333 0 0         if ($right->{OpCode}->{Value} == 0) {
334 0           $left->{OpCode}->{TypeDef} = 'TYPE_INVALID';
335 0           delete $left->{OpCode}->{Value};
336 0           $parser->optWarning($op, "Division by zero.\n");
337 0           $right->del();
338 0           $op->del();
339 0           $OneMoreExpr = 1;
340             }
341             }
342             elsif ($oper eq 'div') {
343 0 0         if ($right->{OpCode}->{Value} == 0) {
344 0           $left->{OpCode}->{TypeDef} = 'TYPE_INVALID';
345 0           delete $left->{OpCode}->{Value};
346 0           $parser->optWarning($op, "Integer division by zero.\n");
347             }
348             else {
349 1     1   4881 use integer;
  1         2  
  1         8  
350 0           $left->{OpCode}->{Value} /= $right->{OpCode}->{Value};
351 0           $parser->checkRangeInteger($left->{OpCode});
352             }
353 0           $right->del();
354 0           $op->del();
355 0           $OneMoreExpr = 1;
356             }
357             elsif ($oper eq '%') {
358 0 0         if ($right->{OpCode}->{Value} == 0) {
359 0           $left->{OpCode}->{TypeDef} = 'TYPE_INVALID';
360 0           delete $left->{OpCode}->{Value};
361 0           $parser->optWarning($op, "Reminder by zero.\n");
362             }
363             else {
364 0           $left->{OpCode}->{Value} %= $right->{OpCode}->{Value};
365 0           $parser->checkRangeInteger($left->{OpCode});
366             }
367 0           $right->del();
368 0           $op->del();
369 0           $OneMoreExpr = 1;
370             }
371             elsif ($oper eq '<<') {
372 0           $left->{OpCode}->{Value} <<= $right->{OpCode}->{Value};
373 0           $parser->checkRangeInteger($left->{OpCode});
374 0           $right->del();
375 0           $op->del();
376 0           $OneMoreExpr = 1;
377             }
378             elsif ($oper eq '>>') {
379 0           $left->{OpCode}->{Value} >>= $right->{OpCode}->{Value};
380 0           $parser->checkRangeInteger($left->{OpCode});
381 0           $right->del();
382 0           $op->del();
383 0           $OneMoreExpr = 1;
384             }
385             elsif ($oper eq '>>>') {
386 0           my $bit = $left->{OpCode}->{Value} & 0x80000000;
387 0           $left->{OpCode}->{Value} >>= $right->{OpCode}->{Value};
388 0           $left->{OpCode}->{Value} |= $bit;
389 0           $parser->checkRangeInteger($left->{OpCode});
390 0           $right->del();
391 0           $op->del();
392 0           $OneMoreExpr = 1;
393             }
394             elsif ($oper eq '<') {
395 0 0         $left->{OpCode}->{Value} = ($left->{OpCode}->{Value} < $right->{OpCode}->{Value}) ? 1 : 0;
396 0           $left->{OpCode}->{TypeDef} = 'TYPE_BOOLEAN';
397 0           $right->del();
398 0           $op->del();
399 0           $OneMoreExpr = 1;
400             }
401             elsif ($oper eq '>') {
402 0 0         $left->{OpCode}->{Value} = ($left->{OpCode}->{Value} > $right->{OpCode}->{Value}) ? 1 : 0;
403 0           $left->{OpCode}->{TypeDef} = 'TYPE_BOOLEAN';
404 0           $right->del();
405 0           $op->del();
406 0           $OneMoreExpr = 1;
407             }
408             elsif ($oper eq '<=') {
409 0 0         $left->{OpCode}->{Value} = ($left->{OpCode}->{Value} <= $right->{OpCode}->{Value}) ? 1 : 0;
410 0           $left->{OpCode}->{TypeDef} = 'TYPE_BOOLEAN';
411 0           $right->del();
412 0           $op->del();
413 0           $OneMoreExpr = 1;
414             }
415             elsif ($oper eq '>=') {
416 0 0         $left->{OpCode}->{Value} = ($left->{OpCode}->{Value} >= $right->{OpCode}->{Value}) ? 1 : 0;
417 0           $left->{OpCode}->{TypeDef} = 'TYPE_BOOLEAN';
418 0           $right->del();
419 0           $op->del();
420 0           $OneMoreExpr = 1;
421             }
422             elsif ($oper eq '==') {
423 0 0         $left->{OpCode}->{Value} = ($left->{OpCode}->{Value} == $right->{OpCode}->{Value}) ? 1 : 0;
424 0           $left->{OpCode}->{TypeDef} = 'TYPE_BOOLEAN';
425 0           $right->del();
426 0           $op->del();
427 0           $OneMoreExpr = 1;
428             }
429             elsif ($oper eq '!=') {
430 0 0         $left->{OpCode}->{Value} = ($left->{OpCode}->{Value} != $right->{OpCode}->{Value}) ? 1 : 0;
431 0           $left->{OpCode}->{TypeDef} = 'TYPE_BOOLEAN';
432 0           $right->del();
433 0           $op->del();
434 0           $OneMoreExpr = 1;
435             }
436             elsif ($oper eq '&') {
437 0           $left->{OpCode}->{Value} &= $right->{OpCode}->{Value};
438 0           $parser->checkRangeInteger($left->{OpCode});
439 0           $right->del();
440 0           $op->del();
441 0           $OneMoreExpr = 1;
442             }
443             elsif ($oper eq '^') {
444 0           $left->{OpCode}->{Value} ^= $right->{OpCode}->{Value};
445 0           $parser->checkRangeInteger($left->{OpCode});
446 0           $right->del();
447 0           $op->del();
448 0           $OneMoreExpr = 1;
449             }
450             elsif ($oper eq '|') {
451 0           $left->{OpCode}->{Value} |= $right->{OpCode}->{Value};
452 0           $parser->checkRangeInteger($left->{OpCode});
453 0           $right->del();
454 0           $op->del();
455 0           $OneMoreExpr = 1;
456             }
457             else {
458 0           croak "INTERNAL ERROR evalBinopInteger (oper:$oper)\n";
459             }
460 0           return;
461             }
462            
463             sub evalBinopFloat {
464 0     0 0   my $parser = shift;
465 0           my ($op, $left, $right) = @_;
466 0           my $oper = $op->{OpCode}->{Operator};
467 0 0         if ($oper eq '+') {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
468 0           $left->{OpCode}->{Value} += $right->{OpCode}->{Value};
469 0           $parser->checkRangeFloat($left->{OpCode});
470 0           $right->del();
471 0           $op->del();
472 0           $OneMoreExpr = 1;
473             }
474             elsif ($oper eq '-') {
475 0           $left->{OpCode}->{Value} -= $right->{OpCode}->{Value};
476 0           $parser->checkRangeFloat($left->{OpCode});
477 0           $right->del();
478 0           $op->del();
479 0           $OneMoreExpr = 1;
480             }
481             elsif ($oper eq '*') {
482 0           $left->{OpCode}->{Value} *= $right->{OpCode}->{Value};
483 0           $parser->checkRangeFloat($left->{OpCode});
484 0           $right->del();
485 0           $op->del();
486 0           $OneMoreExpr = 1;
487             }
488             elsif ($oper eq '/') {
489 0 0         if ($right->{OpCode}->{Value} == 0) {
490 0           $left->{OpCode}->{TypeDef} = 'TYPE_INVALID';
491 0           delete $left->{OpCode}->{Value};
492 0           $parser->optWarning($op, "Division by zero.\n");
493             }
494             else {
495 0           $left->{OpCode}->{Value} /= $right->{OpCode}->{Value};
496 0           $parser->checkRangeFloat($left->{OpCode});
497             }
498 0           $right->del();
499 0           $op->del();
500 0           $OneMoreExpr = 1;
501             }
502             elsif ($oper eq 'div') {
503             }
504             elsif ($oper eq '%') {
505             }
506             elsif ($oper eq '<<') {
507             }
508             elsif ($oper eq '>>') {
509             }
510             elsif ($oper eq '>>>') {
511             }
512             elsif ($oper eq '<') {
513             }
514             elsif ($oper eq '>') {
515             }
516             elsif ($oper eq '<=') {
517             }
518             elsif ($oper eq '>=') {
519             }
520             elsif ($oper eq '==') {
521             }
522             elsif ($oper eq '!=') {
523             }
524             elsif ($oper eq '&') {
525             }
526             elsif ($oper eq '^') {
527             }
528             elsif ($oper eq '|') {
529             }
530             else {
531 0           croak "INTERNAL ERROR evalBinopFloat (oper:$oper)\n";
532             }
533 0           return;
534             }
535            
536             sub optIdtLeftInteger {
537 0     0 0   my $parser = shift;
538 0           my ($op, $left, $right) = @_;
539 0           my $val = $left->{OpCode}->{Value};
540 0           my $oper = $op->{OpCode}->{Operator};
541 0 0         if ($val == 0) {
    0          
    0          
542 0 0         if ($oper eq '+') {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
543 0           $op->del();
544 0           $left->del();
545 0           $OneMoreExpr = 1;
546             }
547             elsif ($oper eq '-') {
548 0           $left->del();
549 0           bless($op->{OpCode}, 'UnaryOp');
550 0           $OneMoreExpr = 1;
551             }
552             elsif ($oper eq '*') {
553 0           $op->del();
554 0           $right->insert(new Pop($parser));
555 0           $OneMoreExpr = 1;
556             }
557             elsif ($oper eq '/') {
558             }
559             elsif ($oper eq 'div') {
560 0           $op->del();
561 0           $right->insert(new Pop($parser));
562 0           $OneMoreExpr = 1;
563             }
564             elsif ($oper eq '%') {
565 0           $op->del();
566 0           $right->insert(new Pop($parser));
567 0           $OneMoreExpr = 1;
568             }
569             elsif ($oper eq '<<') {
570 0           $op->del();
571 0           $op->insert(new Pop($parser));
572 0           $OneMoreExpr = 1;
573             }
574             elsif ($oper eq '>>') {
575 0           $op->del();
576 0           $op->insert(new Pop($parser));
577 0           $OneMoreExpr = 1;
578             }
579             elsif ($oper eq '>>>') {
580 0           $op->del();
581 0           $op->insert(new Pop($parser));
582 0           $OneMoreExpr = 1;
583             }
584             elsif ($oper eq '<') {
585             }
586             elsif ($oper eq '>') {
587             }
588             elsif ($oper eq '<=') {
589             }
590             elsif ($oper eq '>=') {
591             }
592             elsif ($oper eq '==') {
593             }
594             elsif ($oper eq '!=') {
595             }
596             elsif ($oper eq '&') {
597 0           $op->del();
598 0           $right->insert(new Pop($parser));
599 0           $OneMoreExpr = 1;
600             }
601             elsif ($oper eq '^') {
602 0           $op->del();
603 0           $left->del();
604 0           $OneMoreExpr = 1;
605             }
606             elsif ($oper eq '|') {
607 0           $op->del();
608 0           $left->del();
609 0           $OneMoreExpr = 1;
610             }
611             else {
612 0           croak "INTERNAL ERROR optIdtLeftInteger (oper:$oper)\n";
613             }
614             }
615             elsif ($val == 1) {
616 0 0         if ($oper eq '+') {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
617 0           $left->del();
618 0           bless($op->{OpCode}, 'UnaryOp');
619 0           $op->{OpCode}->{Operator} = '++';
620 0           $OneMoreExpr = 1;
621             }
622             elsif ($oper eq '-') {
623             }
624             elsif ($oper eq '*') {
625 0           $left->del();
626 0           $op->del();
627 0           $OneMoreExpr = 1;
628             }
629             elsif ($oper eq '/') {
630             }
631             elsif ($oper eq 'div') {
632             }
633             elsif ($oper eq '%') {
634             }
635             elsif ($oper eq '<<') {
636             }
637             elsif ($oper eq '>>') {
638             }
639             elsif ($oper eq '>>>') {
640             }
641             elsif ($oper eq '<') {
642             }
643             elsif ($oper eq '>') {
644             }
645             elsif ($oper eq '<=') {
646             }
647             elsif ($oper eq '>=') {
648             }
649             elsif ($oper eq '==') {
650             }
651             elsif ($oper eq '!=') {
652             }
653             elsif ($oper eq '&') {
654             }
655             elsif ($oper eq '^') {
656             }
657             elsif ($oper eq '|') {
658             }
659             else {
660 0           croak "INTERNAL ERROR optIdtLeftInteger (oper:$oper)\n";
661             }
662             }
663             elsif ($val == -1) {
664 0 0         if ($oper eq '+') {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
665 0           $left->del();
666 0           bless($op->{OpCode}, 'UnaryOp');
667 0           $op->{OpCode}->{Operator} = '--';
668 0           $OneMoreExpr = 1;
669             }
670             elsif ($oper eq '-') {
671             }
672             elsif ($oper eq '*') {
673 0           $left->del();
674 0           bless($op->{OpCode}, 'UnaryOp');
675 0           $op->{OpCode}->{Operator} = '-';
676 0           $OneMoreExpr = 1;
677             }
678             elsif ($oper eq '/') {
679             }
680             elsif ($oper eq 'div') {
681             }
682             elsif ($oper eq '%') {
683             }
684             elsif ($oper eq '<<') {
685             }
686             elsif ($oper eq '>>') {
687             }
688             elsif ($oper eq '>>>') {
689             }
690             elsif ($oper eq '<') {
691             }
692             elsif ($oper eq '>') {
693             }
694             elsif ($oper eq '<=') {
695             }
696             elsif ($oper eq '>=') {
697             }
698             elsif ($oper eq '==') {
699             }
700             elsif ($oper eq '!=') {
701             }
702             elsif ($oper eq '&') {
703             }
704             elsif ($oper eq '^') {
705             }
706             elsif ($oper eq '|') {
707             }
708             else {
709 0           croak "INTERNAL ERROR optIdtLeftInteger (oper:$oper)\n";
710             }
711             }
712 0           return;
713             }
714            
715             sub optIdtRightInteger {
716 0     0 0   my $parser = shift;
717 0           my ($op, $left, $right) = @_;
718 0           my $val = $right->{OpCode}->{Value};
719 0           my $oper = $op->{OpCode}->{Operator};
720 0 0         if ($val == 0) {
    0          
    0          
721 0 0         if ($oper eq '+') {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
722 0           $op->del();
723 0           $right->del();
724 0           $OneMoreExpr = 1;
725             }
726             elsif ($oper eq '-') {
727 0           $op->del();
728 0           $right->del();
729 0           $OneMoreExpr = 1;
730             }
731             elsif ($oper eq '*') {
732 0           $op->del();
733 0           $left->insert(new Pop($parser));
734 0           $OneMoreExpr = 1;
735             }
736             elsif ($oper eq '/') {
737 0           $op->del();
738 0           $left->insert(new Pop($parser));
739 0           $right->{OpCode}->{TypeDef} = 'TYPE_INVALID';
740 0           $OneMoreExpr = 1;
741 0           $parser->optWarning($op, "Division by zero.\n");
742             }
743             elsif ($oper eq 'div') {
744 0           $op->del();
745 0           $left->insert(new Pop($parser));
746 0           $right->{OpCode}->{TypeDef} = 'TYPE_INVALID';
747 0           $OneMoreExpr = 1;
748 0           $parser->optWarning($op, "Integer division by zero.\n");
749             }
750             elsif ($oper eq '%') {
751 0           $op->del();
752 0           $left->insert(new Pop($parser));
753 0           $right->{OpCode}->{TypeDef} = 'TYPE_INVALID';
754 0           $OneMoreExpr = 1;
755 0           $parser->optWarning($op, "Reminder by zero.\n");
756             }
757             elsif ($oper eq '<<') {
758 0           $op->del();
759 0           $right->del();
760 0           $OneMoreExpr = 1;
761             }
762             elsif ($oper eq '>>') {
763 0           $op->del();
764 0           $right->del();
765 0           $OneMoreExpr = 1;
766             }
767             elsif ($oper eq '>>>') {
768 0           $op->del();
769 0           $right->del();
770 0           $OneMoreExpr = 1;
771             }
772             elsif ($oper eq '<') {
773             }
774             elsif ($oper eq '>') {
775             }
776             elsif ($oper eq '<=') {
777             }
778             elsif ($oper eq '>=') {
779             }
780             elsif ($oper eq '==') {
781             }
782             elsif ($oper eq '!=') {
783             }
784             elsif ($oper eq '&') {
785 0           $op->del();
786 0           $left->insert(new Pop($parser));
787 0           $OneMoreExpr = 1;
788             }
789             elsif ($oper eq '^') {
790 0           $op->del();
791 0           $right->del();
792 0           $OneMoreExpr = 1;
793             }
794             elsif ($oper eq '|') {
795 0           $op->del();
796 0           $right->del();
797 0           $OneMoreExpr = 1;
798             }
799             else {
800 0           croak "INTERNAL ERROR optIdtRightInteger (oper:$oper)\n";
801             }
802             }
803             elsif ($val == 1) {
804 0 0         if ($oper eq '+') {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
805 0           $right->del();
806 0           bless($op->{OpCode}, 'UnaryOp');
807 0           $op->{OpCode}->{Operator} = '++';
808 0           $OneMoreExpr = 1;
809             }
810             elsif ($oper eq '-') {
811 0           $right->del();
812 0           bless($op->{OpCode}, 'UnaryOp');
813 0           $op->{OpCode}->{Operator} = '--';
814 0           $OneMoreExpr = 1;
815             }
816             elsif ($oper eq '*') {
817 0           $right->del();
818 0           $op->del();
819 0           $OneMoreExpr = 1;
820             }
821             elsif ($oper eq '/') {
822             }
823             elsif ($oper eq 'div') {
824 0           $right->del();
825 0           $op->del();
826 0           $OneMoreExpr = 1;
827             }
828             elsif ($oper eq '%') {
829 0           $op->del();
830 0           $left->insert(new Pop($parser));
831 0           $right->{OpCode}->{Value} = 0;
832 0           $OneMoreExpr = 1;
833             }
834             elsif ($oper eq '<<') {
835             }
836             elsif ($oper eq '>>') {
837             }
838             elsif ($oper eq '>>>') {
839             }
840             elsif ($oper eq '<') {
841             }
842             elsif ($oper eq '>') {
843             }
844             elsif ($oper eq '<=') {
845             }
846             elsif ($oper eq '>=') {
847             }
848             elsif ($oper eq '==') {
849             }
850             elsif ($oper eq '!=') {
851             }
852             elsif ($oper eq '&') {
853             }
854             elsif ($oper eq '^') {
855             }
856             elsif ($oper eq '|') {
857             }
858             else {
859 0           croak "INTERNAL ERROR optIdtRightInteger (oper:$oper)\n";
860             }
861             }
862             elsif ($val == -1) {
863 0 0         if ($oper eq '+') {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
864 0           $right->del();
865 0           bless($op->{OpCode}, 'UnaryOp');
866 0           $op->{OpCode}->{Operator} = '--';
867 0           $OneMoreExpr = 1;
868             }
869             elsif ($oper eq '-') {
870 0           $right->del();
871 0           bless($op->{OpCode}, 'UnaryOp');
872 0           $op->{OpCode}->{Operator} = '++';
873 0           $OneMoreExpr = 1;
874             }
875             elsif ($oper eq '*') {
876 0           $right->del();
877 0           bless($op->{OpCode}, 'UnaryOp');
878 0           $op->{OpCode}->{Operator} = '-';
879 0           $OneMoreExpr = 1;
880             }
881             elsif ($oper eq '/') {
882             }
883             elsif ($oper eq 'div') {
884 0           $right->del();
885 0           bless($op->{OpCode}, 'UnaryOp');
886 0           $op->{OpCode}->{Operator} = '-';
887 0           $OneMoreExpr = 1;
888             }
889             elsif ($oper eq '%') {
890 0           $op->del();
891 0           $left->insert(new Pop($parser));
892 0           $right->{OpCode}->{Value} = 0;
893 0           $OneMoreExpr = 1;
894             }
895             elsif ($oper eq '<<') {
896             }
897             elsif ($oper eq '>>') {
898             }
899             elsif ($oper eq '>>>') {
900             }
901             elsif ($oper eq '<') {
902             }
903             elsif ($oper eq '>') {
904             }
905             elsif ($oper eq '<=') {
906             }
907             elsif ($oper eq '>=') {
908             }
909             elsif ($oper eq '==') {
910             }
911             elsif ($oper eq '!=') {
912             }
913             elsif ($oper eq '&') {
914             }
915             elsif ($oper eq '^') {
916             }
917             elsif ($oper eq '|') {
918             }
919             else {
920 0           croak "INTERNAL ERROR optIdtRightInteger (oper:$oper)\n";
921             }
922             }
923 0           return;
924             }
925            
926             sub optIdtRightFloat {
927 0     0 0   my $parser = shift;
928 0           my ($op, $left, $right) = @_;
929 0           my $val = $right->{OpCode}->{Value};
930 0           my $oper = $op->{OpCode}->{Operator};
931 0 0         if ($val == 0) {
932 0 0         if ($oper eq '+') {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
933             }
934             elsif ($oper eq '-') {
935             }
936             elsif ($oper eq '*') {
937             }
938             elsif ($oper eq '/') {
939 0           $op->del();
940 0           $left->insert(new Pop($parser));
941 0           $right->{OpCode}->{TypeDef} = 'TYPE_INVALID';
942 0           $OneMoreExpr = 1;
943 0           $parser->optWarning($op, "Division by zero.\n");
944             }
945             elsif ($oper eq 'div') {
946             }
947             elsif ($oper eq '%') {
948             }
949             elsif ($oper eq '<<') {
950             }
951             elsif ($oper eq '>>') {
952             }
953             elsif ($oper eq '>>>') {
954             }
955             elsif ($oper eq '<') {
956             }
957             elsif ($oper eq '>') {
958             }
959             elsif ($oper eq '<=') {
960             }
961             elsif ($oper eq '>=') {
962             }
963             elsif ($oper eq '==') {
964             }
965             elsif ($oper eq '!=') {
966             }
967             elsif ($oper eq '&') {
968             }
969             elsif ($oper eq '^') {
970             }
971             elsif ($oper eq '|') {
972             }
973             else {
974 0           croak "INTERNAL ERROR optIdtRightFloat (oper:$oper)\n";
975             }
976             }
977 0           return;
978             }
979            
980             sub _optAddAsg {
981 0     0     my ($asg, $cst) = @_;
982 0           my $val = $cst->{OpCode}->{Value};
983 0 0         if ($val == 1) {
    0          
    0          
984 0           $cst->del();
985 0           bless($asg->{OpCode}, 'IncrVar');
986             }
987             elsif ($val == 0) {
988 0           $cst->del();
989 0           $asg->del();
990 0           $OneMoreExpr = 1;
991             }
992             elsif ($val == -1) {
993 0           $cst->del();
994 0           bless($asg->{OpCode}, 'DecrVar');
995             }
996 0           return;
997             }
998            
999             sub _optSubAsg {
1000 0     0     my ($asg, $cst) = @_;
1001 0           my $val = $cst->{OpCode}->{Value};
1002 0 0         if ($val == 1) {
    0          
    0          
1003 0           $cst->del();
1004 0           bless($asg->{OpCode}, 'DecrVar');
1005             }
1006             elsif ($val == 0) {
1007 0           $cst->del();
1008 0           $asg->del();
1009 0           $OneMoreExpr = 1;
1010             }
1011             elsif ($val == -1) {
1012 0           $cst->del();
1013 0           bless($asg->{OpCode}, 'IncrVar');
1014             }
1015 0           return;
1016             }
1017            
1018             sub optEvalExpr {
1019 0     0 0   my $parser = shift;
1020 0           my ($expr) = @_;
1021            
1022 0           my $cnt = 0;
1023 0           do {
1024 0           $cnt ++;
1025             # print "optim Expr $cnt\n";
1026 0           $OneMoreExpr = 0;
1027 0           for (my $node = $expr->getLastActive(); defined $node; $node = $node->getPrevActive()) {
1028 0           my $opcode = $node->{OpCode};
1029 0 0         if ($opcode->isa('UnaryOp')) {
    0          
    0          
    0          
1030 0           my $prev = $node->getPrevActive();
1031 0 0         croak "INTERNAL ERROR optEvalExpr\n"
1032             unless (defined $prev);
1033 0 0         if ($prev->{OpCode}->isa('LoadConst')) {
1034 0           my $type = $expr->{OpCode}->{TypeDef};
1035 0 0 0       if ($type eq 'TYPE_INTEGER') {
    0          
    0          
    0          
    0          
1036 0           $parser->evalUnopInteger($node, $prev);
1037             }
1038             elsif ($type eq 'TYPE_FLOAT') {
1039 0           $parser->evalUnopFloat($node, $prev);
1040             }
1041             elsif ($type eq 'TYPE_STRING' or $type eq 'TYPE_UTF8_STRING') {
1042 0           $parser->evalUnopString($node, $prev);
1043             }
1044             elsif ($type eq 'TYPE_BOOLEAN') {
1045 0           $parser->evalUnopBoolean($node, $prev);
1046             }
1047             elsif ($type eq 'TYPE_INVALID') {
1048 0           $parser->evalUnopInvalid($node, $prev);
1049             }
1050             else {
1051 0           croak "INTERNAL ERROR optEvalExpr (type:$type)\n";
1052             }
1053             }
1054             }
1055             elsif ($opcode->isa('BinaryOp')) {
1056 0           my $right = $node->getPrevActive();
1057 0 0         croak "INTERNAL ERROR optEvalExpr\n"
1058             unless (defined $right);
1059 0           my $left = $node->{OpCode}->{Left};
1060 0 0         croak "INTERNAL ERROR optEvalExpr (left)\n"
1061             unless (defined $left);
1062 0 0 0       if ( $left->{OpCode}->isa('LoadConst')
    0 0        
    0 0        
    0          
    0          
1063             and $left->{OpCode}->{TypeDef} eq 'TYPE_INVALID' ) {
1064 0           $right->del();
1065 0           $node->del();
1066 0           $OneMoreExpr = 1;
1067             }
1068             elsif ( $right->{OpCode}->isa('LoadConst')
1069             and $right->{OpCode}->{TypeDef} eq 'TYPE_INVALID' ) {
1070 0           $left->del();
1071 0           $node->del();
1072 0           $OneMoreExpr = 1;
1073             }
1074             elsif ( $left->{OpCode}->isa('LoadConst')
1075             and $right->{OpCode}->isa('LoadConst') ) {
1076 0           my $type_l = $left->{OpCode}->{TypeDef};
1077 0           my $type_r = $right->{OpCode}->{TypeDef};
1078 0 0         if ($type_l eq $type_r) {
1079 0 0         if ($type_r eq 'TYPE_INTEGER') {
    0          
1080 0           $parser->evalBinopInteger($node, $left, $right);
1081             }
1082             elsif ($type_r eq 'TYPE_FLOAT') {
1083 0           $parser->evalBinopFloat($node, $left, $right);
1084             }
1085             }
1086             }
1087             elsif ( $left->{OpCode}->isa('LoadConst') ) {
1088 0           my $type = $left->{OpCode}->{TypeDef};
1089 0 0         if ($type eq 'TYPE_INTEGER') {
1090 0           $parser->optIdtLeftInteger($node, $left, $right);
1091             }
1092             }
1093             elsif ( $right->{OpCode}->isa('LoadConst') ) {
1094 0           my $type = $right->{OpCode}->{TypeDef};
1095 0 0         if ($type eq 'TYPE_INTEGER') {
    0          
1096 0           $parser->optIdtRightInteger($node, $left, $right);
1097             }
1098             elsif ($type eq 'TYPE_FLOAT') {
1099 0           $parser->optIdtRightFloat($node, $left, $right);
1100             }
1101             }
1102             }
1103             elsif ($opcode->isa('AddAsg')) {
1104 0           my $prev = $node->getPrevActive();
1105 0 0         croak "INTERNAL ERROR optEvalExpr\n"
1106             unless (defined $prev);
1107 0 0         if ($prev->{OpCode}->isa('LoadConst')) {
1108 0 0 0       if ( $prev->{OpCode}->{TypeDef} eq 'TYPE_INTEGER'
1109             or $prev->{OpCode}->{TypeDef} eq 'TYPE_FLOAT' ) {
1110 0           _optAddAsg($node,$prev);
1111             }
1112             }
1113             }
1114             elsif ($opcode->isa('SubAsg')) {
1115 0           my $prev = $node->getPrevActive();
1116 0 0         croak "INTERNAL ERROR optEvalExpr\n"
1117             unless (defined $prev);
1118 0 0         if ($prev->{OpCode}->isa('LoadConst')) {
1119 0 0 0       if ( $prev->{OpCode}->{TypeDef} eq 'TYPE_INTEGER'
1120             or $prev->{OpCode}->{TypeDef} eq 'TYPE_FLOAT' ) {
1121 0           _optSubAsg($node, $prev);
1122             }
1123             }
1124             }
1125             }
1126             }
1127             while ($OneMoreExpr);
1128 0           return $cnt > 1;
1129             }
1130            
1131             sub optLoadVarPop {
1132 0     0 0   my $parser = shift;
1133 0           my ($func) = @_;
1134            
1135 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1136 0 0         if ($node->{OpCode}->isa('LoadVar')) {
1137 0           my $next = $node->getNextActive();
1138 0 0         if (defined $next) {
1139 0           my $opcode = $next->{OpCode};
1140 0 0 0       if ($opcode->isa('Pop')) {
    0          
1141 0           $node->del();
1142 0           $next->del();
1143             }
1144             elsif ( $opcode->isa('IncrVar') or $opcode->isa('DecrVar') ) {
1145 0           $next = $next->getNextActive();
1146 0 0         if (defined $next) {
1147 0 0         if ($next->{OpCode}->isa('Pop')) {
1148 0           $node->del();
1149 0           $next->del();
1150             }
1151             }
1152             }
1153             }
1154             }
1155             }
1156 0           return;
1157             }
1158            
1159             sub optTobool {
1160 0     0 0   my $parser = shift;
1161 0           my ($func) = @_;
1162            
1163 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1164 0 0         if ($node->{OpCode}->isa('ToBool')) {
1165 0           my $next = $node->getNextActive();
1166 0 0         if (defined $next) {
1167 0           my $opcode = $next->{OpCode};
1168 0 0 0       if ( $opcode->isa('FalseJump')
      0        
      0        
      0        
      0        
1169             or $opcode->isa('ScAnd')
1170             or $opcode->isa('ScOr')
1171             or $opcode->isa('ToBool')
1172             or ($opcode->isa('UnaryOp') and $opcode->{Operator} eq '!') ) {
1173 0           $node->del();
1174             }
1175             }
1176             }
1177             }
1178 0           return;
1179             }
1180            
1181             sub optUnopNot {
1182 0     0 0   my $parser = shift;
1183 0           my ($func) = @_;
1184            
1185 0           for (my $node = $func->getLastActive(); defined $node; $node = $node->getPrevActive()) {
1186 0 0 0       if ( $node->{OpCode}->isa('UnaryOp')
1187             and $node->{OpCode}->{Operator} eq '!' ) {
1188 0           my $prev = $node->getPrevActive();
1189 0 0         croak "INTERNAL ERROR optUnopNot\n"
1190             unless (defined $prev);
1191 0           my $opcode = $prev->{OpCode};
1192 0 0         if ($opcode->isa('BinaryOp')) {
    0          
1193 0 0         if ($opcode->{Operator} eq '<') {
    0          
    0          
    0          
    0          
    0          
1194 0           $opcode->{Operator} = '>=';
1195 0           $node->del();
1196 0           $OneMoreTime = 1;
1197             }
1198             elsif ($opcode->{Operator} eq '>') {
1199 0           $opcode->{Operator} = '<=';
1200 0           $node->del();
1201 0           $OneMoreTime = 1;
1202             }
1203             elsif ($opcode->{Operator} eq '<=') {
1204 0           $opcode->{Operator} = '>';
1205 0           $node->del();
1206 0           $OneMoreTime = 1;
1207             }
1208             elsif ($opcode->{Operator} eq '>=') {
1209 0           $opcode->{Operator} = '<';
1210 0           $node->del();
1211 0           $OneMoreTime = 1;
1212             }
1213             elsif ($opcode->{Operator} eq '==') {
1214 0           $opcode->{Operator} = '!=';
1215 0           $node->del();
1216 0           $OneMoreTime = 1;
1217             }
1218             elsif ($opcode->{Operator} eq '!=') {
1219 0           $opcode->{Operator} = '==';
1220 0           $node->del();
1221 0           $OneMoreTime = 1;
1222             }
1223             }
1224             elsif ($opcode->isa('UnaryOp')) {
1225 0 0         if ($opcode->{Operator} eq '!') {
1226 0           bless($prev->{Opcode}, 'ToBool');
1227 0           $node->del();
1228 0           $OneMoreTime = 1;
1229             }
1230             }
1231             }
1232             }
1233 0           return;
1234             }
1235            
1236             sub optLabel {
1237 0     0 0   my $parser = shift;
1238 0           my ($func) = @_;
1239            
1240 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1241 0 0         if ($node->{OpCode}->isa('Label')) {
1242 0 0         if ($node->{OpCode}->{Definition}->{NbUse} == 0) {
1243 0           $node->del();
1244 0           $OneMoreTime = 1;
1245             }
1246             }
1247             }
1248 0           return;
1249             }
1250            
1251             sub optTestJump {
1252 0     0 0   my $parser = shift;
1253 0           my ($func) = @_;
1254            
1255 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1256 0 0         if ($node->{OpCode}->isa('FalseJump')) {
1257 0           my $prev = $node->getPrevActive();
1258 0 0 0       if (defined $prev and $prev->{OpCode}->isa('LoadConst')) {
1259 0 0         if ($prev->{OpCode}->{Value}) {
1260 0           $parser->optInfo($node, "Condition always TRUE.\n");
1261 0           $node->del();
1262 0           $prev->del();
1263 0           $node->{OpCode}->{Definition}->{NbUse} --;
1264             }
1265             else {
1266 0           $parser->optInfo($node, "Condition always FALSE.\n");
1267 0           bless($node->{OpCode}, 'Jump');
1268 0           $prev->del(); # OK
1269             }
1270 0           $OneMoreTime = 1;
1271             }
1272             }
1273             }
1274 0           return;
1275             }
1276            
1277             sub optReJump {
1278 0     0 0   my $parser = shift;
1279 0           my ($func) = @_;
1280            
1281 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1282 0           my $opcode = $node->{OpCode};
1283 0 0 0       if ($opcode->isa('Jump') or $opcode->isa('FalseJump')) {
1284 0           my $label1 = $opcode->{Definition};
1285 0           my $dest = $label1->{Node}->getNextActive();
1286 0 0 0       if (defined $dest and $dest->{OpCode}->isa('Jump')) {
1287 0           my $label2 = $dest->{OpCode}->{Definition};
1288 0           $opcode->{Definition} = $label2;
1289 0           $label1->{NbUse} --;
1290 0           $label2->{NbUse} ++;
1291             }
1292             }
1293             }
1294 0           return;
1295             }
1296            
1297             sub optFalseJumpJump {
1298 0     0 0   my $parser = shift;
1299 0           my ($func) = @_;
1300            
1301 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1302 0 0         if ($node->{OpCode}->isa('FalseJump')) {
1303 0           my $next = $node->getNextActive();
1304 0 0 0       if (defined $next and $next->{OpCode}->isa('Jump')) {
1305 0           my $next2 = $next->getNextActive();
1306 0 0 0       if ( defined $next2
      0        
1307             and $next2->{OpCode}->isa('Label')
1308             and $node->{OpCode}->{Definition} == $next2->{OpCode}->{Definition} ) {
1309 0           $node->{OpCode}->{Definition}->{NbUse} --;
1310 0           bless($node->{OpCode}, 'UnaryOp');
1311 0           $node->{OpCode}->{Operator} = '!';
1312 0           bless($next->{OpCode}, 'FalseJump');
1313 0           $parser->optDebug($node, "reverse FalseJump.\n");
1314             }
1315             }
1316             }
1317             }
1318 0           return;
1319             }
1320            
1321             sub optNullJump {
1322 0     0 0   my $parser = shift;
1323 0           my ($func) = @_;
1324            
1325 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1326 0           my $opcode = $node->{OpCode};
1327 0 0 0       if ($opcode->isa('Jump') or $opcode->isa('FalseJump')) {
1328 0           my $label = $opcode->{Definition};
1329 0           my $next = $node->getNextActive();
1330 0 0 0       if ( defined $next
      0        
1331             and $next->{OpCode}->isa('Label')
1332             and $label == $next->{OpCode}->{Definition} ) {
1333 0 0         if ($opcode->isa('Jump')) {
1334 0           $node->del();
1335 0           $parser->optDebug($node, "null Jump.\n");
1336             }
1337             else { # FalseJump
1338 0           bless($node->{OpCode}, 'Pop');
1339 0           $OneMoreTime = 1;
1340 0           $parser->optDebug($node, "null FalseJump.\n");
1341             }
1342             }
1343             }
1344             }
1345 0           return;
1346             }
1347            
1348             sub killVar {
1349 0     0 0   my $parser = shift;
1350 0           my ($func, $def) = @_;
1351            
1352 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1353 0           my $opcode = $node->{OpCode};
1354 0 0 0       if ( $opcode->isa('StoreVar')
    0 0        
      0        
1355             or $opcode->isa('AddAsg')
1356             or $opcode->isa('SubAsg') ) {
1357 0           my $expr = $node->getPrevActive();
1358 0 0         croak "INTERNAL ERROR killVar\n"
1359             unless (defined $expr);
1360 0           $expr->insert(new Pop($parser));
1361 0           $node->del();
1362             }
1363             elsif ( $opcode->isa('IncrVar')
1364             or $opcode->isa('DecrVar') ) {
1365 0 0         if ($def == $node->{OpCode}->{Definition}) {
1366 0           $node->del();
1367             }
1368             }
1369             }
1370 0           return;
1371             }
1372            
1373             sub killDeadExpr {
1374 0     0 0   my $parser = shift;
1375 0           my ($func) = @_;
1376            
1377 0           for (my $node = $func->getLastActive(); defined $node; $node = $node->getPrevActive()) {
1378 0 0         if ($node->{OpCode}->isa('Pop')) {
1379 0           my $prev = $node->getPrevActive();
1380 0 0         croak "INTERNAL ERROR killDeadExpr\n"
1381             unless (defined $prev);
1382 0           my $opcode =$prev->{OpCode};
1383 0 0         if ($opcode->isa('LoadConst')) {
    0          
    0          
    0          
1384 0           $prev->del();
1385 0           $node->del();
1386 0           $parser->optDebug($node, "del LOAD_CONST.\n");
1387             }
1388             elsif ($opcode->isa('LoadVar')) {
1389 0           $prev->del();
1390 0           $node->del();
1391 0           $OneMoreTime = 1;
1392 0           $parser->optDebug($node, "del LOAD_VAR.\n");
1393             }
1394             elsif ($opcode->isa('UnaryOp')) {
1395 0           my $expr = $prev->getPrevActive();
1396 0 0         croak "INTERNAL ERROR killDeadExpr (expr)\n"
1397             unless (defined $expr);
1398 0           $expr->insert(new Pop($parser));
1399 0           $prev->del();
1400 0           $node->del();
1401 0           $parser->optDebug($node, "del UNOP.\n");
1402             }
1403             elsif ($opcode->isa('BinaryOp')) {
1404 0           my $left = $prev->{OpCode}->{Left};
1405 0           my $right = $prev->getPrevActive();
1406 0 0         croak "INTERNAL ERROR killDeadExpr (right)\n"
1407             unless (defined $right);
1408 0 0         croak "INTERNAL ERROR killDeadExpr (left)\n"
1409             unless (defined $left);
1410 0           $left->insert(new Pop($parser));
1411 0           $right->insert(new Pop($parser));
1412 0           $prev->del();
1413 0           $node->del();
1414 0           $parser->optDebug($node, "del BINOP.\n");
1415             }
1416             }
1417             }
1418 0           return;
1419             }
1420            
1421             sub killDeadCode {
1422 0     0 0   my $parser = shift;
1423 0           my ($func) = @_;
1424            
1425 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1426 0 0 0       if ( $node->{OpCode}->isa('Jump')
      0        
1427             or $node->{OpCode}->isa('Return')
1428             or $node->{OpCode}->isa('ReturnES') ) {
1429 0           my $first = 1;
1430 0           for (my $next = $node->getNextActive(); defined $next; $next = $next->getNextActive()) {
1431 0           my $opcode = $next->{OpCode};
1432 0 0 0       last if ($opcode->isa('Label') and $opcode->{Definition}->{Index} > 0);
1433 0           $next->del();
1434 0 0         if ($first) {
1435 0           $first = 0;
1436 0           $parser->optWarning($next, "Code unreachable.\n");
1437             }
1438             }
1439             }
1440             }
1441 0           return;
1442             }
1443            
1444             sub convVar2Const {
1445 0     0 0   my $parser = shift;
1446 0           my ($func, $def, $name, $cst) = @_;
1447            
1448 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1449 0           my $opcode = $node->{OpCode};
1450 0 0 0       if ($opcode->isa('LoadVar') and $def == $opcode->{Definition}) {
1451 0           $parser->optInfo($node, "Implemented by a constant - $name.\n");
1452 0           bless($node->{OpCode}, 'LoadConst');
1453 0           $opcode->{Value} = $cst->{Value};
1454 0           $opcode->{TypeDef} = $cst->{TypeDef};
1455             }
1456             }
1457 0           return;
1458             }
1459            
1460             sub optVar {
1461 0     0 0   my $parser = shift;
1462 0           my ($func) = @_;
1463            
1464 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1465 0           my $opcode = $node->{OpCode};
1466 0 0 0       if ( $opcode->isa('Argument')
      0        
      0        
      0        
      0        
      0        
1467             or $opcode->isa('LoadVar')
1468             or $opcode->isa('StoreVar')
1469             or $opcode->isa('IncrVar')
1470             or $opcode->isa('DecrVar')
1471             or $opcode->isa('AddAsg')
1472             or $opcode->isa('SubAsg') ) {
1473 0           $opcode->{Definition}->{Index} = 0; # clear flag
1474             }
1475             }
1476 0           for (my $node = $func->getFirstActive(); defined $node; $node = $node->getNextActive()) {
1477 0           my $opcode = $node->{OpCode};
1478 0 0 0       if ( $opcode->isa('Argument')
      0        
      0        
      0        
      0        
      0        
1479             or $opcode->isa('LoadVar')
1480             or $opcode->isa('StoreVar')
1481             or $opcode->isa('IncrVar')
1482             or $opcode->isa('DecrVar')
1483             or $opcode->isa('AddAsg')
1484             or $opcode->isa('SubAsg') ) {
1485 0           my $def = $opcode->{Definition};
1486 0 0 0       if ($def->{Index} == 0 and $def->{NbUse} != 0) {
1487 0           my $load = undef;
1488 0           my $store = undef;
1489 0           my $nb_load = 0;
1490 0           my $nb_store = 0;
1491 0           my $nb_modif = 0;
1492 0           my $name = $def->{Symbol};
1493 0           $def->{Index} = 1; # set flag
1494 0           for (my $next = $node; defined $next; $next = $next->getNextActive()) {
1495 0 0 0       if ($next->{OpCode}->isa('LoadVar')) {
    0 0        
    0 0        
1496 0 0         if ($def == $next->{OpCode}->{Definition}) {
1497 0           $nb_load ++;
1498 0           $load = $next;
1499             }
1500             }
1501             elsif ($next->{OpCode}->isa('StoreVar')) {
1502 0 0         if ($def == $next->{OpCode}->{Definition}) {
1503 0           $nb_store ++;
1504 0           $store = $next;
1505             }
1506             }
1507             elsif ( $next->{OpCode}->isa('IncrVar')
1508             or $next->{OpCode}->isa('DecrVar')
1509             or $next->{OpCode}->isa('AddAsg')
1510             or $next->{OpCode}->isa('SubAsg') ) {
1511 0 0         if ($def == $next->{OpCode}->{Definition}) {
1512 0           $nb_modif ++;
1513             }
1514             }
1515             }
1516             # print "var:",$name," nb_load:",$nb_load," nb_store:",$nb_store," nb_modif:",$nb_modif,"\n";
1517 0 0 0       if ($nb_load == 0) {
    0 0        
1518 0           $parser->optWarning($node, "Unaccessed variable - $name.\n");
1519 0           $parser->killVar($node, $def);
1520             }
1521             elsif ( ! $opcode->isa('Argument') and $nb_modif == 0 and $nb_store == 1) {
1522 0           my $prev = $store->getPrevActive();
1523 0 0 0       if ($prev->{OpCode}->isa('LoadConst')) {
    0          
1524 0           $parser->convVar2Const($node, $def, $name, $prev->{OpCode});
1525 0           $store->del();
1526 0           $prev->del();
1527             }
1528             elsif ($nb_load == 1 and $store->getNextActive() == $load) {
1529 0           $store->del();
1530 0           $load->del();
1531 0           $parser->optDebug($load, "store/load deleted - $name.\n");
1532             }
1533             }
1534             }
1535             }
1536             }
1537 0           return;
1538             }
1539            
1540             sub Optimize {
1541 0     0 0   my $parser = shift;
1542 0           my ($OptExpr) = @_;
1543             # my $visitor = new WAP::wmls::printVisitor();
1544            
1545 0           for (my $node = $parser->YYData->{FunctionList}; defined $node; $node = $node->{Next}) {
1546 0 0         croak "INTERNAL ERROR in Optimize\n"
1547             unless ($node->{OpCode}->isa('Function'));
1548 0           my $func = $node->{OpCode}->{Value};
1549 0 0         next unless (defined $func);
1550            
1551 0           my $cnt = 0;
1552             # $func->visit($visitor);
1553 0           $parser->optLoadVarPop($func);
1554 0           do {
1555 0           $cnt ++;
1556             # print "optim $cnt\n";
1557 0           $OneMoreTime = 0;
1558 0           $parser->optTobool($func);
1559 0           $parser->optVar($func);
1560 0           $parser->killDeadExpr($func);
1561             # $func->visit($visitor);
1562 0 0         if ($OptExpr) {
1563 0 0         if ($parser->optEvalExpr($func)) {
1564 0           $OneMoreTime = 1;
1565             }
1566             }
1567             # $func->visit($visitor);
1568 0           $parser->optTestJump($func);
1569 0           $parser->optReJump($func);
1570 0           $parser->killDeadCode($func);
1571 0           $parser->optFalseJumpJump($func);
1572 0           $parser->optNullJump($func);
1573 0           $parser->optLabel($func);
1574 0           $parser->optUnopNot($func);
1575             # $func->visit($visitor);
1576             }
1577             while ($OneMoreTime);
1578             }
1579 0           return;
1580             }
1581            
1582             1;
1583