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