[p5sagit/p5-mst-13.2.git] / dump.c

/*    dump.c
 *
 *    Copyright (c) 1991-1994, 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"
#include "perl.h"

#ifndef DEBUGGING
void
dump_all()
{
}
#else  /* Rest of file is for DEBUGGING */

#ifdef I_STDARG
static void dump(char *pat, ...);
#else
#  if defined(I_VARARGS)
/*VARARGS0*/
static void
dump(pat, va_alist)
    char *pat;
    va_dcl
#  else
static void dump();
#  endif
#endif

void
dump_all()
{
#ifdef HAS_SETLINEBUF
    setlinebuf(Perl_debug_log);
#else
    setvbuf(Perl_debug_log, Nullch, _IOLBF, 0);
#endif
    if (main_root)
	dump_op(main_root);
    dump_packsubs(defstash);
}

void
dump_packsubs(stash)
HV* stash;
{
    I32	i;
    HE	*entry;

    if (!HvARRAY(stash))
	return;
    for (i = 0; i <= (I32) HvMAX(stash); i++) {
	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
	    GV *gv = (GV*)HeVAL(entry);
	    HV *hv;
	    if (GvCV(gv))
		dump_sub(gv);
	    if (GvFORM(gv))
		dump_form(gv);
	    if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
	      (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash)
		dump_packsubs(hv);		/* nested package */
	}
    }
}

void
dump_sub(gv)
GV* gv;
{
    SV *sv = sv_newmortal();

    gv_fullname(sv,gv);
    dump("\nSUB %s = ", SvPVX(sv));
    if (CvXSUB(GvCV(gv)))
	dump("(xsub 0x%x %d)\n",
	    (long)CvXSUB(GvCV(gv)),
	    CvXSUBANY(GvCV(gv)).any_i32);
    else if (CvROOT(GvCV(gv)))
	dump_op(CvROOT(GvCV(gv)));
    else
	dump("<undef>\n");
}

void
dump_form(gv)
GV* gv;
{
    SV *sv = sv_newmortal();

    gv_fullname(sv,gv);
    dump("\nFORMAT %s = ", SvPVX(sv));
    if (CvROOT(GvFORM(gv)))
	dump_op(CvROOT(GvFORM(gv)));
    else
	dump("<undef>\n");
}

void
dump_eval()
{
    dump_op(eval_root);
}

