# License or the Artistic License, as specified in the README file.
#
package B::CC;
+
+our $VERSION = '1.00';
+
+use Config;
use strict;
use B qw(main_start main_root class comppadlist peekop svref_2object
timing_info init_av sv_undef amagic_generation
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;
$ppname = shift;
$runtime_list_ref = [];
$declare_ref = {};
- runtime("djSP;");
+ runtime("dSP;");
declare("I32", "oldsave");
declare("SV", "**svp");
map { declare("SV", "*$_") } qw(sv src dst left right);
}
}
+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;
sub error {
my $format = shift;
- my $file = $curcop->[0]->filegv->SV->PV;
+ my $file = $curcop->[0]->file;
my $line = $curcop->[0]->line;
$errors++;
if (@_) {
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--;");
}
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--;");
}
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;
}
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;
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) {
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;
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));");
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();
return $op->next;
}
+
sub pp_pushmark {
my $op = shift;
write_back_stack();
# 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;
$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;
$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;
# 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;
# 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);
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)));
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;
}
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;
}
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;
}
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;
# 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();
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 {
}
init_pp($name);
load_pad(@padlist);
+ %lexstate=();
B::Pseudoreg->new_scope;
@cxstack = ();
if ($debug_timings) {
if (!$$op) {
runtime("PUTBACK;","return PL_op;");
} elsif ($done{$$op}) {
+ save_or_restore_lexical_state($$op);
runtime(sprintf("goto %s;", label($op)));
}
}
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);