KevinSchoenmayer/GseTDDUebungKCLR
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1920
database/perl/lib/B/Concise.pm Normal file
View File

File diff suppressed because it is too large Load Diff

6990
database/perl/lib/B/Deparse.pm Normal file
View File

File diff suppressed because it is too large Load Diff

900
database/perl/lib/B/Op_private.pm Normal file
View File

@@ -0,0 +1,900 @@
# -*- buffer-read-only: t -*-
#
# lib/B/Op_private.pm
#
# Copyright (C) 2014 by Larry Wall and others
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the README file.
#
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
# This file is built by regen/opcode.pl from data in
# regen/op_private and pod embedded in regen/opcode.pl.
# Any changes made here will be lost!
=head1 NAME
B::Op_private - OP op_private flag definitions
=head1 SYNOPSIS
use B::Op_private;
# flag details for bit 7 of OP_AELEM's op_private:
my $name = $B::Op_private::bits{aelem}{7}; # OPpLVAL_INTRO
my $value = $B::Op_private::defines{$name}; # 128
my $label = $B::Op_private::labels{$name}; # LVINTRO
# the bit field at bits 5..6 of OP_AELEM's op_private:
my $bf = $B::Op_private::bits{aelem}{6};
my $mask = $bf->{bitmask}; # etc
=head1 DESCRIPTION
This module provides four global hashes:
%B::Op_private::bits
%B::Op_private::defines
%B::Op_private::labels
%B::Op_private::ops_using
which contain information about the per-op meanings of the bits in the
op_private field.
=head2 C<%bits>
This is indexed by op name and then bit number (0..7). For single bit flags,
it returns the name of the define (if any) for that bit:
$B::Op_private::bits{aelem}{7} eq 'OPpLVAL_INTRO';
For bit fields, it returns a hash ref containing details about the field.
The same reference will be returned for all bit positions that make
up the bit field; so for example these both return the same hash ref:
$bitfield = $B::Op_private::bits{aelem}{5};
$bitfield = $B::Op_private::bits{aelem}{6};
The general format of this hash ref is
{
# The bit range and mask; these are always present.
bitmin => 5,
bitmax => 6,
bitmask => 0x60,
# (The remaining keys are optional)
# The names of any defines that were requested:
mask_def => 'OPpFOO_MASK',
baseshift_def => 'OPpFOO_SHIFT',
bitcount_def => 'OPpFOO_BITS',
# If present, Concise etc will display the value with a 'FOO='
# prefix. If it equals '-', then Concise will treat the bit
# field as raw bits and not try to interpret it.
label => 'FOO',
# If present, specifies the names of some defines and the
# display labels that are used to assign meaning to particu-
# lar integer values within the bit field; e.g. 3 is dis-
# played as 'C'.
enum => [ qw(
1 OPpFOO_A A
2 OPpFOO_B B
3 OPpFOO_C C
)],
};
=head2 C<%defines>
This gives the value of every C<OPp> define, e.g.
$B::Op_private::defines{OPpLVAL_INTRO} == 128;
=head2 C<%labels>
This gives the short display label for each define, as used by C<B::Concise>
and C<perl -Dx>, e.g.
$B::Op_private::labels{OPpLVAL_INTRO} eq 'LVINTRO';
If the label equals '-', then Concise will treat the bit as a raw bit and
not try to display it symbolically.
=head2 C<%ops_using>
For each define, this gives a reference to an array of op names that use
the flag.
@ops_using_lvintro = @{ $B::Op_private::ops_using{OPp_LVAL_INTRO} };
=cut
package B::Op_private;
our %bits;
our $VERSION = "5.032001";
$bits{$_}{3} = 'OPpENTERSUB_AMPER' for qw(entersub rv2cv);
$bits{$_}{6} = 'OPpENTERSUB_DB' for qw(entersub rv2cv);
$bits{$_}{2} = 'OPpENTERSUB_HASTARG' for qw(entersub rv2cv);
$bits{$_}{6} = 'OPpFLIP_LINENUM' for qw(flip flop);
$bits{$_}{1} = 'OPpFT_ACCESS' for qw(fteexec fteread ftewrite ftrexec ftrread ftrwrite);
$bits{$_}{4} = 'OPpFT_AFTER_t' for qw(ftatime ftbinary ftblk ftchr ftctime ftdir fteexec fteowned fteread ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned ftrread ftrwrite ftsgid ftsize ftsock ftsuid ftsvtx fttext fttty ftzero);
$bits{$_}{2} = 'OPpFT_STACKED' for qw(ftatime ftbinary ftblk ftchr ftctime ftdir fteexec fteowned fteread ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned ftrread ftrwrite ftsgid ftsize ftsock ftsuid ftsvtx fttext fttty ftzero);
$bits{$_}{3} = 'OPpFT_STACKING' for qw(ftatime ftbinary ftblk ftchr ftctime ftdir fteexec fteowned fteread ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned ftrread ftrwrite ftsgid ftsize ftsock ftsuid ftsvtx fttext fttty ftzero);
$bits{$_}{1} = 'OPpHINT_STRICT_REFS' for qw(entersub multideref rv2av rv2cv rv2gv rv2hv rv2sv);
$bits{$_}{5} = 'OPpHUSH_VMSISH' for qw(dbstate nextstate);
$bits{$_}{6} = 'OPpINDEX_BOOLNEG' for qw(index rindex);
$bits{$_}{1} = 'OPpITER_REVERSED' for qw(enteriter iter);
$bits{$_}{7} = 'OPpLVALUE' for qw(leave leaveloop);
$bits{$_}{6} = 'OPpLVAL_DEFER' for qw(aelem helem multideref);
$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multiconcat multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv split);
$bits{$_}{2} = 'OPpLVREF_ELEM' for qw(lvref refassign);
$bits{$_}{3} = 'OPpLVREF_ITER' for qw(lvref refassign);
$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr values vec);
$bits{$_}{4} = 'OPpMAYBE_TRUEBOOL' for qw(padhv ref rv2hv);
$bits{$_}{7} = 'OPpOFFBYONE' for qw(caller runcv wantarray);
$bits{$_}{5} = 'OPpOPEN_IN_CRLF' for qw(backtick open);
$bits{$_}{4} = 'OPpOPEN_IN_RAW' for qw(backtick open);
$bits{$_}{7} = 'OPpOPEN_OUT_CRLF' for qw(backtick open);
$bits{$_}{6} = 'OPpOPEN_OUT_RAW' for qw(backtick open);
$bits{$_}{6} = 'OPpOUR_INTRO' for qw(enteriter gvsv rv2av rv2hv rv2sv split);
$bits{$_}{6} = 'OPpPAD_STATE' for qw(lvavref lvref padav padhv padsv pushmark refassign);
$bits{$_}{7} = 'OPpPV_IS_UTF8' for qw(dump goto last next redo);
$bits{$_}{6} = 'OPpREFCOUNTED' for qw(leave leaveeval leavesub leavesublv leavewrite);
$bits{$_}{2} = 'OPpSLICEWARNING' for qw(aslice hslice padav padhv rv2av rv2hv);
$bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid);
$bits{$_}{0} = 'OPpTRANS_CAN_FORCE_UTF8' for qw(trans transr);
$bits{$_}{5} = 'OPpTRANS_COMPLEMENT' for qw(trans transr);
$bits{$_}{7} = 'OPpTRANS_DELETE' for qw(trans transr);
$bits{$_}{6} = 'OPpTRANS_GROWS' for qw(trans transr);
$bits{$_}{2} = 'OPpTRANS_IDENTICAL' for qw(trans transr);
$bits{$_}{3} = 'OPpTRANS_SQUASH' for qw(trans transr);
$bits{$_}{1} = 'OPpTRANS_USE_SVOP' for qw(trans transr);
$bits{$_}{5} = 'OPpTRUEBOOL' for qw(grepwhile index length padav padhv pos ref rindex rv2av rv2hv subst);
my @bf = (
{
label => '-',
mask_def => 'OPpARG1_MASK',
bitmin => 0,
bitmax => 0,
bitmask => 1,
},
{
label => '-',
mask_def => 'OPpARG2_MASK',
bitmin => 0,
bitmax => 1,
bitmask => 3,
},
{
label => 'offset',
mask_def => 'OPpAVHVSWITCH_MASK',
bitmin => 0,
bitmax => 1,
bitmask => 3,
},
{
label => '-',
mask_def => 'OPpARG3_MASK',
bitmin => 0,
bitmax => 2,
bitmask => 7,
},
{
label => '-',
mask_def => 'OPpARG4_MASK',
bitmin => 0,
bitmax => 3,
bitmask => 15,
},
{
label => 'range',
mask_def => 'OPpPADRANGE_COUNTMASK',
bitcount_def => 'OPpPADRANGE_COUNTSHIFT',
bitmin => 0,
bitmax => 6,
bitmask => 127,
},
{
label => 'key',
bitmin => 0,
bitmax => 7,
bitmask => 255,
},
{
mask_def => 'OPpARGELEM_MASK',
bitmin => 1,
bitmax => 2,
bitmask => 6,
enum => [
0, 'OPpARGELEM_SV', 'SV',
1, 'OPpARGELEM_AV', 'AV',
2, 'OPpARGELEM_HV', 'HV',
],
},
{
mask_def => 'OPpDEREF',
bitmin => 4,
bitmax => 5,
bitmask => 48,
enum => [
1, 'OPpDEREF_AV', 'DREFAV',
2, 'OPpDEREF_HV', 'DREFHV',
3, 'OPpDEREF_SV', 'DREFSV',
],
},
{
mask_def => 'OPpLVREF_TYPE',
bitmin => 4,
bitmax => 5,
bitmask => 48,
enum => [
0, 'OPpLVREF_SV', 'SV',
1, 'OPpLVREF_AV', 'AV',
2, 'OPpLVREF_HV', 'HV',
3, 'OPpLVREF_CV', 'CV',
],
},
);
@{$bits{aassign}}{6,5,4,2,1,0} = ('OPpASSIGN_COMMON_SCALAR', 'OPpASSIGN_COMMON_RC1', 'OPpASSIGN_COMMON_AGG', 'OPpASSIGN_TRUEBOOL', $bf[1], $bf[1]);
$bits{abs}{0} = $bf[0];
@{$bits{accept}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{add}}{1,0} = ($bf[1], $bf[1]);
$bits{aeach}{0} = $bf[0];
@{$bits{aelem}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]);
@{$bits{aelemfast}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]);
@{$bits{aelemfast_lex}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]);
$bits{akeys}{0} = $bf[0];
$bits{alarm}{0} = $bf[0];
$bits{and}{0} = $bf[0];
$bits{andassign}{0} = $bf[0];
$bits{anonconst}{0} = $bf[0];
@{$bits{anonhash}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{anonlist}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{argcheck}{0} = $bf[0];
$bits{argdefelem}{0} = $bf[0];
@{$bits{argelem}}{2,1,0} = ($bf[7], $bf[7], $bf[0]);
@{$bits{atan2}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{av2arylen}{0} = $bf[0];
$bits{avalues}{0} = $bf[0];
@{$bits{avhvswitch}}{1,0} = ($bf[2], $bf[2]);
$bits{backtick}{0} = $bf[0];
@{$bits{bind}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{binmode}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{bit_and}}{1,0} = ($bf[1], $bf[1]);
@{$bits{bit_or}}{1,0} = ($bf[1], $bf[1]);
@{$bits{bit_xor}}{1,0} = ($bf[1], $bf[1]);
@{$bits{bless}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{caller}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{chdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{chmod}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{chomp}{0} = $bf[0];
$bits{chop}{0} = $bf[0];
@{$bits{chown}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{chr}{0} = $bf[0];
$bits{chroot}{0} = $bf[0];
@{$bits{close}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{closedir}{0} = $bf[0];
$bits{cmpchain_and}{0} = $bf[0];
$bits{cmpchain_dup}{0} = $bf[0];
$bits{complement}{0} = $bf[0];
@{$bits{concat}}{6,1,0} = ('OPpCONCAT_NESTED', $bf[1], $bf[1]);
$bits{cond_expr}{0} = $bf[0];
@{$bits{connect}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{const}}{6,4,3,2,1} = ('OPpCONST_BARE', 'OPpCONST_ENTERED', 'OPpCONST_STRICT', 'OPpCONST_SHORTCIRCUIT', 'OPpCONST_NOVER');
@{$bits{coreargs}}{7,6,1,0} = ('OPpCOREARGS_PUSHMARK', 'OPpCOREARGS_SCALARMOD', 'OPpCOREARGS_DEREF2', 'OPpCOREARGS_DEREF1');
$bits{cos}{0} = $bf[0];
@{$bits{crypt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{dbmclose}{0} = $bf[0];
@{$bits{dbmopen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{defined}{0} = $bf[0];
@{$bits{delete}}{6,5,0} = ('OPpSLICE', 'OPpKVSLICE', $bf[0]);
@{$bits{die}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{divide}}{1,0} = ($bf[1], $bf[1]);
$bits{dofile}{0} = $bf[0];
$bits{dor}{0} = $bf[0];
$bits{dorassign}{0} = $bf[0];
$bits{dump}{0} = $bf[0];
$bits{each}{0} = $bf[0];
@{$bits{entereval}}{5,4,3,2,1,0} = ('OPpEVAL_RE_REPARSING', 'OPpEVAL_COPHH', 'OPpEVAL_BYTES', 'OPpEVAL_UNICODE', 'OPpEVAL_HAS_HH', $bf[0]);
$bits{entergiven}{0} = $bf[0];
$bits{enteriter}{3} = 'OPpITER_DEF';
@{$bits{entersub}}{5,4,0} = ($bf[8], $bf[8], 'OPpENTERSUB_INARGS');
$bits{entertry}{0} = $bf[0];
$bits{enterwhen}{0} = $bf[0];
@{$bits{enterwrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{eof}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{eq}}{1,0} = ($bf[1], $bf[1]);
@{$bits{exec}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{exists}}{6,0} = ('OPpEXISTS_SUB', $bf[0]);
@{$bits{exit}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{exp}{0} = $bf[0];
$bits{fc}{0} = $bf[0];
@{$bits{fcntl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{fileno}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{flip}{0} = $bf[0];
@{$bits{flock}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{flop}{0} = $bf[0];
@{$bits{formline}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{ftatime}{0} = $bf[0];
$bits{ftbinary}{0} = $bf[0];
$bits{ftblk}{0} = $bf[0];
$bits{ftchr}{0} = $bf[0];
$bits{ftctime}{0} = $bf[0];
$bits{ftdir}{0} = $bf[0];
$bits{fteexec}{0} = $bf[0];
$bits{fteowned}{0} = $bf[0];
$bits{fteread}{0} = $bf[0];
$bits{ftewrite}{0} = $bf[0];
$bits{ftfile}{0} = $bf[0];
$bits{ftis}{0} = $bf[0];
$bits{ftlink}{0} = $bf[0];
$bits{ftmtime}{0} = $bf[0];
$bits{ftpipe}{0} = $bf[0];
$bits{ftrexec}{0} = $bf[0];
$bits{ftrowned}{0} = $bf[0];
$bits{ftrread}{0} = $bf[0];
$bits{ftrwrite}{0} = $bf[0];
$bits{ftsgid}{0} = $bf[0];
$bits{ftsize}{0} = $bf[0];
$bits{ftsock}{0} = $bf[0];
$bits{ftsuid}{0} = $bf[0];
$bits{ftsvtx}{0} = $bf[0];
$bits{fttext}{0} = $bf[0];
$bits{fttty}{0} = $bf[0];
$bits{ftzero}{0} = $bf[0];
@{$bits{ge}}{1,0} = ($bf[1], $bf[1]);
@{$bits{gelem}}{1,0} = ($bf[1], $bf[1]);
@{$bits{getc}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{getpeername}{0} = $bf[0];
@{$bits{getpgrp}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{getpriority}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{getsockname}{0} = $bf[0];
$bits{ggrgid}{0} = $bf[0];
$bits{ggrnam}{0} = $bf[0];
@{$bits{ghbyaddr}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{ghbyname}{0} = $bf[0];
@{$bits{glob}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{gmtime}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{gnbyaddr}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{gnbyname}{0} = $bf[0];
$bits{goto}{0} = $bf[0];
$bits{gpbyname}{0} = $bf[0];
@{$bits{gpbynumber}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{gpwnam}{0} = $bf[0];
$bits{gpwuid}{0} = $bf[0];
$bits{grepstart}{0} = $bf[0];
$bits{grepwhile}{0} = $bf[0];
@{$bits{gsbyname}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{gsbyport}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{gsockopt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{gt}}{1,0} = ($bf[1], $bf[1]);
$bits{gv}{5} = 'OPpEARLY_CV';
@{$bits{helem}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]);
$bits{hex}{0} = $bf[0];
@{$bits{i_add}}{1,0} = ($bf[1], $bf[1]);
@{$bits{i_divide}}{1,0} = ($bf[1], $bf[1]);
@{$bits{i_eq}}{1,0} = ($bf[1], $bf[1]);
@{$bits{i_ge}}{1,0} = ($bf[1], $bf[1]);
@{$bits{i_gt}}{1,0} = ($bf[1], $bf[1]);
@{$bits{i_le}}{1,0} = ($bf[1], $bf[1]);
@{$bits{i_lt}}{1,0} = ($bf[1], $bf[1]);
@{$bits{i_modulo}}{1,0} = ($bf[1], $bf[1]);
@{$bits{i_multiply}}{1,0} = ($bf[1], $bf[1]);
@{$bits{i_ncmp}}{1,0} = ($bf[1], $bf[1]);
@{$bits{i_ne}}{1,0} = ($bf[1], $bf[1]);
$bits{i_negate}{0} = $bf[0];
$bits{i_postdec}{0} = $bf[0];
$bits{i_postinc}{0} = $bf[0];
$bits{i_predec}{0} = $bf[0];
$bits{i_preinc}{0} = $bf[0];
@{$bits{i_subtract}}{1,0} = ($bf[1], $bf[1]);
@{$bits{index}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{int}{0} = $bf[0];
@{$bits{ioctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{isa}}{1,0} = ($bf[1], $bf[1]);
@{$bits{join}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{keys}{0} = $bf[0];
@{$bits{kill}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{last}{0} = $bf[0];
$bits{lc}{0} = $bf[0];
$bits{lcfirst}{0} = $bf[0];
@{$bits{le}}{1,0} = ($bf[1], $bf[1]);
$bits{leaveeval}{0} = $bf[0];
$bits{leavegiven}{0} = $bf[0];
@{$bits{leaveloop}}{1,0} = ($bf[1], $bf[1]);
$bits{leavesub}{0} = $bf[0];
$bits{leavesublv}{0} = $bf[0];
$bits{leavewhen}{0} = $bf[0];
$bits{leavewrite}{0} = $bf[0];
@{$bits{left_shift}}{1,0} = ($bf[1], $bf[1]);
$bits{length}{0} = $bf[0];
@{$bits{link}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{list}{6} = 'OPpLIST_GUESSED';
@{$bits{listen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{localtime}{0} = $bf[0];
$bits{lock}{0} = $bf[0];
$bits{log}{0} = $bf[0];
@{$bits{lslice}}{1,0} = ($bf[1], $bf[1]);
$bits{lstat}{0} = $bf[0];
@{$bits{lt}}{1,0} = ($bf[1], $bf[1]);
$bits{lvavref}{0} = $bf[0];
@{$bits{lvref}}{5,4,0} = ($bf[9], $bf[9], $bf[0]);
$bits{mapstart}{0} = $bf[0];
$bits{mapwhile}{0} = $bf[0];
$bits{method}{0} = $bf[0];
$bits{method_named}{0} = $bf[0];
$bits{method_redir}{0} = $bf[0];
$bits{method_redir_super}{0} = $bf[0];
$bits{method_super}{0} = $bf[0];
@{$bits{mkdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{modulo}}{1,0} = ($bf[1], $bf[1]);
@{$bits{msgctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{msgget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{msgrcv}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{msgsnd}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{multiconcat}}{6,5,3,0} = ('OPpMULTICONCAT_APPEND', 'OPpMULTICONCAT_FAKE', 'OPpMULTICONCAT_STRINGIFY', $bf[0]);
@{$bits{multideref}}{5,4,0} = ('OPpMULTIDEREF_DELETE', 'OPpMULTIDEREF_EXISTS', $bf[0]);
@{$bits{multiply}}{1,0} = ($bf[1], $bf[1]);
@{$bits{nbit_and}}{1,0} = ($bf[1], $bf[1]);
@{$bits{nbit_or}}{1,0} = ($bf[1], $bf[1]);
@{$bits{nbit_xor}}{1,0} = ($bf[1], $bf[1]);
@{$bits{ncmp}}{1,0} = ($bf[1], $bf[1]);
$bits{ncomplement}{0} = $bf[0];
@{$bits{ne}}{1,0} = ($bf[1], $bf[1]);
$bits{negate}{0} = $bf[0];
$bits{next}{0} = $bf[0];
$bits{not}{0} = $bf[0];
$bits{oct}{0} = $bf[0];
$bits{once}{0} = $bf[0];
@{$bits{open}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{open_dir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{or}{0} = $bf[0];
$bits{orassign}{0} = $bf[0];
$bits{ord}{0} = $bf[0];
@{$bits{pack}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{padhv}{0} = 'OPpPADHV_ISKEYS';
@{$bits{padrange}}{6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]);
@{$bits{padsv}}{5,4} = ($bf[8], $bf[8]);
@{$bits{pipe_op}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{pop}{0} = $bf[0];
$bits{pos}{0} = $bf[0];
$bits{postdec}{0} = $bf[0];
$bits{postinc}{0} = $bf[0];
@{$bits{pow}}{1,0} = ($bf[1], $bf[1]);
$bits{predec}{0} = $bf[0];
$bits{preinc}{0} = $bf[0];
$bits{prototype}{0} = $bf[0];
@{$bits{push}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{quotemeta}{0} = $bf[0];
@{$bits{rand}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{range}{0} = $bf[0];
@{$bits{read}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{readdir}{0} = $bf[0];
$bits{readline}{0} = $bf[0];
$bits{readlink}{0} = $bf[0];
@{$bits{recv}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{redo}{0} = $bf[0];
$bits{ref}{0} = $bf[0];
@{$bits{refassign}}{5,4,1,0} = ($bf[9], $bf[9], $bf[1], $bf[1]);
$bits{refgen}{0} = $bf[0];
$bits{regcmaybe}{0} = $bf[0];
$bits{regcomp}{0} = $bf[0];
$bits{regcreset}{0} = $bf[0];
@{$bits{rename}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{repeat}}{6,1,0} = ('OPpREPEAT_DOLIST', $bf[1], $bf[1]);
$bits{require}{0} = $bf[0];
@{$bits{reset}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{reverse}}{3,0} = ('OPpREVERSE_INPLACE', $bf[0]);
$bits{rewinddir}{0} = $bf[0];
@{$bits{right_shift}}{1,0} = ($bf[1], $bf[1]);
@{$bits{rindex}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{rmdir}{0} = $bf[0];
$bits{rv2av}{0} = $bf[0];
@{$bits{rv2cv}}{7,5,0} = ('OPpENTERSUB_NOPAREN', 'OPpMAY_RETURN_CONSTANT', $bf[0]);
@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[8], $bf[8], 'OPpDONT_INIT_GV', $bf[0]);
$bits{rv2hv}{0} = 'OPpRV2HV_ISKEYS';
@{$bits{rv2sv}}{5,4,0} = ($bf[8], $bf[8], $bf[0]);
@{$bits{sassign}}{7,6,1,0} = ('OPpASSIGN_CV_TO_GV', 'OPpASSIGN_BACKWARDS', $bf[1], $bf[1]);
@{$bits{sbit_and}}{1,0} = ($bf[1], $bf[1]);
@{$bits{sbit_or}}{1,0} = ($bf[1], $bf[1]);
@{$bits{sbit_xor}}{1,0} = ($bf[1], $bf[1]);
$bits{scalar}{0} = $bf[0];
$bits{schomp}{0} = $bf[0];
$bits{schop}{0} = $bf[0];
@{$bits{scmp}}{1,0} = ($bf[1], $bf[1]);
$bits{scomplement}{0} = $bf[0];
@{$bits{seek}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{seekdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{select}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{semctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{semget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{semop}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{send}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{seq}}{1,0} = ($bf[1], $bf[1]);
@{$bits{setpgrp}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{setpriority}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{sge}}{1,0} = ($bf[1], $bf[1]);
@{$bits{sgt}}{1,0} = ($bf[1], $bf[1]);
$bits{shift}{0} = $bf[0];
@{$bits{shmctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{shmget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{shmread}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{shmwrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{shostent}{0} = $bf[0];
@{$bits{shutdown}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{sin}{0} = $bf[0];
@{$bits{sle}}{1,0} = ($bf[1], $bf[1]);
@{$bits{sleep}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{slt}}{1,0} = ($bf[1], $bf[1]);
@{$bits{smartmatch}}{1,0} = ($bf[1], $bf[1]);
@{$bits{sne}}{1,0} = ($bf[1], $bf[1]);
$bits{snetent}{0} = $bf[0];
@{$bits{socket}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{sockpair}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{sort}}{7,6,4,3,2,1,0} = ('OPpSORT_UNSTABLE', 'OPpSORT_STABLE', 'OPpSORT_DESCEND', 'OPpSORT_INPLACE', 'OPpSORT_REVERSE', 'OPpSORT_INTEGER', 'OPpSORT_NUMERIC');
@{$bits{splice}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{split}}{4,3,2} = ('OPpSPLIT_ASSIGN', 'OPpSPLIT_LEX', 'OPpSPLIT_IMPLIM');
@{$bits{sprintf}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{sprotoent}{0} = $bf[0];
$bits{sqrt}{0} = $bf[0];
@{$bits{srand}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{srefgen}{0} = $bf[0];
@{$bits{sselect}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{sservent}{0} = $bf[0];
@{$bits{ssockopt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{stat}{0} = $bf[0];
@{$bits{stringify}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{study}{0} = $bf[0];
$bits{substcont}{0} = $bf[0];
@{$bits{substr}}{4,2,1,0} = ('OPpSUBSTR_REPL_FIRST', $bf[3], $bf[3], $bf[3]);
@{$bits{subtract}}{1,0} = ($bf[1], $bf[1]);
@{$bits{symlink}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{syscall}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{sysopen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{sysread}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{sysseek}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{system}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{syswrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{tell}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{telldir}{0} = $bf[0];
@{$bits{tie}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{tied}{0} = $bf[0];
@{$bits{truncate}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{uc}{0} = $bf[0];
$bits{ucfirst}{0} = $bf[0];
@{$bits{umask}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{undef}{0} = $bf[0];
@{$bits{unlink}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{unpack}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{unshift}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{untie}{0} = $bf[0];
@{$bits{utime}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{values}{0} = $bf[0];
@{$bits{vec}}{1,0} = ($bf[1], $bf[1]);
@{$bits{waitpid}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{warn}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{xor}}{1,0} = ($bf[1], $bf[1]);
our %defines = (
OPpALLOW_FAKE => 64,
OPpARG1_MASK => 1,
OPpARG2_MASK => 3,
OPpARG3_MASK => 7,
OPpARG4_MASK => 15,
OPpARGELEM_AV => 2,
OPpARGELEM_HV => 4,
OPpARGELEM_MASK => 6,
OPpARGELEM_SV => 0,
OPpASSIGN_BACKWARDS => 64,
OPpASSIGN_COMMON_AGG => 16,
OPpASSIGN_COMMON_RC1 => 32,
OPpASSIGN_COMMON_SCALAR => 64,
OPpASSIGN_CV_TO_GV => 128,
OPpASSIGN_TRUEBOOL => 4,
OPpAVHVSWITCH_MASK => 3,
OPpCONCAT_NESTED => 64,
OPpCONST_BARE => 64,
OPpCONST_ENTERED => 16,
OPpCONST_NOVER => 2,
OPpCONST_SHORTCIRCUIT => 4,
OPpCONST_STRICT => 8,
OPpCOREARGS_DEREF1 => 1,
OPpCOREARGS_DEREF2 => 2,
OPpCOREARGS_PUSHMARK => 128,
OPpCOREARGS_SCALARMOD => 64,
OPpDEREF => 48,
OPpDEREF_AV => 16,
OPpDEREF_HV => 32,
OPpDEREF_SV => 48,
OPpDONT_INIT_GV => 4,
OPpEARLY_CV => 32,
OPpENTERSUB_AMPER => 8,
OPpENTERSUB_DB => 64,
OPpENTERSUB_HASTARG => 4,
OPpENTERSUB_INARGS => 1,
OPpENTERSUB_NOPAREN => 128,
OPpEVAL_BYTES => 8,
OPpEVAL_COPHH => 16,
OPpEVAL_HAS_HH => 2,
OPpEVAL_RE_REPARSING => 32,
OPpEVAL_UNICODE => 4,
OPpEXISTS_SUB => 64,
OPpFLIP_LINENUM => 64,
OPpFT_ACCESS => 2,
OPpFT_AFTER_t => 16,
OPpFT_STACKED => 4,
OPpFT_STACKING => 8,
OPpHINT_STRICT_REFS => 2,
OPpHUSH_VMSISH => 32,
OPpINDEX_BOOLNEG => 64,
OPpITER_DEF => 8,
OPpITER_REVERSED => 2,
OPpKVSLICE => 32,
OPpLIST_GUESSED => 64,
OPpLVALUE => 128,
OPpLVAL_DEFER => 64,
OPpLVAL_INTRO => 128,
OPpLVREF_AV => 16,
OPpLVREF_CV => 48,
OPpLVREF_ELEM => 4,
OPpLVREF_HV => 32,
OPpLVREF_ITER => 8,
OPpLVREF_SV => 0,
OPpLVREF_TYPE => 48,
OPpMAYBE_LVSUB => 8,
OPpMAYBE_TRUEBOOL => 16,
OPpMAY_RETURN_CONSTANT => 32,
OPpMULTICONCAT_APPEND => 64,
OPpMULTICONCAT_FAKE => 32,
OPpMULTICONCAT_STRINGIFY => 8,
OPpMULTIDEREF_DELETE => 32,
OPpMULTIDEREF_EXISTS => 16,
OPpOFFBYONE => 128,
OPpOPEN_IN_CRLF => 32,
OPpOPEN_IN_RAW => 16,
OPpOPEN_OUT_CRLF => 128,
OPpOPEN_OUT_RAW => 64,
OPpOUR_INTRO => 64,
OPpPADHV_ISKEYS => 1,
OPpPADRANGE_COUNTMASK => 127,
OPpPADRANGE_COUNTSHIFT => 7,
OPpPAD_STATE => 64,
OPpPV_IS_UTF8 => 128,
OPpREFCOUNTED => 64,
OPpREPEAT_DOLIST => 64,
OPpREVERSE_INPLACE => 8,
OPpRV2HV_ISKEYS => 1,
OPpSLICE => 64,
OPpSLICEWARNING => 4,
OPpSORT_DESCEND => 16,
OPpSORT_INPLACE => 8,
OPpSORT_INTEGER => 2,
OPpSORT_NUMERIC => 1,
OPpSORT_REVERSE => 4,
OPpSORT_STABLE => 64,
OPpSORT_UNSTABLE => 128,
OPpSPLIT_ASSIGN => 16,
OPpSPLIT_IMPLIM => 4,
OPpSPLIT_LEX => 8,
OPpSUBSTR_REPL_FIRST => 16,
OPpTARGET_MY => 16,
OPpTRANS_CAN_FORCE_UTF8 => 1,
OPpTRANS_COMPLEMENT => 32,
OPpTRANS_DELETE => 128,
OPpTRANS_GROWS => 64,
OPpTRANS_IDENTICAL => 4,
OPpTRANS_SQUASH => 8,
OPpTRANS_USE_SVOP => 2,
OPpTRUEBOOL => 32,
);
our %labels = (
OPpALLOW_FAKE => 'FAKE',
OPpARGELEM_AV => 'AV',
OPpARGELEM_HV => 'HV',
OPpARGELEM_SV => 'SV',
OPpASSIGN_BACKWARDS => 'BKWARD',
OPpASSIGN_COMMON_AGG => 'COM_AGG',
OPpASSIGN_COMMON_RC1 => 'COM_RC1',
OPpASSIGN_COMMON_SCALAR => 'COM_SCALAR',
OPpASSIGN_CV_TO_GV => 'CV2GV',
OPpASSIGN_TRUEBOOL => 'BOOL',
OPpCONCAT_NESTED => 'NESTED',
OPpCONST_BARE => 'BARE',
OPpCONST_ENTERED => 'ENTERED',
OPpCONST_NOVER => 'NOVER',
OPpCONST_SHORTCIRCUIT => 'SHORT',
OPpCONST_STRICT => 'STRICT',
OPpCOREARGS_DEREF1 => 'DEREF1',
OPpCOREARGS_DEREF2 => 'DEREF2',
OPpCOREARGS_PUSHMARK => 'MARK',
OPpCOREARGS_SCALARMOD => '$MOD',
OPpDEREF_AV => 'DREFAV',
OPpDEREF_HV => 'DREFHV',
OPpDEREF_SV => 'DREFSV',
OPpDONT_INIT_GV => 'NOINIT',
OPpEARLY_CV => 'EARLYCV',
OPpENTERSUB_AMPER => 'AMPER',
OPpENTERSUB_DB => 'DBG',
OPpENTERSUB_HASTARG => 'TARG',
OPpENTERSUB_INARGS => 'INARGS',
OPpENTERSUB_NOPAREN => 'NO()',
OPpEVAL_BYTES => 'BYTES',
OPpEVAL_COPHH => 'COPHH',
OPpEVAL_HAS_HH => 'HAS_HH',
OPpEVAL_RE_REPARSING => 'REPARSE',
OPpEVAL_UNICODE => 'UNI',
OPpEXISTS_SUB => 'SUB',
OPpFLIP_LINENUM => 'LINENUM',
OPpFT_ACCESS => 'FTACCESS',
OPpFT_AFTER_t => 'FTAFTERt',
OPpFT_STACKED => 'FTSTACKED',
OPpFT_STACKING => 'FTSTACKING',
OPpHINT_STRICT_REFS => 'STRICT',
OPpHUSH_VMSISH => 'HUSH',
OPpINDEX_BOOLNEG => 'NEG',
OPpITER_DEF => 'DEF',
OPpITER_REVERSED => 'REVERSED',
OPpKVSLICE => 'KVSLICE',
OPpLIST_GUESSED => 'GUESSED',
OPpLVALUE => 'LV',
OPpLVAL_DEFER => 'LVDEFER',
OPpLVAL_INTRO => 'LVINTRO',
OPpLVREF_AV => 'AV',
OPpLVREF_CV => 'CV',
OPpLVREF_ELEM => 'ELEM',
OPpLVREF_HV => 'HV',
OPpLVREF_ITER => 'ITER',
OPpLVREF_SV => 'SV',
OPpMAYBE_LVSUB => 'LVSUB',
OPpMAYBE_TRUEBOOL => 'BOOL?',
OPpMAY_RETURN_CONSTANT => 'CONST',
OPpMULTICONCAT_APPEND => 'APPEND',
OPpMULTICONCAT_FAKE => 'FAKE',
OPpMULTICONCAT_STRINGIFY => 'STRINGIFY',
OPpMULTIDEREF_DELETE => 'DELETE',
OPpMULTIDEREF_EXISTS => 'EXISTS',
OPpOFFBYONE => '+1',
OPpOPEN_IN_CRLF => 'INCR',
OPpOPEN_IN_RAW => 'INBIN',
OPpOPEN_OUT_CRLF => 'OUTCR',
OPpOPEN_OUT_RAW => 'OUTBIN',
OPpOUR_INTRO => 'OURINTR',
OPpPADHV_ISKEYS => 'KEYS',
OPpPAD_STATE => 'STATE',
OPpPV_IS_UTF8 => 'UTF',
OPpREFCOUNTED => 'REFC',
OPpREPEAT_DOLIST => 'DOLIST',
OPpREVERSE_INPLACE => 'INPLACE',
OPpRV2HV_ISKEYS => 'KEYS',
OPpSLICE => 'SLICE',
OPpSLICEWARNING => 'SLICEWARN',
OPpSORT_DESCEND => 'DESC',
OPpSORT_INPLACE => 'INPLACE',
OPpSORT_INTEGER => 'INT',
OPpSORT_NUMERIC => 'NUM',
OPpSORT_REVERSE => 'REV',
OPpSORT_STABLE => 'STABLE',
OPpSORT_UNSTABLE => 'UNSTABLE',
OPpSPLIT_ASSIGN => 'ASSIGN',
OPpSPLIT_IMPLIM => 'IMPLIM',
OPpSPLIT_LEX => 'LEX',
OPpSUBSTR_REPL_FIRST => 'REPL1ST',
OPpTARGET_MY => 'TARGMY',
OPpTRANS_CAN_FORCE_UTF8 => 'CAN_FORCE_UTF8',
OPpTRANS_COMPLEMENT => 'COMPL',
OPpTRANS_DELETE => 'DEL',
OPpTRANS_GROWS => 'GROWS',
OPpTRANS_IDENTICAL => 'IDENT',
OPpTRANS_SQUASH => 'SQUASH',
OPpTRANS_USE_SVOP => 'USE_SVOP',
OPpTRUEBOOL => 'BOOL',
);
our %ops_using = (
OPpALLOW_FAKE => [qw(rv2gv)],
OPpASSIGN_BACKWARDS => [qw(sassign)],
OPpASSIGN_COMMON_AGG => [qw(aassign)],
OPpCONCAT_NESTED => [qw(concat)],
OPpCONST_BARE => [qw(const)],
OPpCOREARGS_DEREF1 => [qw(coreargs)],
OPpEARLY_CV => [qw(gv)],
OPpENTERSUB_AMPER => [qw(entersub rv2cv)],
OPpENTERSUB_INARGS => [qw(entersub)],
OPpENTERSUB_NOPAREN => [qw(rv2cv)],
OPpEVAL_BYTES => [qw(entereval)],
OPpEXISTS_SUB => [qw(exists)],
OPpFLIP_LINENUM => [qw(flip flop)],
OPpFT_ACCESS => [qw(fteexec fteread ftewrite ftrexec ftrread ftrwrite)],
OPpFT_AFTER_t => [qw(ftatime ftbinary ftblk ftchr ftctime ftdir fteexec fteowned fteread ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned ftrread ftrwrite ftsgid ftsize ftsock ftsuid ftsvtx fttext fttty ftzero)],
OPpHINT_STRICT_REFS => [qw(entersub multideref rv2av rv2cv rv2gv rv2hv rv2sv)],
OPpHUSH_VMSISH => [qw(dbstate nextstate)],
OPpINDEX_BOOLNEG => [qw(index rindex)],
OPpITER_DEF => [qw(enteriter)],
OPpITER_REVERSED => [qw(enteriter iter)],
OPpKVSLICE => [qw(delete)],
OPpLIST_GUESSED => [qw(list)],
OPpLVALUE => [qw(leave leaveloop)],
OPpLVAL_DEFER => [qw(aelem helem multideref)],
OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multiconcat multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv split)],
OPpLVREF_ELEM => [qw(lvref refassign)],
OPpMAYBE_LVSUB => [qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr values vec)],
OPpMAYBE_TRUEBOOL => [qw(padhv ref rv2hv)],
OPpMULTICONCAT_APPEND => [qw(multiconcat)],
OPpMULTIDEREF_DELETE => [qw(multideref)],
OPpOFFBYONE => [qw(caller runcv wantarray)],
OPpOPEN_IN_CRLF => [qw(backtick open)],
OPpOUR_INTRO => [qw(enteriter gvsv rv2av rv2hv rv2sv split)],
OPpPADHV_ISKEYS => [qw(padhv)],
OPpPAD_STATE => [qw(lvavref lvref padav padhv padsv pushmark refassign)],
OPpPV_IS_UTF8 => [qw(dump goto last next redo)],
OPpREFCOUNTED => [qw(leave leaveeval leavesub leavesublv leavewrite)],
OPpREPEAT_DOLIST => [qw(repeat)],
OPpREVERSE_INPLACE => [qw(reverse)],
OPpRV2HV_ISKEYS => [qw(rv2hv)],
OPpSLICEWARNING => [qw(aslice hslice padav padhv rv2av rv2hv)],
OPpSORT_DESCEND => [qw(sort)],
OPpSPLIT_ASSIGN => [qw(split)],
OPpSUBSTR_REPL_FIRST => [qw(substr)],
OPpTARGET_MY => [qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int kill left_shift length link log mkdir modulo multiconcat multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid)],
OPpTRANS_CAN_FORCE_UTF8 => [qw(trans transr)],
OPpTRUEBOOL => [qw(grepwhile index length padav padhv pos ref rindex rv2av rv2hv subst)],
);
$ops_using{OPpASSIGN_COMMON_RC1} = $ops_using{OPpASSIGN_COMMON_AGG};
$ops_using{OPpASSIGN_COMMON_SCALAR} = $ops_using{OPpASSIGN_COMMON_AGG};
$ops_using{OPpASSIGN_CV_TO_GV} = $ops_using{OPpASSIGN_BACKWARDS};
$ops_using{OPpASSIGN_TRUEBOOL} = $ops_using{OPpASSIGN_COMMON_AGG};
$ops_using{OPpCONST_ENTERED} = $ops_using{OPpCONST_BARE};
$ops_using{OPpCONST_NOVER} = $ops_using{OPpCONST_BARE};
$ops_using{OPpCONST_SHORTCIRCUIT} = $ops_using{OPpCONST_BARE};
$ops_using{OPpCONST_STRICT} = $ops_using{OPpCONST_BARE};
$ops_using{OPpCOREARGS_DEREF2} = $ops_using{OPpCOREARGS_DEREF1};
$ops_using{OPpCOREARGS_PUSHMARK} = $ops_using{OPpCOREARGS_DEREF1};
$ops_using{OPpCOREARGS_SCALARMOD} = $ops_using{OPpCOREARGS_DEREF1};
$ops_using{OPpDONT_INIT_GV} = $ops_using{OPpALLOW_FAKE};
$ops_using{OPpENTERSUB_DB} = $ops_using{OPpENTERSUB_AMPER};
$ops_using{OPpENTERSUB_HASTARG} = $ops_using{OPpENTERSUB_AMPER};
$ops_using{OPpEVAL_COPHH} = $ops_using{OPpEVAL_BYTES};
$ops_using{OPpEVAL_HAS_HH} = $ops_using{OPpEVAL_BYTES};
$ops_using{OPpEVAL_RE_REPARSING} = $ops_using{OPpEVAL_BYTES};
$ops_using{OPpEVAL_UNICODE} = $ops_using{OPpEVAL_BYTES};
$ops_using{OPpFT_STACKED} = $ops_using{OPpFT_AFTER_t};
$ops_using{OPpFT_STACKING} = $ops_using{OPpFT_AFTER_t};
$ops_using{OPpLVREF_ITER} = $ops_using{OPpLVREF_ELEM};
$ops_using{OPpMAY_RETURN_CONSTANT} = $ops_using{OPpENTERSUB_NOPAREN};
$ops_using{OPpMULTICONCAT_FAKE} = $ops_using{OPpMULTICONCAT_APPEND};
$ops_using{OPpMULTICONCAT_STRINGIFY} = $ops_using{OPpMULTICONCAT_APPEND};
$ops_using{OPpMULTIDEREF_EXISTS} = $ops_using{OPpMULTIDEREF_DELETE};
$ops_using{OPpOPEN_IN_RAW} = $ops_using{OPpOPEN_IN_CRLF};
$ops_using{OPpOPEN_OUT_CRLF} = $ops_using{OPpOPEN_IN_CRLF};
$ops_using{OPpOPEN_OUT_RAW} = $ops_using{OPpOPEN_IN_CRLF};
$ops_using{OPpSLICE} = $ops_using{OPpKVSLICE};
$ops_using{OPpSORT_INPLACE} = $ops_using{OPpSORT_DESCEND};
$ops_using{OPpSORT_INTEGER} = $ops_using{OPpSORT_DESCEND};
$ops_using{OPpSORT_NUMERIC} = $ops_using{OPpSORT_DESCEND};
$ops_using{OPpSORT_REVERSE} = $ops_using{OPpSORT_DESCEND};
$ops_using{OPpSORT_STABLE} = $ops_using{OPpSORT_DESCEND};
$ops_using{OPpSORT_UNSTABLE} = $ops_using{OPpSORT_DESCEND};
$ops_using{OPpSPLIT_IMPLIM} = $ops_using{OPpSPLIT_ASSIGN};
$ops_using{OPpSPLIT_LEX} = $ops_using{OPpSPLIT_ASSIGN};
$ops_using{OPpTRANS_COMPLEMENT} = $ops_using{OPpTRANS_CAN_FORCE_UTF8};
$ops_using{OPpTRANS_DELETE} = $ops_using{OPpTRANS_CAN_FORCE_UTF8};
$ops_using{OPpTRANS_GROWS} = $ops_using{OPpTRANS_CAN_FORCE_UTF8};
$ops_using{OPpTRANS_IDENTICAL} = $ops_using{OPpTRANS_CAN_FORCE_UTF8};
$ops_using{OPpTRANS_SQUASH} = $ops_using{OPpTRANS_CAN_FORCE_UTF8};
$ops_using{OPpTRANS_USE_SVOP} = $ops_using{OPpTRANS_CAN_FORCE_UTF8};
# ex: set ro:

217
database/perl/lib/B/Showlex.pm Normal file
View File

@@ -0,0 +1,217 @@
package B::Showlex;
our $VERSION = '1.05';
use strict;
use B qw(svref_2object comppadlist class);
use B::Terse ();
use B::Concise ();
#
# Invoke as
# perl -MO=Showlex,foo bar.pl
# to see the names of lexical variables used by &foo
# or as
# perl -MO=Showlex bar.pl
# to see the names of file scope lexicals used by bar.pl
#
# borrowed from B::Concise
our $walkHandle = \*STDOUT;
sub walk_output { # updates $walkHandle
$walkHandle = B::Concise::walk_output(@_);
#print "got $walkHandle";
#print $walkHandle "using it";
$walkHandle;
}
sub shownamearray {
my ($name, $av) = @_;
my @els = $av->ARRAY;
my $count = @els;
my $i;
print $walkHandle "$name has $count entries\n";
for ($i = 0; $i < $count; $i++) {
my $sv = $els[$i];
if (class($sv) ne "SPECIAL") {
printf $walkHandle "$i: (0x%lx) %s\n",
$$sv, $sv->PVX // "undef" || "const";
} else {
printf $walkHandle "$i: %s\n", $sv->terse;
#printf $walkHandle "$i: %s\n", B::Concise::concise_sv($sv);
}
}
}
sub showvaluearray {
my ($name, $av) = @_;
my @els = $av->ARRAY;
my $count = @els;
my $i;
print $walkHandle "$name has $count entries\n";
for ($i = 0; $i < $count; $i++) {
printf $walkHandle "$i: %s\n", $els[$i]->terse;
#print $walkHandle "$i: %s\n", B::Concise::concise_sv($els[$i]);
}
}
sub showlex {
my ($objname, $namesav, $valsav) = @_;
shownamearray("Pad of lexical names for $objname", $namesav);
showvaluearray("Pad of lexical values for $objname", $valsav);
}
my ($newlex, $nosp1); # rendering state vars
sub padname_terse {
my $name = shift;
return $name->terse if class($name) eq 'SPECIAL';
my $str = $name->PVX;
return sprintf "(0x%lx) %s",
$$name,
length $str ? qq'"$str"' : defined $str ? "const" : 'undef';
}
sub newlex { # drop-in for showlex
my ($objname, $names, $vals) = @_;
my @names = $names->ARRAY;
my @vals = $vals->ARRAY;
my $count = @names;
print $walkHandle "$objname Pad has $count entries\n";
printf $walkHandle "0: %s\n", padname_terse($names[0]) unless $nosp1;
for (my $i = 1; $i < $count; $i++) {
printf $walkHandle "$i: %s = %s\n", padname_terse($names[$i]),
$vals[$i]->terse,
unless $nosp1
and class($names[$i]) eq 'SPECIAL' || !$names[$i]->LEN;
}
}
sub showlex_obj {
my ($objname, $obj) = @_;
$objname =~ s/^&main::/&/;
showlex($objname, svref_2object($obj)->PADLIST->ARRAY) if !$newlex;
newlex ($objname, svref_2object($obj)->PADLIST->ARRAY) if $newlex;
}
sub showlex_main {
showlex("comppadlist", comppadlist->ARRAY) if !$newlex;
newlex ("main", comppadlist->ARRAY) if $newlex;
}
sub compile {
my @options = grep(/^-/, @_);
my @args = grep(!/^-/, @_);
for my $o (@options) {
$newlex = 1 if $o eq "-newlex";
$nosp1 = 1 if $o eq "-nosp";
}
return \&showlex_main unless @args;
return sub {
my $objref;
foreach my $objname (@args) {
next unless $objname; # skip nulls w/o carping
if (ref $objname) {
print $walkHandle "B::Showlex::compile($objname)\n";
$objref = $objname;
} else {
$objname = "main::$objname" unless $objname =~ /::/;
print $walkHandle "$objname:\n";
no strict 'refs';
die "err: unknown function ($objname)\n"
unless *{$objname}{CODE};
$objref = \&$objname;
}
showlex_obj($objname, $objref);
}
}
}
1;
__END__
=head1 NAME
B::Showlex - Show lexical variables used in functions or files
=head1 SYNOPSIS
perl -MO=Showlex[,-OPTIONS][,SUBROUTINE] foo.pl
=head1 DESCRIPTION
When a comma-separated list of subroutine names is given as options, Showlex
prints the lexical variables used in those subroutines. Otherwise, it prints
the file-scope lexicals in the file.
=head1 EXAMPLES
Traditional form:
$ perl -MO=Showlex -e 'my ($i,$j,$k)=(1,"foo")'
Pad of lexical names for comppadlist has 4 entries
0: (0x8caea4) undef
1: (0x9db0fb0) $i
2: (0x9db0f38) $j
3: (0x9db0f50) $k
Pad of lexical values for comppadlist has 5 entries
0: SPECIAL #1 &PL_sv_undef
1: NULL (0x9da4234)
2: NULL (0x9db0f2c)
3: NULL (0x9db0f44)
4: NULL (0x9da4264)
-e syntax OK
New-style form:
$ perl -MO=Showlex,-newlex -e 'my ($i,$j,$k)=(1,"foo")'
main Pad has 4 entries
0: (0x8caea4) undef
1: (0xa0c4fb8) "$i" = NULL (0xa0b8234)
2: (0xa0c4f40) "$j" = NULL (0xa0c4f34)
3: (0xa0c4f58) "$k" = NULL (0xa0c4f4c)
-e syntax OK
New form, no specials, outside O framework:
$ perl -MB::Showlex -e \
'my ($i,$j,$k)=(1,"foo"); B::Showlex::compile(-newlex,-nosp)->()'
main Pad has 4 entries
1: (0x998ffb0) "$i" = IV (0x9983234) 1
2: (0x998ff68) "$j" = PV (0x998ff5c) "foo"
3: (0x998ff80) "$k" = NULL (0x998ff74)
Note that this example shows the values of the lexicals, whereas the other
examples did not (as they're compile-time only).
=head2 OPTIONS
The C<-newlex> option produces a more readable C<< name => value >> format,
and is shown in the second example above.
The C<-nosp> option eliminates reporting of SPECIALs, such as C<0: SPECIAL
#1 &PL_sv_undef> above. Reporting of SPECIALs can sometimes overwhelm
your declared lexicals.
=head1 SEE ALSO
L<B::Showlex> can also be used outside of the O framework, as in the third
example. See L<B::Concise> for a fuller explanation of reasons.
=head1 TODO
Some of the reported info, such as hex addresses, is not particularly
valuable. Other information would be more useful for the typical
programmer, such as line-numbers, pad-slot reuses, etc.. Given this,
-newlex is not a particularly good flag-name.
=head1 AUTHOR
Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
=cut

104
database/perl/lib/B/Terse.pm Normal file
View File

@@ -0,0 +1,104 @@
package B::Terse;
our $VERSION = '1.09';
use strict;
use B qw(class @specialsv_name);
use B::Concise qw(concise_subref set_style_standard);
use Carp;
sub terse {
my ($order, $subref) = @_;
set_style_standard("terse");
if ($order eq "exec") {
concise_subref('exec', $subref);
} else {
concise_subref('basic', $subref);
}
}
sub compile {
my @args = @_;
my $order = @args ? shift(@args) : "";
$order = "-exec" if $order eq "exec";
unshift @args, $order if $order ne "";
B::Concise::compile("-terse", @args);
}
sub indent {
my ($level) = @_ ? shift : 0;
return " " x $level;
}
sub B::SV::terse {
my($sv, $level) = (@_, 0);
my %info;
B::Concise::concise_sv($sv, \%info);
my $s = indent($level)
. B::Concise::fmt_line(\%info, $sv,
"#svclass~(?((#svaddr))?)~#svval", 0);
chomp $s;
print "$s\n" unless defined wantarray;
$s;
}
sub B::NULL::terse {
my ($sv, $level) = (@_, 0);
my $s = indent($level) . sprintf "%s (0x%lx)", class($sv), $$sv;
print "$s\n" unless defined wantarray;
$s;
}
sub B::SPECIAL::terse {
my ($sv, $level) = (@_, 0);
my $s = indent($level)
. sprintf( "%s #%d %s", class($sv), $$sv, $specialsv_name[$$sv]);
print "$s\n" unless defined wantarray;
$s;
}
1;
__END__
=head1 NAME
B::Terse - Walk Perl syntax tree, printing terse info about ops
=head1 SYNOPSIS
perl -MO=Terse[,OPTIONS] foo.pl
=head1 DESCRIPTION
This module prints the contents of the parse tree, but without as much
information as CPAN module B::Debug. For comparison, C<print "Hello, world.">
produced 96 lines of output from B::Debug, but only 6 from B::Terse.
This module is useful for people who are writing their own back end,
or who are learning about the Perl internals. It's not useful to the
average programmer.
This version of B::Terse is really just a wrapper that calls L<B::Concise>
with the B<-terse> option. It is provided for compatibility with old scripts
(and habits) but using B::Concise directly is now recommended instead.
For compatibility with the old B::Terse, this module also adds a
method named C<terse> to B::OP and B::SV objects. The B::SV method is
largely compatible with the old one, though authors of new software
might be advised to choose a more user-friendly output format. The
B::OP C<terse> method, however, doesn't work well. Since B::Terse was
first written, much more information in OPs has migrated to the
scratchpad datastructure, but the C<terse> interface doesn't have any
way of getting to the correct pad. As a kludge, the new version will
always use the pad for the main program, but for OPs in subroutines
this will give the wrong answer or crash.
=head1 AUTHOR
The original version of B::Terse was written by Malcolm Beattie,
E<lt>mbeattie@sable.ox.ac.ukE<gt>. This wrapper was written by Stephen
McCamant, E<lt>smcc@MIT.EDUE<gt>.
=cut

496
database/perl/lib/B/Xref.pm Normal file
View File

@@ -0,0 +1,496 @@
package B::Xref;
our $VERSION = '1.07';
=head1 NAME
B::Xref - Generates cross reference reports for Perl programs
=head1 SYNOPSIS
perl -MO=Xref[,OPTIONS] foo.pl
=head1 DESCRIPTION
The B::Xref module is used to generate a cross reference listing of all
definitions and uses of variables, subroutines and formats in a Perl program.
It is implemented as a backend for the Perl compiler.
The report generated is in the following format:
File filename1
Subroutine subname1
Package package1
object1 line numbers
object2 line numbers
...
Package package2
...
Each B<File> section reports on a single file. Each B<Subroutine> section
reports on a single subroutine apart from the special cases
"(definitions)" and "(main)". These report, respectively, on subroutine
definitions found by the initial symbol table walk and on the main part of
the program or module external to all subroutines.
The report is then grouped by the B<Package> of each variable,
subroutine or format with the special case "(lexicals)" meaning
lexical variables. Each B<object> name (implicitly qualified by its
containing B<Package>) includes its type character(s) at the beginning
where possible. Lexical variables are easier to track and even
included dereferencing information where possible.
The C<line numbers> are a comma separated list of line numbers (some
preceded by code letters) where that object is used in some way.
Simple uses aren't preceded by a code letter. Introductions (such as
where a lexical is first defined with C<my>) are indicated with the
letter "i". Subroutine and method calls are indicated by the character
"&". Subroutine definitions are indicated by "s" and format
definitions by "f".
For instance, here's part of the report from the I<pod2man> program that
comes with Perl:
Subroutine clear_noremap
Package (lexical)
$ready_to_print i1069, 1079
Package main
$& 1086
$. 1086
$0 1086
$1 1087
$2 1085, 1085
$3 1085, 1085
$ARGV 1086
%HTML_Escapes 1085, 1085
This shows the variables used in the subroutine C<clear_noremap>. The
variable C<$ready_to_print> is a my() (lexical) variable,
B<i>ntroduced (first declared with my()) on line 1069, and used on
line 1079. The variable C<$&> from the main package is used on 1086,
and so on.
A line number may be prefixed by a single letter:
=over 4
=item i
Lexical variable introduced (declared with my()) for the first time.
=item &
Subroutine or method call.
=item s
Subroutine defined.
=item r
Format defined.
=back
The most useful option the cross referencer has is to save the report
to a separate file. For instance, to save the report on
I<myperlprogram> to the file I<report>:
$ perl -MO=Xref,-oreport myperlprogram
=head1 OPTIONS
Option words are separated by commas (not whitespace) and follow the
usual conventions of compiler backend options.
=over 8
=item C<-oFILENAME>
Directs output to C<FILENAME> instead of standard output.
=item C<-r>
Raw output. Instead of producing a human-readable report, outputs a line
in machine-readable form for each definition/use of a variable/sub/format.
=item C<-d>
Don't output the "(definitions)" sections.
=item C<-D[tO]>
(Internal) debug options, probably only useful if C<-r> included.
The C<t> option prints the object on the top of the stack as it's
being tracked. The C<O> option prints each operator as it's being
processed in the execution order of the program.
=back
=head1 BUGS
Non-lexical variables are quite difficult to track through a program.
Sometimes the type of a non-lexical variable's use is impossible to
determine. Introductions of non-lexical non-scalars don't seem to be
reported properly.
=head1 AUTHOR
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 SVf_ROK OPpOUR_INTRO cstring
);
sub UNKNOWN { ["?", "?", "?"] }
my @pad; # lexicals in current pad
# as ["(lexical)", type, name]
my %done; # keyed by $$op: set when each $op is done
my $top = UNKNOWN; # shadows top element of stack as
# [pack, type, name] (pack can be "(lexical)")
my $file; # shadows current filename
my $line; # shadows current line number
my $subname; # shadows current sub name
my %table; # Multi-level hash to record all uses etc.
my @todo = (); # List of CVs that need processing
my %code = (intro => "i", used => "",
subdef => "s", subused => "&",
formdef => "f", meth => "->");
# Options
my ($debug_op, $debug_top, $nodefs, $raw);
sub process {
my ($var, $event) = @_;
my ($pack, $type, $name) = @$var;
if ($type eq "*") {
if ($event eq "used") {
return;
} elsif ($event eq "subused") {
$type = "&";
}
}
$type =~ s/(.)\*$/$1/g;
if ($raw) {
printf "%-16s %-12s %5d %-12s %4s %-16s %s\n",
$file, $subname, $line, $pack, $type, $name, $event;
} else {
# Wheee
push(@{$table{$file}->{$subname}->{$pack}->{$type.$name}->{$event}},
$line);
}
}
sub load_pad {
my $padlist = shift;
my ($namelistav, $vallistav, @namelist, $ix);
@pad = ();
return if class($padlist) =~ '^(?:SPECIAL|NULL)\z';
($namelistav,$vallistav) = $padlist->ARRAY;
@namelist = $namelistav->ARRAY;
for ($ix = 1; $ix < @namelist; $ix++) {
my $namesv = $namelist[$ix];
next if class($namesv) eq "SPECIAL";
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";
next if class($valsv->STASH) eq 'SPECIAL';
# 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 {
my $start = shift;
my $op;
for ($op = $start; $$op; $op = $op->next) {
last if $done{$$op}++;
warn sprintf("top = [%s, %s, %s]\n", @$top) if $debug_top;
warn peekop($op), "\n" if $debug_op;
my $opname = $op->name;
if ($opname =~ /^(or|and|mapwhile|grepwhile|range|cond_expr)$/) {
xref($op->other);
} elsif ($opname eq "match" || $opname eq "subst") {
xref($op->pmreplstart);
} elsif ($opname eq "substcont") {
xref($op->other->pmreplstart);
$op = $op->other;
redo;
} elsif ($opname eq "enterloop") {
xref($op->redoop);
xref($op->nextop);
xref($op->lastop);
} elsif ($opname eq "subst") {
xref($op->pmreplstart);
} else {
no strict 'refs';
my $ppname = "pp_$opname";
&$ppname($op) if defined(&$ppname);
}
}
}
sub xref_cv {
my $cv = shift;
my $pack = $cv->GV->STASH->NAME;
$subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
load_pad($cv->PADLIST);
xref($cv->START);
$subname = "(main)";
}
sub xref_object {
my $cvref = shift;
xref_cv(svref_2object($cvref));
}
sub xref_main {
$subname = "(main)";
load_pad(comppadlist);
xref(main_start);
while (@todo) {
xref_cv(shift @todo);
}
}
sub pp_nextstate {
my $op = shift;
$file = $op->file;
$line = $op->line;
$top = UNKNOWN;
}
sub pp_padrange {
my $op = shift;
my $count = $op->private & 127;
for my $i (0..$count-1) {
$top = $pad[$op->targ + $i];
process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
}
}
sub pp_padsv {
my $op = shift;
$top = $pad[$op->targ];
process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
}
sub pp_padav { pp_padsv(@_) }
sub pp_padhv { pp_padsv(@_) }
sub deref {
my ($op, $var, $as) = @_;
$var->[1] = $as . $var->[1];
process($var, $op->private & OPpOUR_INTRO ? "intro" : "used");
}
sub pp_rv2cv { deref(shift, $top, "&"); }
sub pp_rv2hv { deref(shift, $top, "%"); }
sub pp_rv2sv { deref(shift, $top, "\$"); }
sub pp_rv2av { deref(shift, $top, "\@"); }
sub pp_rv2gv { deref(shift, $top, "*"); }
sub pp_gvsv {
my $op = shift;
my $gv;
if ($Config{useithreads}) {
$top = $pad[$op->padix];
$top = UNKNOWN unless $top;
$top->[1] = '$';
}
else {
$gv = $op->gv;
$top = [$gv->STASH->NAME, '$', $gv->SAFENAME];
}
process($top, $op->private & OPpLVAL_INTRO ||
$op->private & OPpOUR_INTRO ? "intro" : "used");
}
sub pp_gv {
my $op = shift;
my $gv;
if ($Config{useithreads}) {
$top = $pad[$op->padix];
$top = UNKNOWN unless $top;
$top->[1] = '*';
}
else {
$gv = $op->gv;
if ($gv->FLAGS & SVf_ROK) { # sub ref
my $cv = $gv->RV;
$top = [$cv->STASH->NAME, '*', B::safename($cv->NAME_HEK)]
}
else {
$top = [$gv->STASH->NAME, '*', $gv->SAFENAME];
}
}
process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
}
sub pp_const {
my $op = shift;
my $sv = $op->sv;
# constant could be in the pad (under useithreads)
if ($$sv) {
$top = ["?", "",
(class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK)
? cstring($sv->PV) : "?"];
}
else {
$top = $pad[$op->targ];
$top = UNKNOWN unless $top;
}
}
sub pp_method {
my $op = shift;
$top = ["(method)", "->".$top->[1], $top->[2]];
}
sub pp_entersub {
my $op = shift;
if ($top->[1] eq "m") {
process($top, "meth");
} else {
process($top, "subused");
}
$top = UNKNOWN;
}
#
# Stuff for cross referencing definitions of variables and subs
#
sub B::GV::xref {
my $gv = shift;
my $cv = $gv->CV;
if ($$cv) {
#return if $done{$$cv}++;
$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->FILE;
$line = $gv->LINE;
process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
}
}
sub xref_definitions {
my ($pack, %exclude);
return if $nodefs;
$subname = "(definitions)";
foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS
strict vars FileHandle Exporter Carp PerlIO::Layer
attributes utf8 warnings)) {
$exclude{$pack."::"} = 1;
}
no strict qw(vars refs);
walksymtable(\%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
}
sub output {
return if $raw;
my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
$perpack, $pername, $perev);
foreach $file (sort(keys(%table))) {
$perfile = $table{$file};
print "File $file\n";
foreach $subname (sort(keys(%$perfile))) {
$persubname = $perfile->{$subname};
print " Subroutine $subname\n";
foreach $pack (sort(keys(%$persubname))) {
$perpack = $persubname->{$pack};
print " Package $pack\n";
foreach $name (sort(keys(%$perpack))) {
$pername = $perpack->{$name};
my @lines;
foreach $ev (qw(intro formdef subdef meth subused used)) {
$perev = $pername->{$ev};
if (defined($perev) && @$perev) {
my $code = $code{$ev};
push(@lines, map("$code$_", @$perev));
}
}
printf " %-16s %s\n", $name, join(", ", @lines);
}
}
}
}
}
sub compile {
my @options = @_;
my ($option, $opt, $arg);
OPTION:
while ($option = shift @options) {
if ($option =~ /^-(.)(.*)/) {
$opt = $1;
$arg = $2;
} else {
unshift @options, $option;
last OPTION;
}
if ($opt eq "-" && $arg eq "-") {
shift @options;
last OPTION;
} elsif ($opt eq "o") {
$arg ||= shift @options;
open(STDOUT, '>', $arg) or return "$arg: $!\n";
} elsif ($opt eq "d") {
$nodefs = 1;
} elsif ($opt eq "r") {
$raw = 1;
} elsif ($opt eq "D") {
$arg ||= shift @options;
foreach $arg (split(//, $arg)) {
if ($arg eq "o") {
B->debug(1);
} elsif ($arg eq "O") {
$debug_op = 1;
} elsif ($arg eq "t") {
$debug_top = 1;
}
}
}
}
if (@options) {
return sub {
my $objname;
xref_definitions();
foreach $objname (@options) {
$objname = "main::$objname" unless $objname =~ /::/;
eval "xref_object(\\&$objname)";
die "xref_object(\\&$objname) failed: $@" if $@;
}
output();
}
} else {
return sub {
xref_definitions();
xref_main();
output();
}
}
}
1;