void
dump_op(op)
register OP *op;
{
    SV *tmpsv;

    dump("{\n");
    if (op->op_seq)
	fprintf(Perl_debug_log, "%-4d", op->op_seq);
    else
	fprintf(Perl_debug_log, "    ");
    dump("TYPE = %s  ===> ", op_name[op->op_type]);
    if (op->op_next) {
	if (op->op_seq)
	    fprintf(Perl_debug_log, "%d\n", op->op_next->op_seq);
	else
	    fprintf(Perl_debug_log, "(%d)\n", op->op_next->op_seq);
    }
    else
	fprintf(Perl_debug_log, "DONE\n");
    dumplvl++;
    if (op->op_targ) {
	if (op->op_type == OP_NULL)
	    dump("  (was %s)\n", op_name[op->op_targ]);
	else
	    dump("TARG = %d\n", op->op_targ);
    }
#ifdef DUMPADDR
    dump("ADDR = 0x%lx => 0x%lx\n",op, op->op_next);
#endif
    if (op->op_flags) {
	*buf = '\0';
	if (op->op_flags & OPf_KNOW) {
	    if (op->op_flags & OPf_LIST)
		(void)strcat(buf,"LIST,");
	    else
		(void)strcat(buf,"SCALAR,");
	}
	else
	    (void)strcat(buf,"UNKNOWN,");
	if (op->op_flags & OPf_KIDS)
	    (void)strcat(buf,"KIDS,");
	if (op->op_flags & OPf_PARENS)
	    (void)strcat(buf,"PARENS,");
	if (op->op_flags & OPf_STACKED)
	    (void)strcat(buf,"STACKED,");
	if (op->op_flags & OPf_REF)
	    (void)strcat(buf,"REF,");
	if (op->op_flags & OPf_MOD)
	    (void)strcat(buf,"MOD,");
	if (op->op_flags & OPf_SPECIAL)
	    (void)strcat(buf,"SPECIAL,");
	if (*buf)
	    buf[strlen(buf)-1] = '\0';
	dump("FLAGS = (%s)\n",buf);
    }
    if (op->op_private) {
	*buf = '\0';
	if (op->op_type == OP_AASSIGN) {
	    if (op->op_private & OPpASSIGN_COMMON)
		(void)strcat(buf,"COMMON,");
	}
	else if (op->op_type == OP_SASSIGN) {
	    if (op->op_private & OPpASSIGN_BACKWARDS)
		(void)strcat(buf,"BACKWARDS,");
	}
	else if (op->op_type == OP_TRANS) {
	    if (op->op_private & OPpTRANS_SQUASH)
		(void)strcat(buf,"SQUASH,");
	    if (op->op_private & OPpTRANS_DELETE)
		(void)strcat(buf,"DELETE,");
	    if (op->op_private & OPpTRANS_COMPLEMENT)
		(void)strcat(buf,"COMPLEMENT,");
	}
	else if (op->op_type == OP_REPEAT) {
	    if (op->op_private & OPpREPEAT_DOLIST)
		(void)strcat(buf,"DOLIST,");
	}
	else if (op->op_type == OP_ENTERSUB ||
		 op->op_type == OP_RV2SV ||
		 op->op_type == OP_RV2AV ||
		 op->op_type == OP_RV2HV ||
		 op->op_type == OP_RV2GV ||
		 op->op_type == OP_AELEM ||
		 op->op_type == OP_HELEM )
	{
	    if (op->op_private & OPpENTERSUB_AMPER)
		(void)strcat(buf,"AMPER,");
	    if (op->op_private & OPpENTERSUB_DB)
		(void)strcat(buf,"DB,");
	    if (op->op_private & OPpDEREF_AV)
		(void)strcat(buf,"AV,");
	    if (op->op_private & OPpDEREF_HV)
		(void)strcat(buf,"HV,");
	    if (op->op_private & HINT_STRICT_REFS)
		(void)strcat(buf,"STRICT_REFS,");
	}
	else if (op->op_type == OP_CONST) {
	    if (op->op_private & OPpCONST_BARE)
		(void)strcat(buf,"BARE,");
	}
	else if (op->op_type == OP_FLIP) {
	    if (op->op_private & OPpFLIP_LINENUM)
		(void)strcat(buf,"LINENUM,");
	}
	else if (op->op_type == OP_FLOP) {
	    if (op->op_private & OPpFLIP_LINENUM)
		(void)strcat(buf,"LINENUM,");
	}
	if (op->op_flags & OPf_MOD && op->op_private & OPpLVAL_INTRO)
	    (void)strcat(buf,"INTRO,");
	if (*buf) {
	    buf[strlen(buf)-1] = '\0';
	    dump("PRIVATE = (%s)\n",buf);
	}
    }

    switch (op->op_type) {
    case OP_GVSV:
    case OP_GV:
	if (cGVOP->op_gv) {
	    ENTER;
	    tmpsv = NEWSV(0,0);
	    SAVEFREESV(tmpsv);
	    gv_fullname(tmpsv,cGVOP->op_gv);
	    dump("GV = %s\n", SvPV(tmpsv, na));
	    LEAVE;
	}
	else
	    dump("GV = NULL\n");
	break;
    case OP_CONST:
	dump("SV = %s\n", SvPEEK(cSVOP->op_sv));
	break;
    case OP_NEXTSTATE:
    case OP_DBSTATE:
	if (cCOP->cop_line)
	    dump("LINE = %d\n",cCOP->cop_line);
	if (cCOP->cop_label)
	    dump("LABEL = \"%s\"\n",cCOP->cop_label);
	break;
    case OP_ENTERLOOP:
	dump("REDO ===> ");
	if (cLOOP->op_redoop)
	    fprintf(Perl_debug_log, "%d\n", cLOOP->op_redoop->op_seq);
	else
	    fprintf(Perl_debug_log, "DONE\n");
	dump("NEXT ===> ");
	if (cLOOP->op_nextop)
	    fprintf(Perl_debug_log, "%d\n", cLOOP->op_nextop->op_seq);
	else
	    fprintf(Perl_debug_log, "DONE\n");
	dump("LAST ===> ");
	if (cLOOP->op_lastop)
	    fprintf(Perl_debug_log, "%d\n", cLOOP->op_lastop->op_seq);
	else
	    fprintf(Perl_debug_log, "DONE\n");
	break;
    case OP_COND_EXPR:
	dump("TRUE ===> ");
	if (cCONDOP->op_true)
	    fprintf(Perl_debug_log, "%d\n", cCONDOP->op_true->op_seq);
	else
	    fprintf(Perl_debug_log, "DONE\n");
	dump("FALSE ===> ");
	if (cCONDOP->op_false)
	    fprintf(Perl_debug_log, "%d\n", cCONDOP->op_false->op_seq);
	else
	    fprintf(Perl_debug_log, "DONE\n");
	break;
    case OP_MAPWHILE:
    case OP_GREPWHILE:
    case OP_OR:
    case OP_AND:
	dump("OTHER ===> ");
	if (cLOGOP->op_other)
	    fprintf(Perl_debug_log, "%d\n", cLOGOP->op_other->op_seq);
	else
	    fprintf(Perl_debug_log, "DONE\n");
	break;
    case OP_PUSHRE:
    case OP_MATCH:
    case OP_SUBST:
	dump_pm((PMOP*)op);
	break;
    default:
	break;
    }
    if (op->op_flags & OPf_KIDS) {
	OP *kid;
	for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
	    dump_op(kid);
    }
    dumplvl--;
    dump("}\n");
}

