integrate cfgperl changes into mainline, fix conflicts
[p5sagit/p5-mst-13.2.git] / ext / B / B / CC.pm
index e4f8877..d9cf119 100644 (file)
@@ -8,7 +8,12 @@
 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);
@@ -16,26 +21,6 @@ use B::Stackobj qw(:types :flags);
 
 # 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
@@ -66,6 +51,7 @@ my %skip_stack;               # Hash of PP names which don't need write_back_stack
 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)) {
@@ -106,6 +92,7 @@ sub init_hash { map { $_ => 1 } @_ }
 #
 %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) {
@@ -457,7 +444,7 @@ sub doop {
 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()");
 }
 
 #
@@ -580,14 +567,15 @@ sub pp_dbstate {
     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;
@@ -1077,12 +1065,12 @@ sub nyi {
 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;
@@ -1096,10 +1084,10 @@ sub pp_range {
 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();
@@ -1278,6 +1266,9 @@ sub pp_substcont {
 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);