get Compiler "working" under useithreads

[p5sagit/p5-mst-13.2.git] / ext / B / B / Xref.pm

diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm
index 53b655c..0a5ceab 100644 (file)
--- a/ext/B/B/Xref.pm
+++ b/ext/B/B/Xref.pm
@@ -85,6 +85,7 @@ Malcolm Beattie, mbeattie@sable.ox.ac.uk.
 =cut
 
 use strict;
+use Config;
 use B qw(peekop class comppadlist main_start svref_2object walksymtable
          OPpLVAL_INTRO SVf_POK
         );
@@ -133,10 +134,10 @@ sub process {
 
 sub load_pad {
     my $padlist = shift;
-    my ($namelistav, @namelist, $ix);
+    my ($namelistav, $vallistav, @namelist, $ix);
     @pad = ();
     return if class($padlist) eq "SPECIAL";
-    ($namelistav) = $padlist->ARRAY;
+    ($namelistav,$vallistav) = $padlist->ARRAY;
     @namelist = $namelistav->ARRAY;
     for ($ix = 1; $ix < @namelist; $ix++) {
        my $namesv = $namelist[$ix];
@@ -144,6 +145,17 @@ sub load_pad {
        my ($type, $name) = $namesv->PV =~ /^(.)([^\0]*)(\0.*)?$/;
        $pad[$ix] = ["(lexical)", $type, $name];
     }
+    if ($Config{useithreads}) {
+       my (@vallist);
+       @vallist = $vallistav->ARRAY;
+       for ($ix = 1; $ix < @vallist; $ix++) {
+           my $valsv = $vallist[$ix];
+           next unless class($valsv) eq "GV";
+           # these pad GVs don't have corresponding names, so same @pad
+           # array can be used without collisions
+           $pad[$ix] = [$valsv->STASH->NAME, "*", $valsv->NAME];
+       }
+    }
 }
 
 sub xref {
@@ -229,23 +241,45 @@ sub pp_rv2gv { deref($top, "*"); }
 
 sub pp_gvsv {
     my $op = shift;
-    my $gv = $op->gv;
-    $top = [$gv->STASH->NAME, '$', $gv->NAME];
+    my $gv;
+    if ($Config{useithreads}) {
+       $top = $pad[$op->padix];
+       $top = UNKNOWN unless $top;
+       $top->[1] = '$';
+    }
+    else {
+       $gv = $op->gv;
+       $top = [$gv->STASH->NAME, '$', $gv->NAME];
+    }
     process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
 }
 
 sub pp_gv {
     my $op = shift;
-    my $gv = $op->gv;
-    $top = [$gv->STASH->NAME, "*", $gv->NAME];
+    my $gv;
+    if ($Config{useithreads}) {
+       $top = $pad[$op->padix];
+       $top = UNKNOWN unless $top;
+       $top->[1] = '*';
+    }
+    else {
+       $gv = $op->gv;
+       $top = [$gv->STASH->NAME, "*", $gv->NAME];
+    }
     process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
 }
 
 sub pp_const {
     my $op = shift;
     my $sv = $op->sv;
-    $top = ["?", "",
-           (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
+    # constant could be in the pad (under useithreads)
+    if ($$sv) {
+       $top = ["?", "",
+               (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
+    }
+    else {
+       $top = $pad[$op->targ];
+    }
 }
 
 sub pp_method {