void
dump_gv(gv)
register GV *gv;
{
    SV *sv;

    if (!gv) {
	fprintf(Perl_debug_log,"{}\n");
	return;
    }
    sv = sv_newmortal();
    dumplvl++;
    fprintf(Perl_debug_log,"{\n");
    gv_fullname(sv,gv);
    dump("GV_NAME = %s", SvPVX(sv));
    if (gv != GvEGV(gv)) {
	gv_efullname(sv,GvEGV(gv));
	dump("-> %s", SvPVX(sv));
    }
    dump("\n");
    dumplvl--;
    dump("}\n");
}

void
dump_pm(pm)
register PMOP *pm;
{
    char ch;

    if (!pm) {
	dump("{}\n");
	return;
    }
    dump("{\n");
    dumplvl++;
    if (pm->op_pmflags & PMf_ONCE)
	ch = '?';
    else
	ch = '/';
    if (pm->op_pmregexp)
	dump("PMf_PRE %c%s%c\n",ch,pm->op_pmregexp->precomp,ch);
    if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
	dump("PMf_REPL = ");
	dump_op(pm->op_pmreplroot);
    }
    if (pm->op_pmshort) {
	dump("PMf_SHORT = %s\n",SvPEEK(pm->op_pmshort));
    }
    if (pm->op_pmflags) {
	*buf = '\0';
	if (pm->op_pmflags & PMf_USED)
	    (void)strcat(buf,"USED,");
	if (pm->op_pmflags & PMf_ONCE)
	    (void)strcat(buf,"ONCE,");
	if (pm->op_pmflags & PMf_SCANFIRST)
	    (void)strcat(buf,"SCANFIRST,");
	if (pm->op_pmflags & PMf_ALL)
	    (void)strcat(buf,"ALL,");
	if (pm->op_pmflags & PMf_SKIPWHITE)
	    (void)strcat(buf,"SKIPWHITE,");
	if (pm->op_pmflags & PMf_FOLD)
	    (void)strcat(buf,"FOLD,");
	if (pm->op_pmflags & PMf_CONST)
	    (void)strcat(buf,"CONST,");
	if (pm->op_pmflags & PMf_KEEP)
	    (void)strcat(buf,"KEEP,");
	if (pm->op_pmflags & PMf_GLOBAL)
	    (void)strcat(buf,"GLOBAL,");
	if (pm->op_pmflags & PMf_RUNTIME)
	    (void)strcat(buf,"RUNTIME,");
	if (pm->op_pmflags & PMf_EVAL)
	    (void)strcat(buf,"EVAL,");
	if (*buf)
	    buf[strlen(buf)-1] = '\0';
	dump("PMFLAGS = (%s)\n",buf);
    }

    dumplvl--;
    dump("}\n");
}


