dump.c revision 7c478bd95313f5f23a4c958a745db2134aa03244
/* dump.c
*
* Copyright (c) 1991-2001, Larry Wall
*
* 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) {
}
}
else {
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;
}
else {
sv_catpv(t, "SV_YES");
goto finish;
}
sv_catpv(t, ":");
}
sv_catpv(t, "(");
unref++;
}
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 = '/';
if (pm->op_pmregexp)
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) {
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)
}
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 & 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)
}
else
switch (o->op_private & OPpDEREF) {
case OPpDEREF_SV:
break;
case OPpDEREF_AV:
break;
case OPpDEREF_HV:
break;
}
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 & OPpFLIP_LINENUM)
}
if (o->op_private & OPpFLIP_LINENUM)
if (o->op_private & OPpLVAL_INTRO)
}
}
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:
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();
}
}
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";
if (s)
else
}
else
if (mg->mg_private)
else
}
}
}
do_sv_dump(level+2, file, (SV*)((mg)->mg_ptr), nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
continue;
}
else
}
}
}
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,");
}
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 THROGH */
default:
break;
case SVt_PVBM:
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;
}
SvREFCNT_dec(d);
return;
}
}
else
}
}
switch (type) {
case SVt_PVLV:
/* XXX level+1 ??? */
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)
}
}
/* Now calculate quality wrt theoretical value */
for (i = max; i > 0; i--) { /* Precision: count down. */
}
/* Approximate by Poisson distribution */
}
char *key;
Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%"UVxf"\n", pv_display(d, key, len, 0, pvlim), (UV)hash);
}
}
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_THREADS
#endif /* USE_THREADS */
/* %5d below is enough whitespace. */
file,
}
}
{
(!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
{
}