X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB%2FXref.pm;h=0a5ceabda1e358a06ef50efa50c621742dece940;hb=18228111eab2b4346ec4a982338c6a12fe2ee3a2;hp=53b655c82edb9066f5f12f149a45bf4f426c316e;hpb=2ba999ece4e8727143f109b401921cec33e5b6dc;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm
index 53b655c..0a5ceab 100644
--- 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 {