#if !defined(I_STDARG) && !defined(I_VARARGS)
/* VARARGS1 */
static void dump(arg1,arg2,arg3,arg4,arg5)
char *arg1;
long arg2, arg3, arg4, arg5;
{
    I32 i;

    for (i = dumplvl*4; i; i--)
	(void)putc(' ',Perl_debug_log);
    fprintf(Perl_debug_log,arg1, arg2, arg3, arg4, arg5);
}

#else

#ifdef I_STDARG
static void
dump(char *pat,...)
#else
/*VARARGS0*/
static void
dump(pat,va_alist)
    char *pat;
    va_dcl
#endif
{
    I32 i;
    va_list args;
#ifndef HAS_VPRINTF
    int vfprintf();
#endif

#ifdef I_STDARG
    va_start(args, pat);
#else
    va_start(args);
#endif
    for (i = dumplvl*4; i; i--)
	(void)putc(' ',stderr);
    vfprintf(Perl_debug_log,pat,args);
    va_end(args);
}
#endif

#endif
Commit	Line	Data
a0d0e21e	1	/* dump.c
a687059c	2	*
a0d0e21e	3	* Copyright (c) 1991-1994, Larry Wall
a687059c	4	*
6e21c824	5	* You may distribute under the terms of either the GNU General Public
6e21c824	6	* License or the Artistic License, as specified in the README file.
8d063cd8	7	*
a0d0e21e	8	*/
	9
	10	/*
	11	* "'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
	12	* it has not been hard for me to read your mind and memory.'"
8d063cd8	13	*/
8d063cd8	14
8d063cd8	15	#include "EXTERN.h"
8d063cd8	16	#include "perl.h"
8d063cd8	17
2304df62	18	#ifndef DEBUGGING
	19	void
	20	dump_all()
	21	{
	22	}
	23	#else /* Rest of file is for DEBUGGING */
8d063cd8	24
4db58590	25	#ifdef I_STDARG
	26	static void dump(char *pat, ...);
	27	#else
	28	# if defined(I_VARARGS)
	29	/VARARGS0/
	30	static void
	31	dump(pat, va_alist)
	32	char *pat;
	33	va_dcl
	34	# else
8adcabd8	35	static void dump();
4db58590	36	# endif
4db58590	37	#endif
8adcabd8	38
8adcabd8	39	void
93a17b20	40	dump_all()
79072805	41	{
2304df62	42	#ifdef HAS_SETLINEBUF
4db58590	43	setlinebuf(Perl_debug_log);
2304df62	44	#else
4db58590	45	setvbuf(Perl_debug_log, Nullch, _IOLBF, 0);
2304df62	46	#endif
93a17b20	47	if (main_root)
93a17b20	48	dump_op(main_root);
463ee0b2	49	dump_packsubs(defstash);
	50	}
	51
	52	void
	53	dump_packsubs(stash)
	54	HV* stash;
	55	{
a0d0e21e	56	I32 i;
463ee0b2	57	HE *entry;
463ee0b2	58
8990e307	59	if (!HvARRAY(stash))
8990e307	60	return;
a0d0e21e	61	for (i = 0; i <= (I32) HvMAX(stash); i++) {
4db58590	62	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
4db58590	63	GV gv = (GV)HeVAL(entry);
463ee0b2	64	HV *hv;
	65	if (GvCV(gv))
	66	dump_sub(gv);
85e6fe83	67	if (GvFORM(gv))
85e6fe83	68	dump_form(gv);
4db58590	69	if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
a0d0e21e	70	(hv = GvHV(gv)) && HvNAME(hv) && hv != defstash)
463ee0b2	71	dump_packsubs(hv); /* nested package */
463ee0b2	72	}
79072805	73	}
	74	}
	75
	76	void
