X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB%2FCC.pm;h=cf0e81f92e9932a6cdc7b12ae4ff5b23e529f9c2;hb=87d7fd28459b8274079ce3260d3e07e306aa70d8;hp=30882dd48f1502f4c15278b78c3a0c1cc37cf696;hpb=edcf81c065c289db870eda66eec01bdab2c57a10;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm index 30882dd..cf0e81f 100644 --- a/ext/B/B/CC.pm +++ b/ext/B/B/CC.pm @@ -53,8 +53,10 @@ my %skip_invalidate; # Hash of PP names which don't need invalidate_lexicals my %ignore_op; # Hash of ops which do nothing except returning op_next my %need_curcop; # Hash of ops which need PL_curcop +my %lexstate; #state of padsvs at the start of a bblock + BEGIN { - foreach (qw(pp_setstate pp_scalar pp_regcmaybe pp_lineseq pp_scope pp_null)) { + foreach (qw(pp_scalar pp_regcmaybe pp_lineseq pp_scope pp_null)) { $ignore_op{$_} = 1; } } @@ -101,7 +103,8 @@ sub debug { if ($debug_runtime) { warn(@_); } else { - runtime(map { chomp; "/* $_ */"} @_); + my @tmp=@_; + runtime(map { chomp; "/* $_ */"} @tmp); } } @@ -213,6 +216,31 @@ sub write_back_lexicals { } } +sub save_or_restore_lexical_state { + my $bblock=shift; + unless( exists $lexstate{$bblock}){ + foreach my $lex (@pad) { + next unless ref($lex); + ${$lexstate{$bblock}}{$lex->{iv}} = $lex->{flags} ; + } + }else{ + foreach my $lex (@pad) { + next unless ref($lex); + my $old_flags=${$lexstate{$bblock}}{$lex->{iv}} ; + next if ( $old_flags eq $lex->{flags}); + if (($old_flags & VALID_SV) && !($lex->{flags} & VALID_SV)){ + $lex->write_back; + } + if (($old_flags & VALID_DOUBLE) && !($lex->{flags} & VALID_DOUBLE)){ + $lex->load_double; + } + if (($old_flags & VALID_INT) && !($lex->{flags} & VALID_INT)){ + $lex->load_int; + } + } + } +} + sub write_back_stack { my $obj; return unless @stack; @@ -346,7 +374,7 @@ sub dopoptolabel { sub error { my $format = shift; - my $file = $curcop->[0]->filegv->SV->PV; + my $file = $curcop->[0]->file; my $line = $curcop->[0]->line; $errors++; if (@_) { @@ -497,8 +525,10 @@ sub pp_and { if (@stack >= 1) { my $bool = pop_bool(); write_back_stack(); + save_or_restore_lexical_state($$next); runtime(sprintf("if (!$bool) {XPUSHs(&PL_sv_no); goto %s;}", label($next))); } else { + save_or_restore_lexical_state($$next); runtime(sprintf("if (!%s) goto %s;", top_bool(), label($next)), "*sp--;"); } @@ -513,9 +543,11 @@ sub pp_or { if (@stack >= 1) { my $bool = pop_bool @stack; write_back_stack(); + save_or_restore_lexical_state($$next); runtime(sprintf("if (%s) { XPUSHs(&PL_sv_yes); goto %s; }", $bool, label($next))); } else { + save_or_restore_lexical_state($$next); runtime(sprintf("if (%s) goto %s;", top_bool(), label($next)), "*sp--;"); } @@ -529,6 +561,7 @@ sub pp_cond_expr { reload_lexicals(); my $bool = pop_bool(); write_back_stack(); + save_or_restore_lexical_state($$false); runtime(sprintf("if (!$bool) goto %s;", label($false))); return $op->other; } @@ -565,7 +598,7 @@ sub pp_nextstate { my $op = shift; $curcop->load($op); @stack = (); - debug(sprintf("%s:%d\n", $op->filegv->SV->PV, $op->line)) if $debug_lineno; + debug(sprintf("%s:%d\n", $op->file, $op->line)) if $debug_lineno; runtime("TAINT_NOT;") unless $omit_taint; runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;"); if ($freetmps_each_bblock || $freetmps_each_loop) { @@ -1013,6 +1046,7 @@ sub pp_preinc { return $op->next; } + sub pp_pushmark { my $op = shift; write_back_stack(); @@ -1054,6 +1088,7 @@ sub pp_formline { # See comment in pp_grepwhile to see why! $init->add("((LISTOP*)$sym)->op_first = $sym;"); runtime("if (PL_op == ((LISTOP*)($sym))->op_first){"); + save_or_restore_lexical_state(${$op->first}); runtime( sprintf("goto %s;",label($op->first))); runtime("}"); return $op->next; @@ -1163,6 +1198,7 @@ sub pp_grepstart { $next->save; my $nexttonext=$next->next; $nexttonext->save; + save_or_restore_lexical_state($$nexttonext); runtime(sprintf("if (PL_op == (($sym)->op_next)->op_next) goto %s;", label($nexttonext))); return $op->next->other; @@ -1182,6 +1218,7 @@ sub pp_mapstart { $next->save; my $nexttonext=$next->next; $nexttonext->save; + save_or_restore_lexical_state($$nexttonext); runtime(sprintf("if (PL_op == (($sym)->op_next)->op_next) goto %s;", label($nexttonext))); return $op->next->other; @@ -1200,6 +1237,7 @@ sub pp_grepwhile { # around that, we hack op_next to be our own op (purely because we # know it's a non-NULL pointer and can't be the same as op_other). $init->add("((LOGOP*)$sym)->op_next = $sym;"); + save_or_restore_lexical_state($$next); runtime(sprintf("if (PL_op == ($sym)->op_next) goto %s;", label($next))); $know_op = 0; return $op->other; @@ -1237,6 +1275,7 @@ sub pp_range { # We need to save our UNOP structure since pp_flop uses # it to find and adjust out targ. We don't need it ourselves. $op->save; + save_or_restore_lexical_state(${$op->other}); runtime sprintf("if (SvTRUE(PL_curpad[%d])) goto %s;", $op->targ, label($op->other)); unshift(@bblock_todo, $op->other); @@ -1267,6 +1306,7 @@ sub pp_flip { if ($op->flags & OPf_SPECIAL) { runtime("sv_setiv(PL_curpad[$ix], 1);"); } else { + save_or_restore_lexical_state(${$op->first->other}); runtime("\tsv_setiv(PL_curpad[$ix], 0);", "\tsp--;", sprintf("\tgoto %s;", label($op->first->other))); @@ -1338,6 +1378,7 @@ sub pp_next { default_pp($op); my $nextop = $cxstack[$cxix]->{nextop}; push(@bblock_todo, $nextop); + save_or_restore_lexical_state($$nextop); runtime(sprintf("goto %s;", label($nextop))); return $op->next; } @@ -1361,6 +1402,7 @@ sub pp_redo { default_pp($op); my $redoop = $cxstack[$cxix]->{redoop}; push(@bblock_todo, $redoop); + save_or_restore_lexical_state($$redoop); runtime(sprintf("goto %s;", label($redoop))); return $op->next; } @@ -1389,6 +1431,7 @@ sub pp_last { default_pp($op); my $lastop = $cxstack[$cxix]->{lastop}->next; push(@bblock_todo, $lastop); + save_or_restore_lexical_state($$lastop); runtime(sprintf("goto %s;", label($lastop))); return $op->next; } @@ -1400,6 +1443,7 @@ sub pp_subst { my $sym = doop($op); my $replroot = $op->pmreplroot; if ($$replroot) { + save_or_restore_lexical_state($$replroot); runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplroot) goto %s;", $sym, label($replroot)); $op->pmreplstart->save; @@ -1420,6 +1464,7 @@ sub pp_substcont { # my $pmopsym = objsym($pmop); my $pmopsym = $pmop->save; # XXX can this recurse? # warn "pmopsym = $pmopsym\n";#debug + save_or_restore_lexical_state(${$pmop->pmreplstart}); runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplstart) goto %s;", $pmopsym, label($pmop->pmreplstart)); invalidate_lexicals(); @@ -1467,6 +1512,7 @@ sub compile_op { sub compile_bblock { my $op = shift; #warn "compile_bblock: ", peekop($op), "\n"; # debug + save_or_restore_lexical_state($$op); write_label($op); $know_op = 0; do { @@ -1480,8 +1526,14 @@ sub compile_bblock { sub cc { my ($name, $root, $start, @padlist) = @_; my $op; + if($done{$$start}){ + #warn "repeat=>".ref($start)."$name,\n";#debug + $decl->add(sprintf("#define $name %s",$done{$$start})); + return; + } init_pp($name); load_pad(@padlist); + %lexstate=(); B::Pseudoreg->new_scope; @cxstack = (); if ($debug_timings) { @@ -1503,7 +1555,7 @@ sub cc { next if !defined($op) || !$$op || $done{$$op}; #warn "...compiling it\n"; # debug do { - $done{$$op} = 1; + $done{$$op} = $name; $op = compile_bblock($op); if ($need_freetmps && $freetmps_each_bblock) { runtime("FREETMPS;"); @@ -1517,6 +1569,7 @@ sub cc { if (!$$op) { runtime("PUTBACK;","return PL_op;"); } elsif ($done{$$op}) { + save_or_restore_lexical_state($$op); runtime(sprintf("goto %s;", label($op))); } } @@ -1591,8 +1644,8 @@ XS(boot_$cmodule) perl_init(); ENTER; SAVETMPS; - SAVESPTR(PL_curpad); - SAVESPTR(PL_op); + SAVEVPTR(PL_curpad); + SAVEVPTR(PL_op); PL_curpad = AvARRAY($curpad_sym); PL_op = $start; pp_main(aTHX);