use Exporter (); # use #5
-our $VERSION = "0.98";
+our $VERSION = "1.001";
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( set_style set_style_standard add_callback
concise_subref concise_cv concise_main
# use #6
use B qw(class ppname main_start main_root main_cv cstring svref_2object
SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL
+ OPf_STACKED
+ OPpSPLIT_ASSIGN OPpSPLIT_LEX
CVf_ANON PAD_FAKELEX_ANON PAD_FAKELEX_MULTI SVf_ROK);
my %style =
"gt_#seq ",
"(?(#seq)?)#noise#arg(?([#targarg])?)"],
"debug" =>
- ["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
+ ["#class (#addr)\n\top_next\t\t#nextaddr\n\t(?(op_other\t#otheraddr\n\t)?)"
+ . "op_sibling\t#sibaddr\n\t"
. "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n"
. "\top_flags\t#flagval\n\top_private\t#privval\t#hintsval\n"
. "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
sub concise_stashref {
my($order, $h) = @_;
- local *s;
+ my $name = svref_2object($h)->NAME;
foreach my $k (sort keys %$h) {
next unless defined $h->{$k};
- *s = $h->{$k};
- my $coderef = *s{CODE} or next;
+ my $coderef = ref $h->{$k} eq 'CODE' ? $h->{$k}
+ : ref\$h->{$k} eq 'GLOB' ? *{$h->{$k}}{CODE} || next
+ : next;
reset_sequence();
- print "FUNC: ", *s, "\n";
+ print "FUNC: *", $name, "::", $k, "\n";
my $codeobj = svref_2object($coderef);
next unless ref $codeobj eq 'B::CV';
eval { concise_cv_obj($order, $codeobj, $k) };
my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
- 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#");
+ 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#",
+ 'METHOP' => '.', UNOP_AUX => '+');
no warnings 'qw'; # "Possible attempt to put comments..."; use #7
my @linenoise =
}
}
if (class($op) eq "PMOP") {
- my $maybe_root = $op->pmreplroot;
+ my $maybe_root = $op->code_list;
+ if ( ref($maybe_root) and $maybe_root->isa("B::OP")
+ and not $op->flags & OPf_KIDS) {
+ walk_topdown($maybe_root, $sub, $level + 1);
+ }
+ $maybe_root = $op->pmreplroot;
if (ref($maybe_root) and $maybe_root->isa("B::OP")) {
# It really is the root of the replacement, not something
# else stored here for lack of space elsewhere
for (; $$op; $op = $op->next) {
last if exists $sequence_num{$$op};
my $name = $op->name;
- if ($name =~ /^(null|scalar|lineseq|scope)$/) {
- next if $oldop and $ {$op->next};
- } else {
- $sequence_num{$$op} = $seq_max++;
- if (class($op) eq "LOGOP") {
- my $other = $op->other;
- $other = $other->next while $other->name eq "null";
- sequence($other);
- } elsif (class($op) eq "LOOP") {
- my $redoop = $op->redoop;
- $redoop = $redoop->next while $redoop->name eq "null";
- sequence($redoop);
- my $nextop = $op->nextop;
- $nextop = $nextop->next while $nextop->name eq "null";
- sequence($nextop);
- my $lastop = $op->lastop;
- $lastop = $lastop->next while $lastop->name eq "null";
- sequence($lastop);
- } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
- my $replstart = $op->pmreplstart;
- $replstart = $replstart->next while $replstart->name eq "null";
- sequence($replstart);
- }
+ $sequence_num{$$op} = $seq_max++;
+ if (class($op) eq "LOGOP") {
+ sequence($op->other);
+ } elsif (class($op) eq "LOOP") {
+ sequence($op->redoop);
+ sequence( $op->nextop);
+ sequence($op->lastop);
+ } elsif ($name eq "subst" and $ {$op->pmreplstart}) {
+ sequence($op->pmreplstart);
}
$oldop = $op;
}
return $text; # suppress empty lines
}
-our %priv; # used to display each opcode's BASEOP.op_private values
-
-$priv{$_}{128} = "LVINTRO"
- for qw(pos substr vec threadsv gvsv rv2sv rv2hv rv2gv rv2av rv2arylen
- aelem helem aslice hslice padsv padav padhv enteriter entersub
- padrange pushmark);
-$priv{$_}{64} = "REFC" for qw(leave leavesub leavesublv leavewrite);
-@{$priv{aassign}}{32,64} = qw(STATE COMMON);
-@{$priv{sassign}}{32,64,128} = qw(STATE BKWARD CV2GV);
-$priv{$_}{64} = "RTIME" for qw(match subst substcont qr);
-@{$priv{$_}}{1,2,4,8,16,64} = qw(<UTF >UTF IDENT SQUASH DEL COMPL GROWS)
- for qw(trans transr);
-$priv{repeat}{64} = "DOLIST";
-$priv{leaveloop}{64} = "CONT";
-$priv{$_}{4} = "DREFed" for qw(rv2sv rv2av rv2hv);
-@{$priv{$_}}{32,64,96} = qw(DREFAV DREFHV DREFSV)
- for qw(rv2gv rv2sv padsv aelem helem);
-$priv{$_}{16} = "STATE" for qw(padav padhv padsv);
-@{$priv{rv2gv}}{4,16} = qw(NOINIT FAKE);
-@{$priv{entersub}}{1,4,16,32,64} = qw(INARGS TARG DBG DEREF);
-@{$priv{rv2cv}}{1,8,128} = qw(CONST AMPER NO());
-$priv{gv}{32} = "EARLYCV";
-$priv{$_}{16} = "LVDEFER" for qw(aelem helem);
-$priv{$_}{16} = "OURINTR" for qw(gvsv rv2sv rv2av rv2hv r2gv enteriter);
-$priv{$_}{8} = "LVSUB"
- for qw(rv2av rv2gv rv2hv padav padhv aelem helem aslice hslice
- av2arylen keys rkeys substr pos vec);
-@{$priv{$_}}{32,64} = qw(BOOL BOOL?) for qw(rv2hv padhv);
-$priv{substr}{16} = "REPL1ST";
-$priv{$_}{16} = "TARGMY"
- for map(($_,"s$_"), qw(chop chomp)),
- map(($_,"i_$_"), qw(postinc postdec multiply divide modulo add
- subtract negate)),
- qw(pow concat stringify left_shift right_shift bit_and bit_xor
- bit_or complement atan2 sin cos rand exp log sqrt int hex oct
- abs length index rindex sprintf ord chr crypt quotemeta join
- push unshift flock chdir chown chroot unlink chmod utime rename
- link symlink mkdir rmdir wait waitpid system exec kill getppid
- getpgrp setpgrp getpriority setpriority time sleep);
-$priv{$_}{4} = "REVERSED" for qw(enteriter iter);
-@{$priv{const}}{2,4,8,16,64,128} = qw(NOVER SHORT STRICT ENTERED BARE FOLD);
-$priv{$_}{64} = "LINENUM" for qw(flip flop);
-$priv{list}{64} = "GUESSED";
-$priv{delete}{64} = "SLICE";
-$priv{exists}{64} = "SUB";
-@{$priv{sort}}{1,2,4,8,16,32,64} = qw(NUM INT REV INPLACE DESC QSORT STABLE);
-$priv{reverse}{8} = "INPLACE";
-$priv{threadsv}{64} = "SVREFd";
-@{$priv{$_}}{16,32,64,128} = qw(INBIN INCR OUTBIN OUTCR)
- for qw(open backtick);
-$priv{exit}{128} = "VMS";
-$priv{$_}{2} = "FTACCESS"
- for qw(ftrread ftrwrite ftrexec fteread ftewrite fteexec);
-@{$priv{entereval}}{2,4,8,16} = qw(HAS_HH UNI BYTES COPHH);
-@{$priv{$_}}{4,8,16} = qw(FTSTACKED FTSTACKING FTAFTERt)
- for qw(ftrread ftrwrite ftrexec fteread ftewrite fteexec ftis fteowned
- ftrowned ftzero ftsize ftmtime ftatime ftctime ftsock ftchr
- ftblk ftfile ftdir ftpipe ftlink ftsuid ftsgid ftsvtx fttty
- fttext ftbinary);
-$priv{$_}{2} = "GREPLEX"
- for qw(mapwhile mapstart grepwhile grepstart);
-$priv{$_}{128} = "+1" for qw(caller wantarray runcv);
-@{$priv{coreargs}}{1,2,64,128} = qw(DREF1 DREF2 $MOD MARK);
-$priv{$_}{128} = "UTF" for qw(last redo next goto dump);
-$priv{split}{128} = "IMPLIM";
+
+
+# use require rather than use here to avoid disturbing tests that dump
+# BEGIN blocks
+require B::Op_private;
+
+
our %hints; # used to display each COP's op_hints values
# strict refs, subs, vars
-@hints{2,512,1024,32,64,128} = ('$', '&', '*', 'x$', 'x&', 'x*');
+@hints{0x2,0x200,0x400,0x20,0x40,0x80} = ('$', '&', '*', 'x$', 'x&', 'x*');
# integers, locale, bytes
-@hints{1,4,8,16} = ('i', 'l', 'b');
+@hints{0x1,0x4,0x8,0x10} = ('i', 'l', 'b');
# block scope, localise %^H, $^OPEN (in), $^OPEN (out)
-@hints{256,131072,262144,524288} = ('{','%','<','>');
+@hints{0x100,0x20000,0x40000,0x80000} = ('{','%','<','>');
# overload new integer, float, binary, string, re
-@hints{4096,8192,16384,32768,65536} = ('I', 'F', 'B', 'S', 'R');
+@hints{0x1000,0x2000,0x4000,0x8000,0x10000} = ('I', 'F', 'B', 'S', 'R');
# taint and eval
-@hints{1048576,2097152} = ('T', 'E');
-# filetest access, UTF-8
-@hints{4194304,8388608} = ('X', 'U');
+@hints{0x100000,0x200000} = ('T', 'E');
+# filetest access, use utf8, unicode_strings feature
+@hints{0x400000,0x800000,0x800} = ('X', 'U', 'us');
+
+# pick up the feature hints constants.
+# Note that we're relying on non-API parts of feature.pm,
+# but its less naughty than just blindly copying those constants into
+# this src file.
+#
+require feature;
-sub _flags {
- my($hash, $x) = @_;
+sub hints_flags {
+ my($x) = @_;
my @s;
- for my $flag (sort {$b <=> $a} keys %$hash) {
- if ($hash->{$flag} and $x & $flag and $x >= $flag) {
+ for my $flag (sort {$b <=> $a} keys %hints) {
+ if ($hints{$flag} and $x & $flag and $x >= $flag) {
$x -= $flag;
- push @s, $hash->{$flag};
+ push @s, $hints{$flag};
}
}
- push @s, $x if $x;
+ if ($x & $feature::hint_mask) {
+ push @s, "fea=" . (($x & $feature::hint_mask) >> $feature::hint_shift);
+ $x &= ~$feature::hint_mask;
+ }
+ push @s, sprintf "0x%x", $x if $x;
return join(",", @s);
}
+
+# return a string like 'LVINTRO,1' for the op $name with op_private
+# value $x
+
sub private_flags {
my($name, $x) = @_;
- _flags($priv{$name}, $x);
-}
+ my $entry = $B::Op_private::bits{$name};
+ return $x ? "$x" : '' unless $entry;
+
+ my @flags;
+ my $bit;
+ for ($bit = 7; $bit >= 0; $bit--) {
+ next unless exists $entry->{$bit};
+ my $e = $entry->{$bit};
+ if (ref($e) eq 'HASH') {
+ # bit field
+
+ my ($bitmin, $bitmax, $bitmask, $enum, $label) =
+ @{$e}{qw(bitmin bitmax bitmask enum label)};
+ $bit = $bitmin;
+ next if defined $label && $label eq '-'; # display as raw number
+
+ my $val = $x & $bitmask;
+ $x &= ~$bitmask;
+ $val >>= $bitmin;
+
+ if (defined $enum) {
+ # try to convert numeric $val into symbolic
+ my @enum = @$enum;
+ while (@enum) {
+ my $ix = shift @enum;
+ my $name = shift @enum;
+ my $label = shift @enum;
+ if ($val == $ix) {
+ $val = $label;
+ last;
+ }
+ }
+ }
+ next if $val eq '0'; # don't display anonymous zero values
+ push @flags, defined $label ? "$label=$val" : $val;
+
+ }
+ else {
+ # flag bit
+ my $label = $B::Op_private::labels{$e};
+ next if defined $label && $label eq '-'; # display as raw number
+ if ($x & (1<<$bit)) {
+ $x -= (1<<$bit);
+ push @flags, $label;
+ }
+ }
+ }
-sub hints_flags {
- my($x) = @_;
- _flags(\%hints, $x);
+ push @flags, $x if $x; # display unknown bits numerically
+ return join ",", @flags;
}
sub concise_sv {
}
}
if (class($sv) eq "SPECIAL") {
- $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
+ $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no",
+ '', '', '', "sv_zero"]->[$$sv];
} elsif ($preferpv
- && ($sv->FLAGS & SVf_POK || class($sv) eq "REGEXP")) {
+ && ($sv->FLAGS & SVf_POK)) {
$hr->{svval} .= cstring($sv->PV);
} elsif ($sv->FLAGS & SVf_NOK) {
$hr->{svval} .= $sv->NV;
} elsif ($sv->FLAGS & SVf_IOK) {
$hr->{svval} .= $sv->int_value;
- } elsif ($sv->FLAGS & SVf_POK || class($sv) eq "REGEXP") {
+ } elsif ($sv->FLAGS & SVf_POK) {
$hr->{svval} .= cstring($sv->PV);
} elsif (class($sv) eq "HV") {
$hr->{svval} .= 'HASH';
$srclines{$fullnm} = \@l;
}
+# Given a pad target, return the pad var's name and cop range /
+# fakeness, or failing that, its target number.
+# e.g.
+# ('$i', '$i:5,7')
+# or
+# ('$i', '$i:fake:a')
+# or
+# ('t5', 't5')
+
+sub padname {
+ my ($targ) = @_;
+
+ my ($targarg, $targarglife);
+ my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$targ];
+ if (defined $padname and class($padname) ne "SPECIAL" and
+ $padname->LEN)
+ {
+ $targarg = $padname->PVX;
+ if ($padname->FLAGS & SVf_FAKE) {
+ # These changes relate to the jumbo closure fix.
+ # See changes 19939 and 20005
+ my $fake = '';
+ $fake .= 'a'
+ if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON;
+ $fake .= 'm'
+ if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI;
+ $fake .= ':' . $padname->PARENT_PAD_INDEX
+ if $curcv->CvFLAGS & CVf_ANON;
+ $targarglife = "$targarg:FAKE:$fake";
+ }
+ else {
+ my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base;
+ my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base;
+ $finish = "end" if $finish == 999999999 - $cop_seq_base;
+ $targarglife = "$targarg:$intro,$finish";
+ }
+ } else {
+ $targarglife = $targarg = "t" . $targ;
+ }
+ return $targarg, $targarglife;
+}
+
+
+
sub concise_op {
my ($op, $level, $format) = @_;
my %h;
$h{class} = class($op);
$h{extarg} = $h{targ} = $op->targ;
$h{extarg} = "" unless $h{extarg};
- if ($h{name} eq "null" and $h{targ}) {
- # targ holds the old type
- $h{exname} = "ex-" . substr(ppname($h{targ}), 3);
+ $h{privval} = $op->private;
+ # for null ops, targ holds the old type
+ my $origname = $h{name} eq "null" && $h{targ}
+ ? substr(ppname($h{targ}), 3)
+ : $h{name};
+ $h{private} = private_flags($origname, $op->private);
+ if ($op->folded) {
+ $h{private} &&= "$h{private},";
+ $h{private} .= "FOLD";
+ }
+
+ if ($h{name} ne $origname) { # a null op
+ $h{exname} = "ex-$origname";
$h{extarg} = "";
- } elsif ($op->name =~ /^leave(sub(lv)?|write)?$/) {
- # targ potentially holds a reference count
- if ($op->private & 64) {
- my $refs = "ref" . ($h{targ} != 1 ? "s" : "");
- $h{targarglife} = $h{targarg} = "$h{targ} $refs";
- }
+ } elsif ($h{private} =~ /\bREFC\b/) {
+ # targ holds a reference count
+ my $refs = "ref" . ($h{targ} != 1 ? "s" : "");
+ $h{targarglife} = $h{targarg} = "$h{targ} $refs";
} elsif ($h{targ}) {
- my $count = $h{name} eq 'padrange' ? ($op->private & 127) : 1;
+ my $count = $h{name} eq 'padrange'
+ ? ($op->private & $B::Op_private::defines{'OPpPADRANGE_COUNTMASK'})
+ : 1;
my (@targarg, @targarglife);
for my $i (0..$count-1) {
- my ($targarg, $targarglife);
- my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}+$i];
- if (defined $padname and class($padname) ne "SPECIAL") {
- $targarg = $padname->PVX;
- if ($padname->FLAGS & SVf_FAKE) {
- # These changes relate to the jumbo closure fix.
- # See changes 19939 and 20005
- my $fake = '';
- $fake .= 'a'
- if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON;
- $fake .= 'm'
- if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI;
- $fake .= ':' . $padname->PARENT_PAD_INDEX
- if $curcv->CvFLAGS & CVf_ANON;
- $targarglife = "$targarg:FAKE:$fake";
- }
- else {
- my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base;
- my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base;
- $finish = "end" if $finish == 999999999 - $cop_seq_base;
- $targarglife = "$targarg:$intro,$finish";
- }
- } else {
- $targarglife = $targarg = "t" . ($h{targ}+$i);
- }
+ my ($targarg, $targarglife) = padname($h{targ} + $i);
push @targarg, $targarg;
push @targarglife, $targarglife;
}
$h{targarg} = join '; ', @targarg;
$h{targarglife} = join '; ', @targarglife;
}
+
$h{arg} = "";
$h{svclass} = $h{svaddr} = $h{svval} = "";
if ($h{class} eq "PMOP") {
$extra = " replstart->" . seq($op->pmreplstart);
}
}
- elsif ($op->name eq 'pushre') {
- # with C<@stash_array = split(/pat/, str);>,
- # *stash_array is stored in /pat/'s pmreplroot.
- my $gv = $op->pmreplroot;
- if (!ref($gv)) {
- # threaded: the value is actually a pad offset for where
- # the GV is kept (op_pmtargetoff)
- if ($gv) {
- $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$gv]->NAME;
- }
- }
- else {
- # unthreaded: its a GV (if it exists)
- $gv = (ref($gv) eq "B::GV") ? $gv->NAME : undef;
- }
- $extra = " => \@$gv" if $gv;
+ elsif ($op->name eq 'split') {
+ if ( ($op->private & OPpSPLIT_ASSIGN) # @array = split
+ && (not $op->flags & OPf_STACKED)) # @{expr} = split
+ {
+ # with C<@array = split(/pat/, str);>,
+ # array is stored in /pat/'s pmreplroot; either
+ # as an integer index into the pad (for a lexical array)
+ # or as GV for a package array (which will be a pad index
+ # on threaded builds)
+
+ if ($op->private & $B::Op_private::defines{'OPpSPLIT_LEX'}) {
+ my $off = $op->pmreplroot; # union with op_pmtargetoff
+ my ($name, $full) = padname($off);
+ $extra = " => $full";
+ }
+ else {
+ # union with op_pmtargetoff, op_pmtargetgv
+ my $gv = $op->pmreplroot;
+ if (!ref($gv)) {
+ # the value is actually a pad offset
+ $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$gv]->NAME;
+ }
+ else {
+ # unthreaded: its a GV
+ $gv = $gv->NAME;
+ }
+ $extra = " => \@$gv";
+ }
+ }
}
$h{arg} = "($precomp$extra)";
} elsif ($h{class} eq "PVOP" and $h{name} !~ '^transr?\z') {
} elsif ($h{class} eq "LOGOP") {
undef $lastnext;
$h{arg} = "(other->" . seq($op->other) . ")";
+ $h{otheraddr} = sprintf("%#x", $ {$op->other});
+ if ($h{name} eq "argdefelem") {
+ # targ used for element index
+ $h{targarglife} = $h{targarg} = "";
+ $h{arg} .= "[" . $op->targ . "]";
+ }
}
elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") {
unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) {
my $idx = ($h{class} eq "SVOP") ? $op->targ : $op->padix;
- my $preferpv = $h{name} eq "method_named";
if ($h{class} eq "PADOP" or !${$op->sv}) {
my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$idx];
- $h{arg} = "[" . concise_sv($sv, \%h, $preferpv) . "]";
+ $h{arg} = "[" . concise_sv($sv, \%h, 0) . "]";
$h{targarglife} = $h{targarg} = "";
} else {
- $h{arg} = "(" . concise_sv($op->sv, \%h, $preferpv) . ")";
+ $h{arg} = "(" . concise_sv($op->sv, \%h, 0) . ")";
}
}
}
+ elsif ($h{class} eq "METHOP") {
+ my $prefix = '';
+ if ($h{name} eq 'method_redir' or $h{name} eq 'method_redir_super') {
+ my $rclass_sv = $op->rclass;
+ $rclass_sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$rclass_sv]
+ unless ref $rclass_sv;
+ $prefix .= 'PACKAGE "'.$rclass_sv->PV.'", ';
+ }
+ if ($h{name} ne "method") {
+ if (${$op->meth_sv}) {
+ $h{arg} = "($prefix" . concise_sv($op->meth_sv, \%h, 1) . ")";
+ } else {
+ my $sv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$op->targ];
+ $h{arg} = "[$prefix" . concise_sv($sv, \%h, 1) . "]";
+ $h{targarglife} = $h{targarg} = "";
+ }
+ }
+ }
+ elsif ($h{class} eq "UNOP_AUX") {
+ $h{arg} = "(" . $op->string($curcv) . ")";
+ }
+
$h{seq} = $h{hyphseq} = seq($op);
$h{seq} = "" if $h{seq} eq "-";
$h{opt} = $op->opt;
$h{classsym} = $opclass{$h{class}};
$h{flagval} = $op->flags;
$h{flags} = op_flags($op->flags);
- $h{privval} = $op->private;
- $h{private} = private_flags($h{name}, $op->private);
if ($op->can("hints")) {
$h{hintsval} = $op->hints;
$h{hints} = hints_flags($h{hintsval});
# to update the corresponding magic number in the next line.
# Remember, this needs to stay the last things in the module.
-# Why is this different for MacOS? Does it matter?
-my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11;
+my $cop_seq_mnum = 12;
$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum;
1;
0 OP (aka BASEOP) An OP with no children
1 UNOP An OP with one child
+ + UNOP_AUX A UNOP with auxillary fields
2 BINOP An OP with two children
| LOGOP A control branch OP
@ LISTOP An OP that could have lots of children
{ LOOP An OP that holds pointers for a loop
; COP An OP that marks the start of a statement
# PADOP An OP with a GV on the pad
+ . METHOP An OP with method call info
=head2 OP flags abbreviations
They're opcode specific, and occur less often than the public ones, so
they're represented by short mnemonics instead of single-chars; see
-F<op.h> for gory details, or try this quick 2-liner:
-
- $> perl -MB::Concise -de 1
- DB<1> |x \%B::Concise::priv
+B::Op_private and F<regen/op_private> for more details.
=head1 FORMATTING SPECIFICATIONS
X filetest access
U utf-8
+ us use feature 'unicode_strings'
+ fea=NNN feature bundle number
+
=item B<#hintsval>
The numeric value of the COP's hint flags, or an empty string if this is not
https://perl5.git.perl.org / perl5.git / blobdiff