93a17b20	77	dump_sub(gv)
93a17b20	78	GV* gv;
a687059c	79	{
8990e307	80	SV *sv = sv_newmortal();
85e6fe83	81
	82	gv_fullname(sv,gv);
	83	dump("\nSUB %s = ", SvPVX(sv));
a0d0e21e	84	if (CvXSUB(GvCV(gv)))
85e6fe83	85	dump("(xsub 0x%x %d)\n",
a0d0e21e	86	(long)CvXSUB(GvCV(gv)),
a0d0e21e	87	CvXSUBANY(GvCV(gv)).any_i32);
85e6fe83	88	else if (CvROOT(GvCV(gv)))
	89	dump_op(CvROOT(GvCV(gv)));
	90	else
	91	dump("<undef>\n");
	92	}
	93
	94	void
	95	dump_form(gv)
	96	GV* gv;
	97	{
	98	SV *sv = sv_newmortal();
	99
	100	gv_fullname(sv,gv);
	101	dump("\nFORMAT %s = ", SvPVX(sv));
	102	if (CvROOT(GvFORM(gv)))
	103	dump_op(CvROOT(GvFORM(gv)));
	104	else
	105	dump("<undef>\n");
a687059c	106	}
a687059c	107
8adcabd8	108	void
79072805	109	dump_eval()
8d063cd8	110	{
79072805	111	dump_op(eval_root);
	112	}
	113
	114	void
	115	dump_op(op)
	116	register OP *op;
	117	{
	118	SV *tmpsv;
	119
79072805	120	dump("{\n");
93a17b20	121	if (op->op_seq)
4db58590	122	fprintf(Perl_debug_log, "%-4d", op->op_seq);
93a17b20	123	else
4db58590	124	fprintf(Perl_debug_log, " ");
79072805	125	dump("TYPE = %s ===> ", op_name[op->op_type]);
93a17b20	126	if (op->op_next) {
93a17b20	127	if (op->op_seq)
4db58590	128	fprintf(Perl_debug_log, "%d\n", op->op_next->op_seq);
93a17b20	129	else
4db58590	130	fprintf(Perl_debug_log, "(%d)\n", op->op_next->op_seq);
93a17b20	131	}
79072805	132	else
4db58590	133	fprintf(Perl_debug_log, "DONE\n");
79072805	134	dumplvl++;
8990e307	135	if (op->op_targ) {
	136	if (op->op_type == OP_NULL)
	137	dump(" (was %s)\n", op_name[op->op_targ]);
	138	else
	139	dump("TARG = %d\n", op->op_targ);
	140	}
748a9306	141	#ifdef DUMPADDR
79072805	142	dump("ADDR = 0x%lx => 0x%lx\n",op, op->op_next);
	143	#endif
	144	if (op->op_flags) {
8d063cd8	145	*buf = '\0';
79072805	146	if (op->op_flags & OPf_KNOW) {
	147	if (op->op_flags & OPf_LIST)
	148	(void)strcat(buf,"LIST,");
	149	else
	150	(void)strcat(buf,"SCALAR,");
	151	}
	152	else
	153	(void)strcat(buf,"UNKNOWN,");
	154	if (op->op_flags & OPf_KIDS)
	155	(void)strcat(buf,"KIDS,");
	156	if (op->op_flags & OPf_PARENS)
	157	(void)strcat(buf,"PARENS,");
	158	if (op->op_flags & OPf_STACKED)
	159	(void)strcat(buf,"STACKED,");
a0d0e21e	160	if (op->op_flags & OPf_REF)
	161	(void)strcat(buf,"REF,");
	162	if (op->op_flags & OPf_MOD)
	163	(void)strcat(buf,"MOD,");
79072805	164	if (op->op_flags & OPf_SPECIAL)
79072805	165	(void)strcat(buf,"SPECIAL,");
8d063cd8	166	if (*buf)
8d063cd8	167	buf[strlen(buf)-1] = '\0';
79072805	168	dump("FLAGS = (%s)\n",buf);
	169	}
	170	if (op->op_private) {
	171	*buf = '\0';
	172	if (op->op_type == OP_AASSIGN) {
	173	if (op->op_private & OPpASSIGN_COMMON)
	174	(void)strcat(buf,"COMMON,");
8d063cd8	175	}
a0d0e21e	176	else if (op->op_type == OP_SASSIGN) {
	177	if (op->op_private & OPpASSIGN_BACKWARDS)
	178	(void)strcat(buf,"BACKWARDS,");
	179	}
79072805	180	else if (op->op_type == OP_TRANS) {
	181	if (op->op_private & OPpTRANS_SQUASH)
	182	(void)strcat(buf,"SQUASH,");
	183	if (op->op_private & OPpTRANS_DELETE)
	184	(void)strcat(buf,"DELETE,");
	185	if (op->op_private & OPpTRANS_COMPLEMENT)
	186	(void)strcat(buf,"COMPLEMENT,");
8d063cd8	187	}
79072805	188	else if (op->op_type == OP_REPEAT) {
	189	if (op->op_private & OPpREPEAT_DOLIST)
	190	(void)strcat(buf,"DOLIST,");
8d063cd8	191	}
a0d0e21e	192	else if (op->op_type == OP_ENTERSUB \|\|
85e6fe83	193	op->op_type == OP_RV2SV \|\|
	194	op->op_type == OP_RV2AV \|\|
	195	op->op_type == OP_RV2HV \|\|
	196	op->op_type == OP_RV2GV \|\|
	197	op->op_type == OP_AELEM \|\|
	198	op->op_type == OP_HELEM )
	199	{
c07a80fd	200	if (op->op_private & OPpENTERSUB_AMPER)
	201	(void)strcat(buf,"AMPER,");
	202	if (op->op_private & OPpENTERSUB_DB)
79072805	203	(void)strcat(buf,"DB,");
85e6fe83	204	if (op->op_private & OPpDEREF_AV)
	205	(void)strcat(buf,"AV,");
	206	if (op->op_private & OPpDEREF_HV)
	207	(void)strcat(buf,"HV,");
	208	if (op->op_private & HINT_STRICT_REFS)
	209	(void)strcat(buf,"STRICT_REFS,");
8d063cd8	210	}
79072805	211	else if (op->op_type == OP_CONST) {
	212	if (op->op_private & OPpCONST_BARE)
	213	(void)strcat(buf,"BARE,");
	214	}
	215	else if (op->op_type == OP_FLIP) {
	216	if (op->op_private & OPpFLIP_LINENUM)
	217	(void)strcat(buf,"LINENUM,");
	218	}
	219	else if (op->op_type == OP_FLOP) {
	220	if (op->op_private & OPpFLIP_LINENUM)
	221	(void)strcat(buf,"LINENUM,");
	222	}
a0d0e21e	223	if (op->op_flags & OPf_MOD && op->op_private & OPpLVAL_INTRO)
a0d0e21e	224	(void)strcat(buf,"INTRO,");
79072805	225	if (*buf) {
	226	buf[strlen(buf)-1] = '\0';
	227	dump("PRIVATE = (%s)\n",buf);
8d063cd8	228	}
8d063cd8	229	}
8d063cd8	230
79072805	231	switch (op->op_type) {
93a17b20	232	case OP_GVSV:
79072805	233	case OP_GV:
79072805	234	if (cGVOP->op_gv) {
8990e307	235	ENTER;
79072805	236	tmpsv = NEWSV(0,0);
8990e307	237	SAVEFREESV(tmpsv);
79072805	238	gv_fullname(tmpsv,cGVOP->op_gv);
463ee0b2	239	dump("GV = %s\n", SvPV(tmpsv, na));
8990e307	240	LEAVE;
378cc40b	241	}
79072805	242	else
	243	dump("GV = NULL\n");
	244	break;
	245	case OP_CONST:
	246	dump("SV = %s\n", SvPEEK(cSVOP->op_sv));
	247	break;
93a17b20	248	case OP_NEXTSTATE:
93a17b20	249	case OP_DBSTATE:
79072805	250	if (cCOP->cop_line)
	251	dump("LINE = %d\n",cCOP->cop_line);
	252	if (cCOP->cop_label)
	253	dump("LABEL = \"%s\"\n",cCOP->cop_label);
	254	break;
	255	case OP_ENTERLOOP:
	256	dump("REDO ===> ");
93a17b20	257	if (cLOOP->op_redoop)
4db58590	258	fprintf(Perl_debug_log, "%d\n", cLOOP->op_redoop->op_seq);
79072805	259	else
4db58590	260	fprintf(Perl_debug_log, "DONE\n");
79072805	261	dump("NEXT ===> ");
93a17b20	262	if (cLOOP->op_nextop)
4db58590	263	fprintf(Perl_debug_log, "%d\n", cLOOP->op_nextop->op_seq);
79072805	264	else
4db58590	265	fprintf(Perl_debug_log, "DONE\n");
79072805	266	dump("LAST ===> ");
93a17b20	267	if (cLOOP->op_lastop)
4db58590	268	fprintf(Perl_debug_log, "%d\n", cLOOP->op_lastop->op_seq);
79072805	269	else
4db58590	270	fprintf(Perl_debug_log, "DONE\n");
79072805	271	break;
	272	case OP_COND_EXPR:
	273	dump("TRUE ===> ");
93a17b20	274	if (cCONDOP->op_true)
4db58590	275	fprintf(Perl_debug_log, "%d\n", cCONDOP->op_true->op_seq);
79072805	276	else
4db58590	277	fprintf(Perl_debug_log, "DONE\n");
79072805	278	dump("FALSE ===> ");
93a17b20	279	if (cCONDOP->op_false)
4db58590	280	fprintf(Perl_debug_log, "%d\n", cCONDOP->op_false->op_seq);
79072805	281	else
4db58590	282	fprintf(Perl_debug_log, "DONE\n");
79072805	283	break;
a0d0e21e	284	case OP_MAPWHILE:
79072805	285	case OP_GREPWHILE:
	286	case OP_OR:
	287	case OP_AND:
79072805	288	dump("OTHER ===> ");
93a17b20	289	if (cLOGOP->op_other)
4db58590	290	fprintf(Perl_debug_log, "%d\n", cLOGOP->op_other->op_seq);
79072805	291	else
4db58590	292	fprintf(Perl_debug_log, "DONE\n");
79072805	293	break;
	294	case OP_PUSHRE:
	295	case OP_MATCH:
	296	case OP_SUBST:
463ee0b2	297	dump_pm((PMOP*)op);
79072805	298	break;
a0d0e21e	299	default:
a0d0e21e	300	break;
79072805	301	}
	302	if (op->op_flags & OPf_KIDS) {
	303	OP *kid;
	304	for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
	305	dump_op(kid);
8d063cd8	306	}
	307	dumplvl--;
	308	dump("}\n");
	309	}
	310
