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