=cut
use strict;
+use Config;
use B qw(peekop class comppadlist main_start svref_2object walksymtable
OPpLVAL_INTRO SVf_POK
);
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];
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 {
sub pp_nextstate {
my $op = shift;
- $file = $op->filegv->SV->PV;
+ $file = $op->file;
$line = $op->line;
$top = UNKNOWN;
}
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 {
my $cv = $gv->CV;
if ($$cv) {
#return if $done{$$cv}++;
- $file = $gv->FILEGV->SV->PV;
+ $file = $gv->FILE;
$line = $gv->LINE;
process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
push(@todo, $cv);
my $form = $gv->FORM;
if ($$form) {
return if $done{$$form}++;
- $file = $gv->FILEGV->SV->PV;
+ $file = $gv->FILE;
$line = $gv->LINE;
process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
}
my ($pack, %exclude);
return if $nodefs;
$subname = "(definitions)";
- foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS
+ foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS
strict vars FileHandle Exporter Carp)) {
$exclude{$pack."::"} = 1;
}