view release on metacpan or  search on metacpan

lib/B/CC.pm  view on Meta::CPAN

                    $sv->as_sv, $sv->as_sv, $sv->as_sv, label($next)) ) if $sv;
  return $op->other;
}

# coverage: 102
sub pp_cond_expr {
  my $op    = shift;
  my $false = $op->next;
  unshift( @bblock_todo, $false );
  reload_lexicals();
  my $bool = pop_bool();
  write_back_stack();
  save_or_restore_lexical_state($$false);
  runtime( sprintf( "if (!$bool) goto %s;\t/* cond_expr */", label($false) ) );
  return $op->other;
}

# coverage: 9,10,12,17,18,22,28,32
sub pp_padsv {
  my $op = shift;
  my $ix = $op->targ;
  push( @stack, $pad[$ix] ) if $pad[$ix];
  if ( $op->flags & OPf_MOD ) {
    my $private = $op->private;
    if ( $private & OPpLVAL_INTRO ) {
      # coverage: 9,10,12,17,18,19,20,22,27,28,31,32
      runtime("SAVECLEARSV(PL_curpad[$ix]);");
    }
    elsif ( $private & OPpDEREF ) {
      # coverage: 18
      if ($] >= 5.015002) {
	runtime(sprintf( "PL_curpad[%d] = Perl_vivify_ref(aTHX_ PL_curpad[%d], %d);",
			 $ix, $ix, $private & OPpDEREF ));
      } else {
	runtime(sprintf( "Perl_vivify_ref(aTHX_ PL_curpad[%d], %d);",
			 $ix, $private & OPpDEREF ));
      }
      $vivify_ref_defined++;
      $pad[$ix]->invalidate if $pad[$ix];
    }
  }
  return $op->next;
}

# coverage: 1-5,7-14,18-23,25,27-32
sub pp_const {
  my $op = shift;
  my $sv = $op->sv;
  my $obj;

  # constant could be in the pad (under useithreads)
  if ($$sv) {
    $obj = $constobj{$$sv};
    if ( !defined($obj) ) {
      $obj = $constobj{$$sv} = B::Stackobj::Const->new($sv);
    }
  }
  else {
    $obj = $pad[ $op->targ ];
  }
  # XXX looks like method_named has only const as prev op
  if ($op->next
      and $op->next->can('name')
      and $op->next->name eq 'method_named'
     ) {
    $package_pv = svop_or_padop_pv($op);
    debug "save package_pv \"$package_pv\" for method_name\n" if $debug{op};
  }
  push( @stack, $obj );
  return $op->next;
}

# coverage: 1-39, fails in 33
sub pp_nextstate {
  my $op = shift;
  if ($labels->{'nextstate'}->[-1] and $labels->{'nextstate'}->[-1] == $op) {
    debug sprintf("pop_label nextstate: cxstack label %s\n", $curcop->[0]->label) if $debug{cxstack};
    pop_label 'nextstate';
  } else {
    write_label($op);
  }
  $curcop->load($op);
  loadop($op);
  #testcc 48: protect CopFILE_free and CopSTASH_free in END block (#296)
  if ($ppname =~ /^pp_sub_END(_\d+)?$/ and $ITHREADS) {
    runtime("#ifdef USE_ITHREADS",
            "CopFILE((COP*)PL_op) = NULL;");
    if ($] >= 5.018) {
      runtime("CopSTASH_set((COP*)PL_op, NULL);");
    } elsif ($] >= 5.016 and $] <= 5.017) {
      runtime("CopSTASHPV_set((COP*)PL_op, NULL, 0);");
    } else {
      runtime("CopSTASHPV_set((COP*)PL_op, NULL);");
    }
    runtime("#endif");
  }
  @stack = ();
  debug( sprintf( "%s:%d\n", $op->file, $op->line ) ) if $debug{lineno};
  debug( sprintf( "CopLABEL %s\n", $op->label ) ) if $op->label and $debug{cxstack};
  runtime("TAINT_NOT;") if $opt_taint; # TODO Not always needed (resets PL_taint = 0)
  runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;"); # TODO reset sp not needed always
  if ( $freetmps_each_bblock || $freetmps_each_loop ) {
    $need_freetmps = 1;
  }
  else {
    runtime("FREETMPS;"); # TODO Not always needed
  }
  return $op->next;
}

# Like pp_nextstate, but used instead when the debugger is active.
sub pp_dbstate { pp_nextstate(@_) }

#default_pp will handle this:
#sub pp_bless { $curcop->write_back; default_pp(@_) }
#sub pp_repeat { $curcop->write_back; default_pp(@_) }
# The following subs need $curcop->write_back if we decide to support arybase:
# pp_pos, pp_substr, pp_index, pp_rindex, pp_aslice, pp_lslice, pp_splice
#sub pp_caller { $curcop->write_back; default_pp(@_) }

# coverage: ny