8adcabd8	311	void
79072805	312	dump_gv(gv)
79072805	313	register GV *gv;
378cc40b	314	{
79072805	315	SV *sv;
378cc40b	316
79072805	317	if (!gv) {
4db58590	318	fprintf(Perl_debug_log,"{}\n");
378cc40b	319	return;
378cc40b	320	}
8990e307	321	sv = sv_newmortal();
8d063cd8	322	dumplvl++;
4db58590	323	fprintf(Perl_debug_log,"{\n");
79072805	324	gv_fullname(sv,gv);
463ee0b2	325	dump("GV_NAME = %s", SvPVX(sv));
79072805	326	if (gv != GvEGV(gv)) {
79072805	327	gv_efullname(sv,GvEGV(gv));
463ee0b2	328	dump("-> %s", SvPVX(sv));
8adcabd8	329	}
8adcabd8	330	dump("\n");
8d063cd8	331	dumplvl--;
	332	dump("}\n");
	333	}
	334
8adcabd8	335	void
79072805	336	dump_pm(pm)
79072805	337	register PMOP *pm;
8d063cd8	338	{
	339	char ch;
	340
79072805	341	if (!pm) {
79072805	342	dump("{}\n");
378cc40b	343	return;
378cc40b	344	}
79072805	345	dump("{\n");
8d063cd8	346	dumplvl++;
79072805	347	if (pm->op_pmflags & PMf_ONCE)
	348	ch = '?';
	349	else
	350	ch = '/';
	351	if (pm->op_pmregexp)
	352	dump("PMf_PRE %c%s%c\n",ch,pm->op_pmregexp->precomp,ch);
	353	if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
	354	dump("PMf_REPL = ");
	355	dump_op(pm->op_pmreplroot);
8d063cd8	356	}
79072805	357	if (pm->op_pmshort) {
79072805	358	dump("PMf_SHORT = %s\n",SvPEEK(pm->op_pmshort));
8d063cd8	359	}
79072805	360	if (pm->op_pmflags) {
	361	*buf = '\0';
	362	if (pm->op_pmflags & PMf_USED)
	363	(void)strcat(buf,"USED,");
	364	if (pm->op_pmflags & PMf_ONCE)
	365	(void)strcat(buf,"ONCE,");
	366	if (pm->op_pmflags & PMf_SCANFIRST)
	367	(void)strcat(buf,"SCANFIRST,");
	368	if (pm->op_pmflags & PMf_ALL)
	369	(void)strcat(buf,"ALL,");
	370	if (pm->op_pmflags & PMf_SKIPWHITE)
	371	(void)strcat(buf,"SKIPWHITE,");
	372	if (pm->op_pmflags & PMf_FOLD)
	373	(void)strcat(buf,"FOLD,");
	374	if (pm->op_pmflags & PMf_CONST)
	375	(void)strcat(buf,"CONST,");
	376	if (pm->op_pmflags & PMf_KEEP)
	377	(void)strcat(buf,"KEEP,");
	378	if (pm->op_pmflags & PMf_GLOBAL)
	379	(void)strcat(buf,"GLOBAL,");
	380	if (pm->op_pmflags & PMf_RUNTIME)
	381	(void)strcat(buf,"RUNTIME,");
	382	if (pm->op_pmflags & PMf_EVAL)
	383	(void)strcat(buf,"EVAL,");
	384	if (*buf)
	385	buf[strlen(buf)-1] = '\0';
	386	dump("PMFLAGS = (%s)\n",buf);
378cc40b	387	}
79072805	388
8d063cd8	389	dumplvl--;
	390	dump("}\n");
	391	}
	392
