package B::CC;
use strict;
use B qw(main_start main_root class comppadlist peekop svref_2object
- timing_info init_av);
+ timing_info init_av
+ OPf_WANT_LIST OPf_WANT OPf_MOD OPf_STACKED OPf_SPECIAL
+ OPpASSIGN_BACKWARDS OPpLVAL_INTRO OPpDEREF_AV OPpDEREF_HV
+ OPpDEREF OPpFLIP_LINENUM G_ARRAY
+ CXt_NULL CXt_SUB CXt_EVAL CXt_LOOP CXt_SUBST CXt_BLOCK
+ );
use B::C qw(save_unused_subs objsym init_sections mark_unused
output_all output_boilerplate output_main);
use B::Bblock qw(find_leaders);
# These should probably be elsewhere
# Flags for $op->flags
-sub OPf_LIST () { 1 }
-sub OPf_KNOW () { 2 }
-sub OPf_MOD () { 32 }
-sub OPf_STACKED () { 64 }
-sub OPf_SPECIAL () { 128 }
-# op-specific flags for $op->private
-sub OPpASSIGN_BACKWARDS () { 64 }
-sub OPpLVAL_INTRO () { 128 }
-sub OPpDEREF_AV () { 32 }
-sub OPpDEREF_HV () { 64 }
-sub OPpDEREF () { OPpDEREF_AV|OPpDEREF_HV }
-sub OPpFLIP_LINENUM () { 64 }
-sub G_ARRAY () { 1 }
-# cop.h
-sub CXt_NULL () { 0 }
-sub CXt_SUB () { 1 }
-sub CXt_EVAL () { 2 }
-sub CXt_LOOP () { 3 }
-sub CXt_SUBST () { 4 }
-sub CXt_BLOCK () { 5 }
my $module; # module name (when compiled with -m)
my %done; # hash keyed by $$op of leaders of basic blocks
my %skip_lexicals; # Hash of PP names which don't need write_back_lexicals
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
BEGIN {
foreach (qw(pp_scalar pp_regcmaybe pp_lineseq pp_scope pp_null)) {
#
%skip_lexicals = init_hash qw(pp_enter pp_enterloop);
%skip_invalidate = init_hash qw(pp_enter pp_enterloop);
+%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 );
sub debug {
if ($debug_runtime) {
sub gimme {
my $op = shift;
my $flags = $op->flags;
- return (($flags & OPf_KNOW) ? ($flags & OPf_LIST) : "dowantarray()");
+ return (($flags & OPf_WANT) ? ($flags & OPf_WANT_LIST) : "dowantarray()");
}
#
return default_pp($op);
}
-sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
-sub pp_bless { $curcop->write_back; default_pp(@_) }
-sub pp_repeat { $curcop->write_back; default_pp(@_) }
+#default_pp will handle this:
+#sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
+#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_sort { $curcop->write_back; default_pp(@_) }
-sub pp_caller { $curcop->write_back; default_pp(@_) }
-sub pp_reset { $curcop->write_back; default_pp(@_) }
+#sub pp_sort { $curcop->write_back; default_pp(@_) }
+#sub pp_caller { $curcop->write_back; default_pp(@_) }
+#sub pp_reset { $curcop->write_back; default_pp(@_) }
sub pp_gv {
my $op = shift;
}
} else {
if ($force_int) {
+ my $rightruntime = new B::Pseudoreg ("IV", "riv");
+ runtime(sprintf("$$rightruntime = %s;",$right));
runtime(sprintf("sv_setiv(TOPs, %s);",
- &$operator("TOPi", $right)));
+ &$operator("TOPi", $$rightruntime)));
} else {
+ my $rightruntime = new B::Pseudoreg ("double", "rnv");
+ runtime(sprintf("$$rightruntime = %s;",$right));
runtime(sprintf("sv_setnv(TOPs, %s);",
- &$operator("TOPn", $right)));
+ &$operator("TOPn",$$rightruntime)));
}
}
} else {
sub pp_range {
my $op = shift;
my $flags = $op->flags;
- if (!($flags & OPf_KNOW)) {
+ if (!($flags & OPf_WANT)) {
error("context of range unknown at compile-time");
}
write_back_lexicals();
write_back_stack();
- if (!($flags & OPf_LIST)) {
+ if (!($flags & OPf_WANT_LIST)) {
# 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;
sub pp_flip {
my $op = shift;
my $flags = $op->flags;
- if (!($flags & OPf_KNOW)) {
+ if (!($flags & OPf_WANT)) {
error("context of flip unknown at compile-time");
}
- if ($flags & OPf_LIST) {
+ if ($flags & OPf_WANT_LIST) {
return $op->first->false;
}
write_back_lexicals();
sub default_pp {
my $op = shift;
my $ppname = $op->ppaddr;
+ if ($curcop and $need_curcop{$ppname}){
+ $curcop->write_back;
+ }
write_back_lexicals() unless $skip_lexicals{$ppname};
write_back_stack() unless $skip_stack{$ppname};
doop($op);
);
}
+ seek(STDOUT,0,0); #prevent print statements from BEGIN{} into the output
output_boilerplate();
print "\n";
output_all("perl_init");