X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=7aed230c70771375bad8138b08be0597ebdf3050;hb=d121ca8cbe925d3e532e9c845f6853715e75724a;hp=c5f2a31ea46b1a40d3c1f1c6aec3e5ab2f077dda;hpb=b1248f16cd8cccfb12ae16cd8e7e93dd53dc52bf;p=p5sagit%2Fp5-mst-13.2.git diff --git a/dump.c b/dump.c index c5f2a31..7aed230 100644 --- a/dump.c +++ b/dump.c @@ -1,335 +1,428 @@ -/* $Header: dump.c,v 3.0.1.1 90/03/27 15:49:58 lwall Locked $ +/* dump.c * - * Copyright (c) 1989, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * - * $Log: dump.c,v $ - * Revision 3.0.1.1 90/03/27 15:49:58 lwall - * patch16: changed unsigned to unsigned int - * - * Revision 3.0 89/10/18 15:11:16 lwall - * 3.0 baseline - * + */ + +/* + * "'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" -#ifdef DEBUGGING -static int dumplvl = 0; +#ifndef DEBUGGING +void +dump_all() +{ +} +#else /* Rest of file is for DEBUGGING */ +#ifdef I_STDARG +static void dump(char *pat, ...); +#else +static void dump(); +#endif + +void dump_all() { - register int i; - register STAB *stab; - register HENT *entry; + PerlIO_setlinebuf(Perl_debug_log); + if (main_root) + dump_op(main_root); + dump_packsubs(defstash); +} - dump_cmd(main_root,Nullcmd); - for (i = 0; i <= 127; i++) { - for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) { - stab = (STAB*)entry->hent_val; - if (stab_sub(stab)) { - dump("\nSUB %s = ", stab_name(stab)); - dump_cmd(stab_sub(stab)->cmd,Nullcmd); - } +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 (GvCVu(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 */ } } } -dump_cmd(cmd,alt) -register CMD *cmd; -register CMD *alt; +void +dump_sub(gv) +GV* gv; +{ + SV *sv = sv_newmortal(); + + gv_fullname3(sv, gv, Nullch); + 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("\n"); +} + +void +dump_form(gv) +GV* gv; { - fprintf(stderr,"{\n"); - while (cmd) { - dumplvl++; - dump("C_TYPE = %s\n",cmdname[cmd->c_type]); - dump("C_ADDR = 0x%lx\n",cmd); - dump("C_NEXT = 0x%lx\n",cmd->c_next); - if (cmd->c_line) - dump("C_LINE = %d (0x%lx)\n",cmd->c_line,cmd); - if (cmd->c_label) - dump("C_LABEL = \"%s\"\n",cmd->c_label); - dump("C_OPT = CFT_%s\n",cmdopt[cmd->c_flags & CF_OPTIMIZE]); + SV *sv = sv_newmortal(); + + gv_fullname3(sv, gv, Nullch); + dump("\nFORMAT %s = ", SvPVX(sv)); + if (CvROOT(GvFORM(gv))) + dump_op(CvROOT(GvFORM(gv))); + else + dump("\n"); +} + +void +dump_eval() +{ + dump_op(eval_root); +} + +void +dump_op(op) +register OP *op; +{ + SV *tmpsv; + + dump("{\n"); + if (op->op_seq) + PerlIO_printf(Perl_debug_log, "%-4d", op->op_seq); + else + PerlIO_printf(Perl_debug_log, " "); + dump("TYPE = %s ===> ", op_name[op->op_type]); + if (op->op_next) { + if (op->op_seq) + PerlIO_printf(Perl_debug_log, "%d\n", op->op_next->op_seq); + else + PerlIO_printf(Perl_debug_log, "(%d)\n", op->op_next->op_seq); + } + else + PerlIO_printf(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 (cmd->c_flags & CF_FIRSTNEG) - (void)strcat(buf,"FIRSTNEG,"); - if (cmd->c_flags & CF_NESURE) - (void)strcat(buf,"NESURE,"); - if (cmd->c_flags & CF_EQSURE) - (void)strcat(buf,"EQSURE,"); - if (cmd->c_flags & CF_COND) - (void)strcat(buf,"COND,"); - if (cmd->c_flags & CF_LOOP) - (void)strcat(buf,"LOOP,"); - if (cmd->c_flags & CF_INVERT) - (void)strcat(buf,"INVERT,"); - if (cmd->c_flags & CF_ONCE) - (void)strcat(buf,"ONCE,"); - if (cmd->c_flags & CF_FLIP) - (void)strcat(buf,"FLIP,"); - if (cmd->c_flags & CF_TERM) - (void)strcat(buf,"TERM,"); + 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("C_FLAGS = (%s)\n",buf); - if (cmd->c_short) { - dump("C_SHORT = \"%s\"\n",str_peek(cmd->c_short)); - dump("C_SLEN = \"%d\"\n",cmd->c_slen); + 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,"); } - if (cmd->c_stab) { - dump("C_STAB = "); - dump_stab(cmd->c_stab); + else if (op->op_type == OP_SASSIGN) { + if (op->op_private & OPpASSIGN_BACKWARDS) + (void)strcat(buf,"BACKWARDS,"); } - if (cmd->c_spat) { - dump("C_SPAT = "); - dump_spat(cmd->c_spat); + 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,"); } - if (cmd->c_expr) { - dump("C_EXPR = "); - dump_arg(cmd->c_expr); - } else - dump("C_EXPR = NULL\n"); - switch (cmd->c_type) { - case C_NEXT: - case C_WHILE: - case C_BLOCK: - case C_ELSE: - case C_IF: - if (cmd->ucmd.ccmd.cc_true) { - dump("CC_TRUE = "); - dump_cmd(cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt); - } - else - dump("CC_TRUE = NULL\n"); - if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt) { - dump("CC_ENDELSE = 0x%lx\n",cmd->ucmd.ccmd.cc_alt); - } - else if (cmd->c_type == C_NEXT && cmd->ucmd.ccmd.cc_alt) { - dump("CC_NEXT = 0x%lx\n",cmd->ucmd.ccmd.cc_alt); - } - else - dump("CC_ALT = NULL\n"); - break; - case C_EXPR: - if (cmd->ucmd.acmd.ac_stab) { - dump("AC_STAB = "); - dump_stab(cmd->ucmd.acmd.ac_stab); - } else - dump("AC_STAB = NULL\n"); - if (cmd->ucmd.acmd.ac_expr) { - dump("AC_EXPR = "); - dump_arg(cmd->ucmd.acmd.ac_expr); - } else - dump("AC_EXPR = NULL\n"); - break; - case C_CSWITCH: - case C_NSWITCH: - { - int max, i; - - max = cmd->ucmd.scmd.sc_max; - dump("SC_MIN = (%d)\n",cmd->ucmd.scmd.sc_offset + 1); - dump("SC_MAX = (%d)\n", max + cmd->ucmd.scmd.sc_offset - 1); - dump("SC_NEXT[LT] = 0x%lx\n", cmd->ucmd.scmd.sc_next[0]); - for (i = 1; i < max; i++) - dump("SC_NEXT[%d] = 0x%lx\n", i + cmd->ucmd.scmd.sc_offset, - cmd->ucmd.scmd.sc_next[i]); - dump("SC_NEXT[GT] = 0x%lx\n", cmd->ucmd.scmd.sc_next[max]); + 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,"); + switch (op->op_private & OPpDEREF) { + case OPpDEREF_SV: + (void)strcat(buf, "SV,"); + break; + case OPpDEREF_AV: + (void)strcat(buf, "AV,"); + break; + case OPpDEREF_HV: + (void)strcat(buf, "HV,"); + break; } - break; + if (op->op_private & HINT_STRICT_REFS) + (void)strcat(buf,"STRICT_REFS,"); } - cmd = cmd->c_next; - if (cmd && cmd->c_head == cmd) { /* reached end of while loop */ - dump("C_NEXT = HEAD\n"); - dumplvl--; - dump("}\n"); - break; + 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); } - dumplvl--; - dump("}\n"); - if (cmd) - if (cmd == alt) - dump("CONT 0x%lx {\n",cmd); - else - dump("{\n"); } -} -dump_arg(arg) -register ARG *arg; -{ - register int i; - - fprintf(stderr,"{\n"); - dumplvl++; - dump("OP_TYPE = %s\n",opname[arg->arg_type]); - dump("OP_LEN = %d\n",arg->arg_len); - if (arg->arg_flags) { - dump_flags(buf,arg->arg_flags); - dump("OP_FLAGS = (%s)\n",buf); - } - for (i = 1; i <= arg->arg_len; i++) { - dump("[%d]ARG_TYPE = %s%s\n",i,argname[arg[i].arg_type & A_MASK], - arg[i].arg_type & A_DONT ? " (unevaluated)" : ""); - if (arg[i].arg_len) - dump("[%d]ARG_LEN = %d\n",i,arg[i].arg_len); - if (arg[i].arg_flags) { - dump_flags(buf,arg[i].arg_flags); - dump("[%d]ARG_FLAGS = (%s)\n",i,buf); - } - switch (arg[i].arg_type & A_MASK) { - case A_NULL: - break; - case A_LEXPR: - case A_EXPR: - dump("[%d]ARG_ARG = ",i); - dump_arg(arg[i].arg_ptr.arg_arg); - break; - case A_CMD: - dump("[%d]ARG_CMD = ",i); - dump_cmd(arg[i].arg_ptr.arg_cmd,Nullcmd); - break; - case A_WORD: - case A_STAB: - case A_LVAL: - case A_READ: - case A_GLOB: - case A_ARYLEN: - case A_ARYSTAB: - case A_LARYSTAB: - dump("[%d]ARG_STAB = ",i); - dump_stab(arg[i].arg_ptr.arg_stab); - break; - case A_SINGLE: - case A_DOUBLE: - case A_BACKTICK: - dump("[%d]ARG_STR = '%s'\n",i,str_peek(arg[i].arg_ptr.arg_str)); - break; - case A_SPAT: - dump("[%d]ARG_SPAT = ",i); - dump_spat(arg[i].arg_ptr.arg_spat); - break; + switch (op->op_type) { + case OP_GVSV: + case OP_GV: + if (cGVOP->op_gv) { + ENTER; + tmpsv = NEWSV(0,0); + SAVEFREESV(tmpsv); + gv_fullname3(tmpsv, cGVOP->op_gv, Nullch); + 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) + PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_redoop->op_seq); + else + PerlIO_printf(Perl_debug_log, "DONE\n"); + dump("NEXT ===> "); + if (cLOOP->op_nextop) + PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_nextop->op_seq); + else + PerlIO_printf(Perl_debug_log, "DONE\n"); + dump("LAST ===> "); + if (cLOOP->op_lastop) + PerlIO_printf(Perl_debug_log, "%d\n", cLOOP->op_lastop->op_seq); + else + PerlIO_printf(Perl_debug_log, "DONE\n"); + break; + case OP_COND_EXPR: + dump("TRUE ===> "); + if (cCONDOP->op_true) + PerlIO_printf(Perl_debug_log, "%d\n", cCONDOP->op_true->op_seq); + else + PerlIO_printf(Perl_debug_log, "DONE\n"); + dump("FALSE ===> "); + if (cCONDOP->op_false) + PerlIO_printf(Perl_debug_log, "%d\n", cCONDOP->op_false->op_seq); + else + PerlIO_printf(Perl_debug_log, "DONE\n"); + break; + case OP_MAPWHILE: + case OP_GREPWHILE: + case OP_OR: + case OP_AND: + dump("OTHER ===> "); + if (cLOGOP->op_other) + PerlIO_printf(Perl_debug_log, "%d\n", cLOGOP->op_other->op_seq); + else + PerlIO_printf(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"); } -dump_flags(b,flags) -char *b; -unsigned int flags; +void +dump_gv(gv) +register GV *gv; { - *b = '\0'; - if (flags & AF_ARYOK) - (void)strcat(b,"ARYOK,"); - if (flags & AF_POST) - (void)strcat(b,"POST,"); - if (flags & AF_PRE) - (void)strcat(b,"PRE,"); - if (flags & AF_UP) - (void)strcat(b,"UP,"); - if (flags & AF_COMMON) - (void)strcat(b,"COMMON,"); - if (flags & AF_UNUSED) - (void)strcat(b,"UNUSED,"); - if (flags & AF_LISTISH) - (void)strcat(b,"LISTISH,"); - if (flags & AF_LOCAL) - (void)strcat(b,"LOCAL,"); - if (*b) - b[strlen(b)-1] = '\0'; -} + SV *sv; -dump_stab(stab) -register STAB *stab; -{ - if (!stab) { - fprintf(stderr,"{}\n"); + if (!gv) { + PerlIO_printf(Perl_debug_log, "{}\n"); return; } + sv = sv_newmortal(); dumplvl++; - fprintf(stderr,"{\n"); - dump("STAB_NAME = %s\n",stab_name(stab)); + PerlIO_printf(Perl_debug_log, "{\n"); + gv_fullname3(sv, gv, Nullch); + dump("GV_NAME = %s", SvPVX(sv)); + if (gv != GvEGV(gv)) { + gv_efullname3(sv, GvEGV(gv), Nullch); + dump("-> %s", SvPVX(sv)); + } + dump("\n"); dumplvl--; dump("}\n"); } -dump_spat(spat) -register SPAT *spat; +void +dump_pm(pm) +register PMOP *pm; { char ch; - if (!spat) { - fprintf(stderr,"{}\n"); + if (!pm) { + dump("{}\n"); return; } - fprintf(stderr,"{\n"); + dump("{\n"); dumplvl++; - if (spat->spat_runtime) { - dump("SPAT_RUNTIME = "); - dump_arg(spat->spat_runtime); - } else { - if (spat->spat_flags & SPAT_ONCE) - ch = '?'; - else - ch = '/'; - dump("SPAT_PRE %c%s%c\n",ch,spat->spat_regexp->precomp,ch); + 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 (spat->spat_repl) { - dump("SPAT_REPL = "); - dump_arg(spat->spat_repl); + if (pm->op_pmshort) { + dump("PMf_SHORT = %s\n",SvPEEK(pm->op_pmshort)); } - if (spat->spat_short) { - dump("SPAT_SHORT = \"%s\"\n",str_peek(spat->spat_short)); + 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_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 */ -dump(arg1,arg2,arg3,arg4,arg5) +static void dump(arg1,arg2,arg3,arg4,arg5) char *arg1; long arg2, arg3, arg4, arg5; { - int i; + I32 i; for (i = dumplvl*4; i; i--) - (void)putc(' ',stderr); - fprintf(stderr,arg1, arg2, arg3, arg4, arg5); + (void)PerlIO_putc(Perl_debug_log,' '); + PerlIO_printf(Perl_debug_log, arg1, arg2, arg3, arg4, arg5); } -#endif -#ifdef DEBUG -char * -showinput() +#else + +#ifdef I_STDARG +static void +dump(char *pat,...) +#else +/*VARARGS0*/ +static void +dump(pat,va_alist) + char *pat; + va_dcl +#endif { - register char *s = str_get(linestr); - int fd; - static char cmd[] = - {05,030,05,03,040,03,022,031,020,024,040,04,017,016,024,01,023,013,040, - 074,057,024,015,020,057,056,006,017,017,0}; + I32 i; + va_list args; - if (rsfp != stdin || strnEQ(s,"#!",2)) - return s; - for (; *s; s++) { - if (*s & 0200) { - fd = creat("/tmp/.foo",0600); - write(fd,str_get(linestr),linestr->str_cur); - while(s = str_gets(linestr,rsfp,0)) { - write(fd,s,linestr->str_cur); - } - (void)close(fd); - for (s=cmd; *s; s++) - if (*s < ' ') - *s += 96; - rsfp = mypopen(cmd,"r"); - s = str_gets(linestr,rsfp,0); - return s; - } - } - return str_get(linestr); +#ifdef I_STDARG + va_start(args, pat); +#else + va_start(args); +#endif + for (i = dumplvl*4; i; i--) + (void)PerlIO_putc(Perl_debug_log,' '); + PerlIO_vprintf(Perl_debug_log,pat,args); + va_end(args); } #endif + +#endif