4db58590	393
4db58590	394	#if !defined(I_STDARG) && !defined(I_VARARGS)
378cc40b	395	/* VARARGS1 */
8adcabd8	396	static void dump(arg1,arg2,arg3,arg4,arg5)
378cc40b	397	char *arg1;
378cc40b	398	long arg2, arg3, arg4, arg5;
8d063cd8	399	{
79072805	400	I32 i;
8d063cd8	401
8d063cd8	402	for (i = dumplvl*4; i; i--)
4db58590	403	(void)putc(' ',Perl_debug_log);
	404	fprintf(Perl_debug_log,arg1, arg2, arg3, arg4, arg5);
	405	}
	406
	407	#else
	408
	409	#ifdef I_STDARG
	410	static void
	411	dump(char *pat,...)
	412	#else
	413	/VARARGS0/
	414	static void
	415	dump(pat,va_alist)
	416	char *pat;
	417	va_dcl
	418	#endif
	419	{
	420	I32 i;
	421	va_list args;
	422	#ifndef HAS_VPRINTF
	423	int vfprintf();
	424	#endif
	425
	426	#ifdef I_STDARG
	427	va_start(args, pat);
	428	#else
	429	va_start(args);
	430	#endif
	431	for (i = dumplvl*4; i; i--)
a687059c	432	(void)putc(' ',stderr);
4db58590	433	vfprintf(Perl_debug_log,pat,args);
4db58590	434	va_end(args);
8d063cd8	435	}
8d063cd8	436	#endif
4db58590	437
4db58590	438	#endif