dump.c revision 7c478bd95313f5f23a4c958a745db2134aa03244
/* dump.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 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.
*
*/
/*
* "'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
* it has not been hard for me to read your mind and memory.'"
*/
#include "EXTERN.h"
#define PERL_IN_DUMP_C
#include "perl.h"
#include "regcomp.h"
void
{
}
void
{
}
void
{
if (PL_main_root)
}
void
{
I32 i;
return;
continue;
}
}
}
void
{
else
}
void
{
else
}
void
{
}
char *
{
int truncated = 0;
truncated++;
break;
}
switch (*pv) {
default:
else
}
}
if (truncated)
if (nul_terminated)
}
char *
{
SV *t = sv_newmortal();
int unref = 0;
sv_setpvn(t, "", 0);
if (!sv) {
sv_catpv(t, "VOID");
goto finish;
}
sv_catpv(t, "WILD");
goto finish;
}
if (sv == &PL_sv_undef) {
sv_catpv(t, "SV_UNDEF");
SvREADONLY(sv))
goto finish;
}
sv_catpv(t, "SV_NO");
goto finish;
}
sv_catpv(t, "SV_YES");
goto finish;
}
else {
sv_catpv(t, "SV_PLACEHOLDER");
SvREADONLY(sv))
goto finish;
}
sv_catpv(t, ":");
}
sv_catpv(t, "(");
unref++;
}
else if (DEBUG_R_TEST_) {
int is_tmp = 0;
/* is this SV on the tmps stack? */
is_tmp = 1;
break;
}
}
else if (is_tmp)
sv_catpv(t, "<T>");
}
sv_catpv(t, "\\");
*SvEND(t) = '\0';
sv_catpv(t, "...");
goto finish;
}
goto retry;
}
default:
sv_catpv(t, "FREED");
goto finish;
case SVt_NULL:
sv_catpv(t, "UNDEF");
goto finish;
case SVt_IV:
sv_catpv(t, "IV");
break;
case SVt_NV:
sv_catpv(t, "NV");
break;
case SVt_RV:
sv_catpv(t, "RV");
break;
case SVt_PV:
sv_catpv(t, "PV");
break;
case SVt_PVIV:
sv_catpv(t, "PVIV");
break;
case SVt_PVNV:
sv_catpv(t, "PVNV");
break;
case SVt_PVMG:
sv_catpv(t, "PVMG");
break;
case SVt_PVLV:
sv_catpv(t, "PVLV");
break;
case SVt_PVAV:
sv_catpv(t, "AV");
break;
case SVt_PVHV:
sv_catpv(t, "HV");
break;
case SVt_PVCV:
else
sv_catpv(t, "CV()");
goto finish;
case SVt_PVGV:
sv_catpv(t, "GV");
break;
case SVt_PVBM:
sv_catpv(t, "BM");
break;
case SVt_PVFM:
sv_catpv(t, "FM");
break;
case SVt_PVIO:
sv_catpv(t, "IO");
break;
}
sv_catpv(t, "(null)");
else {
sv_catpv(t, "(");
}
}
}
else
}
else
sv_catpv(t, "()");
if (unref) {
while (unref--)
sv_catpv(t, ")");
}
}
void
{
char ch;
if (!pm) {
return;
}
level++;
ch = '?';
else
ch = '/';
else
}
}
}
void
{
}
void
{
level++;
if (o->op_seq)
else
"%*sTYPE = %s ===> ",
if (o->op_next) {
if (o->op_seq)
else
}
else
if (o->op_targ) {
{
if (o->op_targ == OP_NEXTSTATE)
{
if (CopSTASHPV(cCOPo))
CopSTASHPV(cCOPo));
}
}
else
}
#ifdef DUMPADDR
#endif
if (o->op_flags) {
case OPf_WANT_VOID:
break;
case OPf_WANT_SCALAR:
break;
case OPf_WANT_LIST:
break;
default:
break;
}
if (o->op_flags & OPf_PARENS)
if (o->op_flags & OPf_STACKED)
if (o->op_flags & OPf_SPECIAL)
}
if (o->op_private) {
if (o->op_private & OPpTARGET_MY)
}
else if (o->op_type == OP_LEAVESUB ||
o->op_type == OP_LEAVESUBLV ||
o->op_type == OP_LEAVEWRITE) {
if (o->op_private & OPpREFCOUNTED)
}
else if (o->op_type == OP_AASSIGN) {
if (o->op_private & OPpASSIGN_COMMON)
if (o->op_private & OPpASSIGN_HASH)
}
else if (o->op_type == OP_SASSIGN) {
if (o->op_private & OPpASSIGN_BACKWARDS)
}
if (o->op_private & OPpTRANS_SQUASH)
if (o->op_private & OPpTRANS_DELETE)
if (o->op_private & OPpTRANS_COMPLEMENT)
if (o->op_private & OPpTRANS_IDENTICAL)
if (o->op_private & OPpTRANS_GROWS)
}
if (o->op_private & OPpREPEAT_DOLIST)
}
else if (o->op_type == OP_ENTERSUB ||
{
if (o->op_type == OP_ENTERSUB) {
if (o->op_private & OPpENTERSUB_AMPER)
if (o->op_private & OPpENTERSUB_DB)
if (o->op_private & OPpENTERSUB_HASTARG)
if (o->op_private & OPpENTERSUB_NOPAREN)
if (o->op_private & OPpENTERSUB_INARGS)
if (o->op_private & OPpENTERSUB_NOMOD)
}
else {
switch (o->op_private & OPpDEREF) {
case OPpDEREF_SV:
break;
case OPpDEREF_AV:
break;
case OPpDEREF_HV:
break;
}
if (o->op_private & OPpMAYBE_LVSUB)
}
if (o->op_private & OPpLVAL_DEFER)
}
else {
if (o->op_private & HINT_STRICT_REFS)
if (o->op_private & OPpOUR_INTRO)
}
}
if (o->op_private & OPpCONST_BARE)
if (o->op_private & OPpCONST_STRICT)
if (o->op_private & OPpCONST_ARYBASE)
if (o->op_private & OPpCONST_WARNING)
if (o->op_private & OPpCONST_ENTERED)
}
if (o->op_private & OPpFLIP_LINENUM)
}
if (o->op_private & OPpFLIP_LINENUM)
}
if (o->op_private & OPpLVAL_INTRO)
}
if (o->op_private & OPpEARLY_CV)
}
if (o->op_private & OPpLIST_GUESSED)
}
if (o->op_private & OPpSLICE)
}
if (o->op_private & OPpEXISTS_SUB)
}
if (o->op_private & OPpSORT_NUMERIC)
if (o->op_private & OPpSORT_INTEGER)
if (o->op_private & OPpSORT_REVERSE)
}
else if (o->op_type == OP_THREADSV) {
if (o->op_private & OPpDONE_SVREF)
}
if (o->op_private & OPpOPEN_IN_RAW)
if (o->op_private & OPpOPEN_IN_CRLF)
if (o->op_private & OPpOPEN_OUT_RAW)
if (o->op_private & OPpOPEN_OUT_CRLF)
}
if (o->op_private & OPpEXIT_VMSISH)
if (o->op_private & OPpHUSH_VMSISH)
}
if (o->op_private & OPpHUSH_VMSISH)
}
else if (OP_IS_FILETEST_ACCESS(o)) {
if (o->op_private & OPpFT_ACCESS)
}
}
switch (o->op_type) {
case OP_AELEMFAST:
case OP_GVSV:
case OP_GV:
#ifdef USE_ITHREADS
#else
}
else
}
#endif
break;
case OP_CONST:
case OP_METHOD_NAMED:
#ifndef USE_ITHREADS
/* with ITHREADS, consts are stored in the pad, and the right pad
* may not be active here, so skip */
#endif
break;
case OP_SETSTATE:
case OP_NEXTSTATE:
case OP_DBSTATE:
if (CopSTASHPV(cCOPo))
CopSTASHPV(cCOPo));
break;
case OP_ENTERLOOP:
else
else
else
break;
case OP_COND_EXPR:
case OP_RANGE:
case OP_MAPWHILE:
case OP_GREPWHILE:
case OP_OR:
case OP_AND:
else
break;
case OP_PUSHRE:
case OP_MATCH:
case OP_QR:
case OP_SUBST:
break;
case OP_LEAVE:
case OP_LEAVEEVAL:
case OP_LEAVESUB:
case OP_LEAVESUBLV:
case OP_LEAVEWRITE:
case OP_SCOPE:
if (o->op_private & OPpREFCOUNTED)
break;
default:
break;
}
}
}
void
{
do_op_dump(0, Perl_debug_log, o);
}
void
{
if (!gv) {
return;
}
sv = sv_newmortal();
}
}
/* map magic types to the symbolic names
* (with the PERL_MAGIC_ prefixed stripped)
*/
{ PERL_MAGIC_sv, "sv(\\0)" },
{ PERL_MAGIC_arylen, "arylen(#)" },
{ PERL_MAGIC_glob, "glob(*)" },
{ PERL_MAGIC_pos, "pos(.)" },
{ PERL_MAGIC_backref, "backref(<)" },
{ PERL_MAGIC_overload, "overload(A)" },
{ PERL_MAGIC_bm, "bm(B)" },
{ PERL_MAGIC_regdata, "regdata(D)" },
{ PERL_MAGIC_env, "env(E)" },
{ PERL_MAGIC_isa, "isa(I)" },
{ PERL_MAGIC_dbfile, "dbfile(L)" },
{ PERL_MAGIC_shared, "shared(N)" },
{ PERL_MAGIC_tied, "tied(P)" },
{ PERL_MAGIC_sig, "sig(S)" },
{ PERL_MAGIC_uvar, "uvar(U)" },
{ PERL_MAGIC_overload_elem, "overload_elem(a)" },
{ PERL_MAGIC_overload_table, "overload_table(c)" },
{ PERL_MAGIC_regdatum, "regdatum(d)" },
{ PERL_MAGIC_envelem, "envelem(e)" },
{ PERL_MAGIC_fm, "fm(f)" },
{ PERL_MAGIC_regex_global, "regex_global(g)" },
{ PERL_MAGIC_isaelem, "isaelem(i)" },
{ PERL_MAGIC_nkeys, "nkeys(k)" },
{ PERL_MAGIC_dbline, "dbline(l)" },
{ PERL_MAGIC_mutex, "mutex(m)" },
{ PERL_MAGIC_shared_scalar, "shared_scalar(n)" },
{ PERL_MAGIC_collxfrm, "collxfrm(o)" },
{ PERL_MAGIC_tiedelem, "tiedelem(p)" },
{ PERL_MAGIC_tiedscalar, "tiedscalar(q)" },
{ PERL_MAGIC_qr, "qr(r)" },
{ PERL_MAGIC_sigelem, "sigelem(s)" },
{ PERL_MAGIC_taint, "taint(t)" },
{ PERL_MAGIC_uvar_elem, "uvar_elem(v)" },
{ PERL_MAGIC_vec, "vec(v)" },
{ PERL_MAGIC_vstring, "v-string(V)" },
{ PERL_MAGIC_utf8, "utf8(w)" },
{ PERL_MAGIC_substr, "substr(x)" },
{ PERL_MAGIC_defelem, "defelem(y)" },
{ PERL_MAGIC_ext, "ext(~)" },
/* this null string terminates the list */
{ 0, 0 },
};
void
Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
{
if (mg->mg_virtual) {
char *s = 0;
if (v == &PL_vtbl_sv) s = "sv";
else if (v == &PL_vtbl_env) s = "env";
else if (v == &PL_vtbl_envelem) s = "envelem";
else if (v == &PL_vtbl_sig) s = "sig";
else if (v == &PL_vtbl_sigelem) s = "sigelem";
else if (v == &PL_vtbl_pack) s = "pack";
else if (v == &PL_vtbl_packelem) s = "packelem";
else if (v == &PL_vtbl_dbline) s = "dbline";
else if (v == &PL_vtbl_isa) s = "isa";
else if (v == &PL_vtbl_arylen) s = "arylen";
else if (v == &PL_vtbl_glob) s = "glob";
else if (v == &PL_vtbl_mglob) s = "mglob";
else if (v == &PL_vtbl_nkeys) s = "nkeys";
else if (v == &PL_vtbl_taint) s = "taint";
else if (v == &PL_vtbl_substr) s = "substr";
else if (v == &PL_vtbl_vec) s = "vec";
else if (v == &PL_vtbl_pos) s = "pos";
else if (v == &PL_vtbl_bm) s = "bm";
else if (v == &PL_vtbl_fm) s = "fm";
else if (v == &PL_vtbl_uvar) s = "uvar";
else if (v == &PL_vtbl_defelem) s = "defelem";
#ifdef USE_LOCALE_COLLATE
else if (v == &PL_vtbl_collxfrm) s = "collxfrm";
#endif
else if (v == &PL_vtbl_amagic) s = "amagic";
else if (v == &PL_vtbl_amagicelem) s = "amagicelem";
else if (v == &PL_vtbl_backref) s = "backref";
else if (v == &PL_vtbl_utf8) s = "utf8";
if (s)
else
}
else
if (mg->mg_private)
{
int n;
char *name = 0;
for (n=0; magic_names[n].name; n++) {
break;
}
}
if (name)
" MG_TYPE = PERL_MAGIC_%s\n", name);
else
}
}
}
}
}
do_sv_dump(level+2, file, (SV*)((mg)->mg_ptr), nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
continue;
}
else
}
if (cache) {
IV i;
for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
i,
}
}
}
}
void
{
}
void
{
else
}
void
{
else
}
void
{
}
else
}
void
Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
{
SV *d;
char *s;
if (!sv) {
return;
}
d = Perl_newSVpvf(aTHX_
sv_catpv(d, "ROK,");
}
sv_catpv(d, "OVERLOAD,");
switch (type) {
case SVt_PVCV:
case SVt_PVFM:
break;
case SVt_PVHV:
break;
case SVt_PVGV:
if (GvIMPORTED(sv)) {
sv_catpv(d, "IMPORT");
sv_catpv(d, "ALL,");
else {
sv_catpv(d, "(");
sv_catpv(d, " ),");
}
}
/* FALL THROUGH */
default:
break;
case SVt_PVBM:
break;
case SVt_PVMG:
if (flags & SVpad_TYPED)
sv_catpv(d, "TYPED,");
break;
}
sv_catpv(d, "UTF8");
sv_catpv(d, ")");
s = SvPVX(d);
switch (type) {
case SVt_NULL:
SvREFCNT_dec(d);
return;
case SVt_IV:
break;
case SVt_NV:
break;
case SVt_RV:
break;
case SVt_PV:
break;
case SVt_PVIV:
break;
case SVt_PVNV:
break;
case SVt_PVBM:
break;
case SVt_PVMG:
break;
case SVt_PVLV:
break;
case SVt_PVAV:
break;
case SVt_PVHV:
break;
case SVt_PVCV:
break;
case SVt_PVGV:
break;
case SVt_PVFM:
break;
case SVt_PVIO:
break;
default:
SvREFCNT_dec(d);
return;
}
else
}
/* %Vg doesn't work? --jhi */
#ifdef USE_LONG_DOUBLE
#else
#endif
}
}
SvREFCNT_dec(d);
return;
}
}
else
}
}
switch (type) {
case SVt_PVLV:
break;
case SVt_PVAV:
}
else
sv_setpv(d, "");
int count;
if (elt)
}
}
break;
case SVt_PVHV:
/* Show distribution of HEs in the ARRAY */
int freq[200];
int i;
int max = 0;
count++;
}
for (i = 0; i <= max; i++) {
if (freq[i]) {
freq[i]);
if (i != max)
}
}
/* The "quality" of a hash is defined as the total number of
comparisons needed to access every element once, relative
to the expected number needed for a random hash.
The total number of comparisons is equal to the sum of
the squares of the number of entries in each bucket.
For a random hash of n keys into k buckets, the expected
value is
n + n(n-1)/2k
*/
for (i = max; i > 0; i--) { /* Precision: count down. */
}
}
&& count--) {
char *keypv;
PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv), UNI_DISPLAY_QQ));
}
}
break;
case SVt_PVCV:
/* FALL THROUGH */
case SVt_PVFM:
Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)CvSTART(sv)->op_seq);
#ifdef USE_5005THREADS
#endif /* USE_5005THREADS */
}
{
(!outside ? "null"
}
break;
case SVt_PVGV:
break;
break;
case SVt_PVIO:
if (IoTOP_NAME(sv))
if (IoFMT_NAME(sv))
if (IoBOTTOM_NAME(sv))
else
break;
}
SvREFCNT_dec(d);
}
void
{
}
int
{
if (!PL_op) {
if (ckWARN_d(WARN_DEBUGGING))
return 0;
}
do {
if (PL_debug) {
PTR2UV(*PL_watchaddr));
if (DEBUG_s_TEST_) {
if (DEBUG_v_TEST_) {
}
else
debstack();
}
}
return 0;
}
{
return 0;
switch (o->op_type) {
case OP_CONST:
break;
case OP_GVSV:
case OP_GV:
if (cGVOPo_gv) {
}
else
break;
case OP_PADSV:
case OP_PADAV:
case OP_PADHV:
/* print the lexical's name */
if (cv) {
} else
if (sv)
else
break;
default:
break;
}
return 0;
}
{
return PL_compcv;
return PL_main_cv;
else if (ix <= 0)
return Nullcv;
else
}
void
{
PL_watchaddr = addr;
PL_watchok = *addr;
}
STATIC void
{
return;
if (!PL_profiledata)
++PL_profiledata[o->op_type];
}
void
{
unsigned i;
if (!PL_profiledata)
return;
for (i = 0; i < MAXO; i++) {
if (PL_profiledata[i])
"%5lu %s\n", (unsigned long)PL_profiledata[i],
PL_op_name[i]);
}
}