X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB%2FCC.pm;h=c5ca2a3df5bb9f47d20db39a38e55f62d02e83a2;hb=1e1dbab6eed49955498a66ce3beedbd7ea33dc21;hp=f912c413f275b8d88be44ce84b9c9f4975b980c5;hpb=0a574d6e232d3c652ebdcf1bd17c739c4373b905;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm index f912c41..c5ca2a3 100644 --- a/ext/B/B/CC.pm +++ b/ext/B/B/CC.pm @@ -6,6 +6,7 @@ # License or the Artistic License, as specified in the README file. # package B::CC; +use Config; use strict; use B qw(main_start main_root class comppadlist peekop svref_2object timing_info init_av sv_undef amagic_generation @@ -53,6 +54,8 @@ 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_scalar pp_regcmaybe pp_lineseq pp_scope pp_null)) { $ignore_op{$_} = 1; @@ -95,13 +98,14 @@ sub init_hash { map { $_ => 1 } @_ } %need_curcop = init_hash qw(pp_rv2gv pp_bless pp_repeat pp_sort pp_caller pp_reset pp_rv2cv pp_entereval pp_require pp_dofile pp_entertry pp_enterloop pp_enteriter pp_entersub - pp_enter); + pp_enter pp_method); sub debug { if ($debug_runtime) { warn(@_); } else { - runtime(map { chomp; "/* $_ */"} @_); + my @tmp=@_; + runtime(map { chomp; "/* $_ */"} @tmp); } } @@ -213,6 +217,32 @@ 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 +376,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 +527,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 +545,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 +563,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; } @@ -553,9 +588,16 @@ sub pp_padsv { sub pp_const { my $op = shift; my $sv = $op->sv; - my $obj = $constobj{$$sv}; - if (!defined($obj)) { - $obj = $constobj{$$sv} = new B::Stackobj::Const ($sv); + my $obj; + # constant could be in the pad (under useithreads) + if ($$sv) { + $obj = $constobj{$$sv}; + if (!defined($obj)) { + $obj = $constobj{$$sv} = new B::Stackobj::Const ($sv); + } + } + else { + $obj = $pad[$op->targ]; } push(@stack, $obj); return $op->next; @@ -565,7 +607,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) { @@ -623,10 +665,17 @@ sub pp_sort { write_back_stack(); doop($op); return $op->next; -} +} + sub pp_gv { my $op = shift; - my $gvsym = $op->gv->save; + my $gvsym; + if ($Config{useithreads}) { + $gvsym = $pad[$op->padix]->as_sv; + } + else { + $gvsym = $op->gv->save; + } write_back_stack(); runtime("XPUSHs((SV*)$gvsym);"); return $op->next; @@ -634,7 +683,13 @@ sub pp_gv { sub pp_gvsv { my $op = shift; - my $gvsym = $op->gv->save; + my $gvsym; + if ($Config{useithreads}) { + $gvsym = $pad[$op->padix]->as_sv; + } + else { + $gvsym = $op->gv->save; + } write_back_stack(); if ($op->private & OPpLVAL_INTRO) { runtime("XPUSHs(save_scalar($gvsym));"); @@ -646,7 +701,13 @@ sub pp_gvsv { sub pp_aelemfast { my $op = shift; - my $gvsym = $op->gv->save; + my $gvsym; + if ($Config{useithreads}) { + $gvsym = $pad[$op->padix]->as_sv; + } + else { + $gvsym = $op->gv->save; + } my $ix = $op->private; my $flag = $op->flags & OPf_MOD; write_back_stack(); @@ -1013,6 +1074,7 @@ sub pp_preinc { return $op->next; } + sub pp_pushmark { my $op = shift; write_back_stack(); @@ -1054,6 +1116,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 +1226,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 +1246,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 +1265,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 +1303,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 +1334,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 +1406,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 +1430,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 +1459,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 +1471,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 +1492,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(); @@ -1428,7 +1501,7 @@ sub pp_substcont { sub default_pp { my $op = shift; - my $ppname = $op->ppaddr; + my $ppname = "pp_" . $op->name; if ($curcop and $need_curcop{$ppname}){ $curcop->write_back; } @@ -1445,7 +1518,7 @@ sub default_pp { sub compile_op { my $op = shift; - my $ppname = $op->ppaddr; + my $ppname = "pp_" . $op->name; if (exists $ignore_op{$ppname}) { return $op->next; } @@ -1467,6 +1540,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 +1554,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 +1583,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 +1597,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 +1672,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);