profile.c

Go to the documentation of this file.

/*
 * profile.c - gawk parse tree pretty-printer with counts
 */

/* 
 * Copyright (C) 1999-2003 the Free Software Foundation, Inc.
 * 
 * This file is part of GAWK, the GNU implementation of the
 * AWK Programming Language.
 * 
 * GAWK is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 * 
 * GAWK is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
 */

#include "awk.h"

/* where to place redirections for getline, print, printf */
enum redir_placement {
        BEFORE = 0,
        AFTER = 1
};

#undef tree_eval
static void tree_eval P((NODE *tree));
static void parenthesize P((NODETYPE parent_type, NODE *tree));
static void eval_condition P((NODE *tree));
static void pp_op_assign P((NODE *tree));
static void pp_func_call P((NODE *tree));
static void pp_match_op P((NODE *tree));
static void pp_lhs P((NODE *ptr));
static void pp_print_stmt P((const char *command, NODE *tree));
static void pp_delete P((NODE *tree));
static void pp_in_array P((NODE *array, NODE *subscript));
static void pp_getline P((NODE *tree));
static void pp_builtin P((NODE *tree));
static void pp_list P((NODE *tree));
static void pp_string P((const char *str, size_t len, int delim));
static int is_scalar P((NODETYPE type));
static int prec_level P((NODETYPE type));
#ifdef PROFILING
static RETSIGTYPE dump_and_exit P((int signum)) ATTRIBUTE_NORETURN;
static RETSIGTYPE just_dump P((int signum));
#endif

/* pretty printing related functions and variables */

static char **fparms;   /* function parameter names */
static FILE *prof_fp;   /* where to send the profile */

static long indent_level = 0;

static int in_BEGIN_or_END = FALSE;

static int in_expr = FALSE;

#define SPACEOVER       0

/* init_profiling --- do needed initializations, see also main.c */

void
init_profiling(int *flag ATTRIBUTE_UNUSED, const char *def_file ATTRIBUTE_UNUSED)
{
#ifdef PROFILING
        if (*flag == FALSE) {
                *flag = TRUE;
                set_prof_file(def_file);
        }
#endif
}

/* set_prof_file --- set the output file for profiling */

void
set_prof_file(const char *file)
{
        assert(file != NULL);

        prof_fp = fopen(file, "w");
        if (prof_fp == NULL) {
                warning(_("could not open `%s' for writing: %s"),
                                file, strerror(errno));
                warning(_("sending profile to standard error"));
                prof_fp = stderr;
        }
}

/* init_profiling_signals --- set up signal handling for pgawk */

void
init_profiling_signals()
{
#ifdef PROFILING
#ifdef __DJGPP__
        signal(SIGINT, dump_and_exit);
        signal(SIGQUIT, just_dump);
#else  /* !__DJGPP__ */
#ifdef SIGHUP
        signal(SIGHUP, dump_and_exit);
#endif
#ifdef SIGUSR1
        signal(SIGUSR1, just_dump);
#endif
#endif /* !__DJGPP__ */
#endif /* PROFILING */
}

/* indent --- print out enough tabs */

static void
indent(long count)
{
        int i;

        if (count == 0)
                putc('\t', prof_fp);
        else
                fprintf(prof_fp, "%6ld  ", count);

        assert(indent_level >= 0);
        for (i = 0; i < indent_level; i++)
                putc('\t', prof_fp);
}

/* indent_in --- increase the level, with error checking */

static void
indent_in(void)
{
        assert(indent_level >= 0);
        indent_level++;
}

/* indent_out --- decrease the level, with error checking */

static void
indent_out(void)
{
        indent_level--;
        assert(indent_level >= 0);
}

/*
 * pprint:
 * Tree is a bunch of rules to run. Returns zero if it hit an exit()
 * statement 
 */
static void
pprint(register NODE *volatile tree)
{
        register NODE *volatile t = NULL;       /* temporary */
        int volatile traverse = TRUE;   /* True => loop thru tree (Node_rule_list) */

        /* avoid false source indications */
        source = NULL;
        sourceline = 0;

        if (tree == NULL)
                return;
        sourceline = tree->source_line;
        source = tree->source_file;
        switch (tree->type) {
        case Node_rule_node:
                traverse = FALSE;  /* False => one for-loop iteration only */
                /* FALL THROUGH */
        case Node_rule_list:
                for (t = tree; t != NULL; t = t->rnode) {
                        if (traverse)
                                tree = t->lnode;
                        sourceline = tree->source_line;
                        source = tree->source_file;

                        if (! in_BEGIN_or_END)
                                indent(tree->exec_count);

                        if (tree->lnode) {
                                eval_condition(tree->lnode);
                                if (tree->rnode)
                                        fprintf(prof_fp, "\t");
                        }

                        if (tree->rnode) {
                                if (! in_BEGIN_or_END) {
                                        fprintf(prof_fp, "{");
                                        if (tree->lnode != NULL
                                            && tree->lnode->exec_count)
                                                fprintf(prof_fp, " # %ld",
                                                        tree->lnode->exec_count);
                                        fprintf(prof_fp, "\n");
                                }
                                indent_in();
                                pprint(tree->rnode);
                                indent_out();
                                if (! in_BEGIN_or_END) {
                                        indent(SPACEOVER);
                                        fprintf(prof_fp, "}\n");
                                }
                        }

                        if (! traverse)         /* case Node_rule_node */
                                break;          /* don't loop */

                        if (t->rnode && ! in_BEGIN_or_END)
                                fprintf(prof_fp, "\n");
                }
                break;

        case Node_statement_list:
                for (t = tree; t != NULL; t = t->rnode) {
                        pprint(t->lnode);
                }
                break;

        case Node_K_if:
                indent(tree->exec_count);
                fprintf(prof_fp, "if (");
                in_expr++;
                eval_condition(tree->lnode);
                in_expr--;
                fprintf(prof_fp, ") {");
#ifdef PROFILING
                if (tree->rnode->exec_count)
                        fprintf(prof_fp, " # %ld", tree->rnode->exec_count);
#endif
                fprintf(prof_fp, "\n");
                indent_in();
                pprint(tree->rnode->lnode);
                indent_out();
                if (tree->rnode->rnode != NULL) {
                        if (tree->exec_count - tree->rnode->exec_count > 0)
                                indent(tree->exec_count - tree->rnode->exec_count);
                        else
                                indent(0);
                        fprintf(prof_fp, "} else {\n");
                        indent_in();
                        pprint(tree->rnode->rnode);
                        indent_out();
                }
                indent(SPACEOVER);
                fprintf(prof_fp, "}\n");
                break;

        case Node_K_switch:
                indent(tree->exec_count);
                fprintf(prof_fp, "switch (");
                in_expr++;
                pprint(tree->lnode);
                in_expr--;
                fprintf(prof_fp, ") {\n");
                pprint(tree->rnode);
                indent(SPACEOVER);
                fprintf(prof_fp, "}\n");
                break;

        case Node_switch_body:
        case Node_case_list:
                pprint(tree->lnode);
                pprint(tree->rnode);
                break;

        case Node_K_case:
                indent(tree->exec_count);
                fprintf(prof_fp, "case ");
                in_expr++;
                pprint(tree->lnode);
                in_expr--;
                fprintf(prof_fp, ":\n");
                indent_in();
                pprint(tree->rnode);
                indent_out();
                break;

        case Node_K_default:
                indent(tree->exec_count);
                fprintf(prof_fp, "default:\n");
                indent_in();
                pprint(tree->rnode);
                indent_out();
                break;

        case Node_K_while:
                indent(tree->exec_count);
                fprintf(prof_fp, "while (");
                in_expr++;
                eval_condition(tree->lnode);
                in_expr--;
                fprintf(prof_fp, ") {\n");
                indent_in();
                pprint(tree->rnode);
                indent_out();
                indent(SPACEOVER);
                fprintf(prof_fp, "}\n");
                break;

        case Node_K_do:
                indent(tree->exec_count);
                fprintf(prof_fp, "do {\n");
                indent_in();
                pprint(tree->rnode);
                indent_out();
                indent(SPACEOVER);
                fprintf(prof_fp, "} while (");
                in_expr++;
                eval_condition(tree->lnode);
                in_expr--;
                fprintf(prof_fp, ")\n");
                break;

        case Node_K_for:
                indent(tree->exec_count);
                fprintf(prof_fp, "for (");
                in_expr++;
                pprint(tree->forloop->init);
                fprintf(prof_fp, "; ");
                eval_condition(tree->forloop->cond);
                fprintf(prof_fp, "; ");
                pprint(tree->forloop->incr);
                fprintf(prof_fp, ") {\n");
                in_expr--;
                indent_in();
                pprint(tree->lnode);
                indent_out();
                indent(SPACEOVER);
                fprintf(prof_fp, "}\n");
                break;

        case Node_K_arrayfor:
#define hakvar forloop->init
#define arrvar forloop->incr
                indent(tree->exec_count);
                fprintf(prof_fp, "for (");
                in_expr++;
                pp_lhs(tree->hakvar);
                in_expr--;
                fprintf(prof_fp, " in ");
                t = tree->arrvar;
                if (t->type == Node_param_list)
                        fprintf(prof_fp, "%s", fparms[t->param_cnt]);
                else
                        fprintf(prof_fp, "%s", t->vname);
                fprintf(prof_fp, ") {\n");
                indent_in();
                pprint(tree->lnode);
                indent_out();
                indent(SPACEOVER);
                fprintf(prof_fp, "}\n");
                break;
#undef hakvar
#undef arrvar

        case Node_K_break:
                indent(tree->exec_count);
                fprintf(prof_fp, "break\n");
                break;

        case Node_K_continue:
                indent(tree->exec_count);
                fprintf(prof_fp, "continue\n");
                break;

        case Node_K_print:
        case Node_K_print_rec:
                pp_print_stmt("print", tree);
                break;

        case Node_K_printf:
                pp_print_stmt("printf", tree);
                break;

        case Node_K_delete:
                pp_delete(tree);
                break;

        case Node_K_next:
                indent(tree->exec_count);
                fprintf(prof_fp, "next\n");
                break;

        case Node_K_nextfile:
                indent(tree->exec_count);
                fprintf(prof_fp, "nextfile\n");
                break;

        case Node_K_exit:
                indent(tree->exec_count);
                fprintf(prof_fp, "exit");
                if (tree->lnode != NULL) {
                        fprintf(prof_fp, " ");
                        tree_eval(tree->lnode);
                }
                fprintf(prof_fp, "\n");
                break;

        case Node_K_return:
                indent(tree->exec_count);
                fprintf(prof_fp, "return");
                if (tree->lnode != NULL) {
                        fprintf(prof_fp, " ");
                        tree_eval(tree->lnode);
                }
                fprintf(prof_fp, "\n");
                break;

        default:
                /*
                 * Appears to be an expression statement.
                 * Throw away the value. 
                 */
                if (in_expr)
                        tree_eval(tree);
                else {
                        indent(tree->exec_count);
                        tree_eval(tree);
                        fprintf(prof_fp, "\n");
                }
                break;
        }
}

/* tree_eval --- evaluate a subtree */

static void
tree_eval(register NODE *tree)
{
        if (tree == NULL)
                return;

        switch (tree->type) {
        case Node_param_list:
                fprintf(prof_fp, "%s", fparms[tree->param_cnt]);
                return;

        case Node_var_new:
        case Node_var:
        case Node_var_array:
                if (tree->vname != NULL)
                        fprintf(prof_fp, "%s", tree->vname);
                else
                        fatal(_("internal error: %s with null vname"),
                                nodetype2str(tree->type));
                return;

        case Node_val:
                if ((tree->flags & NUMBER) != 0)
                        fprintf(prof_fp, "%g", tree->numbr);
                else {
                        if ((tree->flags & INTLSTR) != 0)
                                fprintf(prof_fp, "_");
                        pp_string(tree->stptr, tree->stlen, '"');
                }
                return;

        case Node_and:
                eval_condition(tree->lnode);
                fprintf(prof_fp, " && ");
                eval_condition(tree->rnode);
                return;

        case Node_or:
                eval_condition(tree->lnode);
                fprintf(prof_fp, " || ");
                eval_condition(tree->rnode);
                return;

        case Node_not:
                parenthesize(tree->type, tree->lnode);
                return;

                /* Builtins */
        case Node_builtin:
                pp_builtin(tree);
                return;

        case Node_in_array:
                in_expr++;
                pp_in_array(tree->lnode, tree->rnode);
                in_expr--;
                return;

        case Node_func_call:
                pp_func_call(tree);
                return;

        case Node_K_getline:
                pp_getline(tree);
                return;

        case Node_K_delete_loop:
        {
                char *aname;
                NODE *t;

                t = tree->lnode;
                if (t->type == Node_param_list)
                        aname = fparms[t->param_cnt];
                else
                        aname = t->vname;

                fprintf(prof_fp, "for (");
                pp_lhs(tree->rnode->lnode);
                fprintf(prof_fp, " in %s) { %s %s'\n", aname,
                        _("# treated internally as `delete'"), aname);
                indent_in();
                indent(SPACEOVER);
                fprintf(prof_fp, "delete %s[", aname);
                pp_lhs(tree->rnode->lnode);
                fprintf(prof_fp, "]\n");
                indent_out();
                indent(SPACEOVER);
                fprintf(prof_fp, "}");
        }
                return;

                /* unary operations */
        case Node_NR:
                fprintf(prof_fp, "NR");
                return;

        case Node_FNR:
                fprintf(prof_fp, "FNR");
                return;

        case Node_NF:
                fprintf(prof_fp, "NF");
                return;

        case Node_FIELDWIDTHS:
                fprintf(prof_fp, "FIELDWIDTHS");
                return;

        case Node_FS:
                fprintf(prof_fp, "FS");
                return;

        case Node_RS:
                fprintf(prof_fp, "RS");
                return;

        case Node_IGNORECASE:
                fprintf(prof_fp, "IGNORECASE");
                return;

        case Node_OFS:
                fprintf(prof_fp, "OFS");
                return;

        case Node_ORS:
                fprintf(prof_fp, "ORS");
                return;

        case Node_OFMT:
                fprintf(prof_fp, "OFMT");
                return;

        case Node_CONVFMT:
                fprintf(prof_fp, "CONVFMT");
                return;

        case Node_BINMODE:
                fprintf(prof_fp, "BINMODE");
                return;

        case Node_TEXTDOMAIN:
                fprintf(prof_fp, "TEXTDOMAIN");
                return;

        case Node_field_spec:
        case Node_subscript:
                pp_lhs(tree);
                return;

        case Node_unary_minus:
                fprintf(prof_fp, " -");
                if (is_scalar(tree->subnode->type))
                        tree_eval(tree->subnode);
                else {
                        fprintf(prof_fp, "(");
                        tree_eval(tree->subnode);
                        fprintf(prof_fp, ")");
                }
                return;

        case Node_cond_exp:
                eval_condition(tree->lnode);
                fprintf(prof_fp, " ? ");
                tree_eval(tree->rnode->lnode);
                fprintf(prof_fp, " : ");
                tree_eval(tree->rnode->rnode);
                return;

        case Node_match:
        case Node_nomatch:
        case Node_regex:
        case Node_dynregex:
                pp_match_op(tree);
                return;

                /* assignments */
        case Node_assign:
                tree_eval(tree->lnode);
                fprintf(prof_fp, " = ");
                tree_eval(tree->rnode);
                return;

        case Node_concat:
                fprintf(prof_fp, "(");
                tree_eval(tree->lnode);
                fprintf(prof_fp, " ");
                tree_eval(tree->rnode);
                fprintf(prof_fp, ")");
                return;

        /* other assignment types are easier because they are numeric */
        case Node_preincrement:
        case Node_predecrement:
        case Node_postincrement:
        case Node_postdecrement:
        case Node_assign_exp:
        case Node_assign_times:
        case Node_assign_quotient:
        case Node_assign_mod:
        case Node_assign_plus:
        case Node_assign_minus:
                pp_op_assign(tree);
                return;

        default:
                break;  /* handled below */
        }

        /* handle binary ops */
        in_expr++;
        parenthesize(tree->type, tree->lnode);

        switch (tree->type) {
        case Node_geq:
                fprintf(prof_fp, " >= ");
                break;
        case Node_leq:
                fprintf(prof_fp, " <= ");
                break;
        case Node_greater:
                fprintf(prof_fp, " > ");
                break;
        case Node_less:
                fprintf(prof_fp, " < ");
                break;
        case Node_notequal:
                fprintf(prof_fp, " != ");
                break;
        case Node_equal:
                fprintf(prof_fp, " == ");
                break;
        case Node_exp:
                fprintf(prof_fp, " ^ ");
                break;
        case Node_times:
                fprintf(prof_fp, " * ");
                break;
        case Node_quotient:
                fprintf(prof_fp, " / ");
                break;
        case Node_mod:
                fprintf(prof_fp, " %% ");
                break;
        case Node_plus:
                fprintf(prof_fp, " + ");
                break;
        case Node_minus:
                fprintf(prof_fp, " - ");
                break;
        default:
                fatal(_("illegal type (%s) in tree_eval"), nodetype2str(tree->type));
        }
        parenthesize(tree->type, tree->rnode);
        in_expr--;

        return;
}

/* eval_condition --- is TREE true or false */

static void
eval_condition(register NODE *tree)
{
        if (tree == NULL)       /* Null trees are the easiest kinds */
                return;

        if (tree->type == Node_line_range) {
                /* /.../, /.../ */
                eval_condition(tree->condpair->lnode);
                fprintf(prof_fp,", ");
                eval_condition(tree->condpair->rnode);
                return;
        }

        /*
         * Could just be J.random expression. in which case, null and 0 are
         * false, anything else is true 
         */

        tree_eval(tree);
        return;
}

/* pp_op_assign --- do +=, -=, etc. */

static void
pp_op_assign(register NODE *tree)
{
        const char *op = NULL;
        enum Order {
                NA = 0,
                PRE = 1,
                POST = 2
        } order = NA;

        switch(tree->type) {
        case Node_preincrement:
                op = "++";
                order = PRE;
                break;

        case Node_predecrement:
                op = "--";
                order = PRE;
                break;

        case Node_postincrement:
                op = "++";
                order = POST;
                break;

        case Node_postdecrement:
                op = "--";
                order = POST;
                break;

        default:
                break;  /* handled below */
        }

        if (order == PRE) {
                fprintf(prof_fp, "%s", op);
                pp_lhs(tree->lnode);
                return;
        } else if (order == POST) {
                pp_lhs(tree->lnode);
                fprintf(prof_fp, "%s", op);
                return;
        }

        /* a binary op */
        pp_lhs(tree->lnode);

        switch(tree->type) {
        case Node_assign_exp:
                fprintf(prof_fp, " ^= ");
                break;

        case Node_assign_times:
                fprintf(prof_fp, " *= ");
                break;

        case Node_assign_quotient:
                fprintf(prof_fp, " /= ");
                break;

        case Node_assign_mod:
                fprintf(prof_fp, " %%= ");
                break;

        case Node_assign_plus:
                fprintf(prof_fp, " += ");
                break;

        case Node_assign_minus:
                fprintf(prof_fp, " -= ");
                break;

        default:
                cant_happen();
        }

        tree_eval(tree->rnode);
}

/* pp_lhs --- print the lhs */

static void
pp_lhs(register NODE *ptr)
{
        register NODE *n;

        switch (ptr->type) {
        case Node_var_array:
                fatal(_("attempt to use array `%s' in a scalar context"),
                        ptr->vname);

        case Node_var_new:
        case Node_var:
                fprintf(prof_fp, "%s", ptr->vname);
                break;

        case Node_FIELDWIDTHS:
                fprintf(prof_fp, "FIELDWIDTHS");
                break;

        case Node_RS:
                fprintf(prof_fp, "RS");
                break;

        case Node_FS:
                fprintf(prof_fp, "FS");
                break;

        case Node_FNR:
                fprintf(prof_fp, "FNR");
                break;

        case Node_NR:
                fprintf(prof_fp, "NR");
                break;

        case Node_NF:
                fprintf(prof_fp, "NF");
                break;

        case Node_IGNORECASE:
                fprintf(prof_fp, "IGNORECASE");
                break;

        case Node_BINMODE:
                fprintf(prof_fp, "BINMODE");
                break;

        case Node_LINT:
                fprintf(prof_fp, "LINT");
                break;

        case Node_OFMT:
                fprintf(prof_fp, "OFMT");
                break;

        case Node_CONVFMT:
                fprintf(prof_fp, "CONVFMT");
                break;

        case Node_ORS:
                fprintf(prof_fp, "ORS");
                break;

        case Node_OFS:
                fprintf(prof_fp, "OFS");
                break;

        case Node_TEXTDOMAIN:
                fprintf(prof_fp, "TEXTDOMAIN");
                break;

        case Node_param_list:
                fprintf(prof_fp, "%s", fparms[ptr->param_cnt]);
                break;

        case Node_field_spec:
                fprintf(prof_fp, "$");
                if (is_scalar(ptr->lnode->type))
                        tree_eval(ptr->lnode);
                else {
                        fprintf(prof_fp, "(");
                        tree_eval(ptr->lnode);
                        fprintf(prof_fp, ")");
                }
                break;

        case Node_subscript:
                n = ptr->lnode;
                if (n->type == Node_param_list) {
                        fprintf(prof_fp, "%s[", fparms[n->param_cnt]);
                } else
                        fprintf(prof_fp, "%s[", n->vname);
                if (ptr->rnode->type == Node_expression_list)
                        pp_list(ptr->rnode);
                else
                        tree_eval(ptr->rnode);
                fprintf(prof_fp, "]");
                break;

        case Node_builtin:
                fatal(_("assignment is not allowed to result of builtin function"));

        default:
                cant_happen();
        }
}

/* match_op --- do ~ and !~ */

static void
pp_match_op(register NODE *tree)
{
        register NODE *re;
        const char *op;
        const char *restr;
        size_t relen;
        NODE *text = NULL;

        if (tree->type == Node_dynregex) {
                tree_eval(tree->re_exp);
                return;
        }

        if (tree->type == Node_regex) {
                re = tree->re_exp;
                restr = re->stptr;
                relen = re->stlen;
                pp_string(restr, relen, '/');
                return;
        }

        /* at this point, have either ~ or !~ */

        text = tree->lnode;
        re = tree->rnode;

        if (tree->type == Node_nomatch)
                op = "!~";
        else if (tree->type == Node_match)
                op = "~";
        else
                op = "";

        tree_eval(text);
        fprintf(prof_fp, " %s ", op);
        tree_eval(re);
}

/* pp_redir --- print a redirection */

static void
pp_redir(register NODE *tree, enum redir_placement dir)
{
        const char *op = "[BOGUS]";     /* should never be seen */

        if (tree == NULL)
                return;

        switch (tree->type) {
        case Node_redirect_output:
                op = ">";
                break;
        case Node_redirect_append:
                op = ">>";
                break;
        case Node_redirect_pipe:
                op = "|";
                break;
        case Node_redirect_pipein:
                op = "|";
                break;
        case Node_redirect_input:
                op = "<";
                break;
        case Node_redirect_twoway:
                op = "|&";
                break;
        default:
                cant_happen();
        }
        
        if (dir == BEFORE) {
                if (! is_scalar(tree->subnode->type)) {
                        fprintf(prof_fp, "(");
                        tree_eval(tree->subnode);
                        fprintf(prof_fp, ")");
                } else
                        tree_eval(tree->subnode);
                fprintf(prof_fp, " %s ", op);
        } else {
                fprintf(prof_fp, " %s ", op);
                if (! is_scalar(tree->subnode->type)) {
                        fprintf(prof_fp, "(");
                        tree_eval(tree->subnode);
                        fprintf(prof_fp, ")");
                } else
                        tree_eval(tree->subnode);
        }
}

/* pp_list --- dump a list of arguments, without parens */

static void
pp_list(register NODE *tree)
{
        for (; tree != NULL; tree = tree->rnode) {
                if (tree->type != Node_expression_list) {
                        fprintf(stderr, "pp_list: got %s\n",
                                        nodetype2str(tree->type));
                        fflush(stderr);
                }
                assert(tree->type == Node_expression_list);
                tree_eval(tree->lnode);
                if (tree->rnode != NULL)
                        fprintf(prof_fp, ", ");
        }
}

/* pp_print_stmt --- print a "print" or "printf" statement */

static void
pp_print_stmt(const char *command, register NODE *tree)
{
        NODE *redir = tree->rnode;

        indent(tree->exec_count);
        fprintf(prof_fp, "%s", command);
        if (redir != NULL) {
                if (tree->lnode != NULL) {
                        /* parenthesize if have a redirection and a list */
                        fprintf(prof_fp, "(");
                        pp_list(tree->lnode);
                        fprintf(prof_fp, ")");
                } else
                        fprintf(prof_fp, " $0");
                pp_redir(redir, AFTER);
        } else {
                fprintf(prof_fp, " ");
                if (tree->lnode != NULL)
                        pp_list(tree->lnode);
                else
                        fprintf(prof_fp, "$0");
        }
        fprintf(prof_fp, "\n");
}

/* pp_delete --- print a "delete" statement */

static void
pp_delete(register NODE *tree)
{
        NODE *array, *subscript;

        array = tree->lnode;
        subscript = tree->rnode;
        indent(array->exec_count);
        if (array->type == Node_param_list)
                fprintf(prof_fp, "delete %s", fparms[array->param_cnt]);
        else
                fprintf(prof_fp, "delete %s", array->vname);
        if (subscript != NULL) {
                fprintf(prof_fp, "[");
                pp_list(subscript);
                fprintf(prof_fp, "]");
        }
        fprintf(prof_fp, "\n");
}

/* pp_in_array --- pretty print "foo in array" test */

static void
pp_in_array(NODE *array, NODE *subscript)
{
        if (subscript->type == Node_expression_list) {
                fprintf(prof_fp, "(");
                pp_list(subscript);
                fprintf(prof_fp, ")");
        } else
                pprint(subscript);

        if (array->type == Node_param_list)
                fprintf(prof_fp, " in %s", fparms[array->param_cnt]);
        else
                fprintf(prof_fp, " in %s", array->vname);
}

/* pp_getline --- print a getline statement */

static void
pp_getline(register NODE *tree)
{
        NODE *redir = tree->rnode;
        int before, after;

        /*
         * command | getline
         *     or
         * command |& getline
         *     or
         * getline < file
         */
        if (redir != NULL) {
                before = (redir->type == Node_redirect_pipein
                                || redir->type == Node_redirect_twoway);
                after = ! before;
        } else
                before = after = FALSE;

        if (before)
                pp_redir(redir, BEFORE);

        fprintf(prof_fp, "getline");
        if (tree->lnode != NULL) {      /* optional var */
                fprintf(prof_fp, " ");
                pp_lhs(tree->lnode);
        }

        if (after)
                pp_redir(redir, AFTER);
}

/* pp_builtin --- print a builtin function */

static void
pp_builtin(register NODE *tree)
{
        const char *func = getfname(tree->builtin);

        fprintf(prof_fp, "%s(", func ? func : "extension_function");
        if (func)
                pp_list(tree->subnode);
        fprintf(prof_fp, ")");
}

/* pp_func_call --- print a function call */

static void
pp_func_call(NODE *tree)
{
        NODE *name, *arglist;

        name = tree->rnode;
        arglist = tree->lnode;
        fprintf(prof_fp, "%s(", name->stptr);
        pp_list(arglist);
        fprintf(prof_fp, ")");
}

/* dump_prog --- dump the program */

/*
 * XXX: I am not sure it is right to have the strings in the dump
 * be translated, but I'll leave it alone for now.
 */

void
dump_prog(NODE *begin, NODE *prog, NODE *end)
{
        time_t now;

        (void) time(& now);
        /* \n on purpose, with \n in ctime() output */
        fprintf(prof_fp, _("\t# gawk profile, created %s\n"), ctime(& now));

        if (begin != NULL) {
                fprintf(prof_fp, _("\t# BEGIN block(s)\n\n"));
                fprintf(prof_fp, "\tBEGIN {\n");
                in_BEGIN_or_END = TRUE;
                pprint(begin);
                in_BEGIN_or_END = FALSE;
                fprintf(prof_fp, "\t}\n");
                if (prog != NULL || end != NULL)
                        fprintf(prof_fp, "\n");
        }
        if (prog != NULL) {
                fprintf(prof_fp, _("\t# Rule(s)\n\n"));
                pprint(prog);
                if (end != NULL)
                        fprintf(prof_fp, "\n");
        }
        if (end != NULL) {
                fprintf(prof_fp, _("\t# END block(s)\n\n"));
                fprintf(prof_fp, "\tEND {\n");
                in_BEGIN_or_END = TRUE;
                pprint(end);
                in_BEGIN_or_END = FALSE;
                fprintf(prof_fp, "\t}\n");
        }
}

/* pp_func --- pretty print a function */

void
pp_func(const char *name, size_t namelen, NODE *f)
{
        int j;
        char **pnames;
        static int first = TRUE;

        if (first) {
                first = FALSE;
                fprintf(prof_fp, _("\n\t# Functions, listed alphabetically\n"));
        }

        fprintf(prof_fp, "\n");
        indent(f->exec_count);
        fprintf(prof_fp, "function %.*s(", (int) namelen, name);
        pnames = f->parmlist;
        fparms = pnames;
        for (j = 0; j < f->lnode->param_cnt; j++) {
                fprintf(prof_fp, "%s", pnames[j]);
                if (j < f->lnode->param_cnt - 1)
                        fprintf(prof_fp, ", ");
        }
        fprintf(prof_fp, ")\n\t{\n");
        indent_in();
        pprint(f->rnode);       /* body */
        indent_out();
        fprintf(prof_fp, "\t}\n");
}

/* pp_string --- pretty print a string or regex constant */

static void
pp_string(const char *str, size_t len, int delim)
{
        pp_string_fp(prof_fp, str, len, delim, FALSE);
}

/* pp_string_fp --- printy print a string to the fp */

/*
 * This routine concentrates string pretty printing in one place,
 * so that it can be called from multiple places within gawk.
 */

void
pp_string_fp(FILE *fp, const char *in_str, size_t len, int delim, int breaklines)
{
        static char escapes[] = "\b\f\n\r\t\v\\";
        static char printables[] = "bfnrtv\\";
        char *cp;
        int i;
        int count;
#define BREAKPOINT      70 /* arbitrary */
        const unsigned char *str = (const unsigned char *) in_str;

        fprintf(fp, "%c", delim);
        for (count = 0; len > 0; len--, str++) {
                if (++count >= BREAKPOINT && breaklines) {
                        fprintf(fp, "%c\n%c", delim, delim);
                        count = 0;
                }
                if (*str == delim) {
                        fprintf(fp, "\\%c", delim);
                        count++;
                } else if (*str == BELL) {
                        fprintf(fp, "\\a");
                        count++;
                } else if ((cp = strchr(escapes, *str)) != NULL) {
                        i = cp - escapes;
                        putc('\\', fp);
                        count++;
                        putc(printables[i], fp);
                        if (breaklines && *str == '\n' && delim == '"') {
                                fprintf(fp, "\"\n\"");
                                count = 0;
                        }
                /* NB: Deliberate use of lower-case versions. */
                } else if (isascii(*str) && isprint(*str)) {
                        putc(*str, fp);
                } else {
                        char buf[10];

                        /* print 'em as they came if for whiny users */
                        if (whiny_users)
                                sprintf(buf, "%c", *str & 0xff);
                        else
                                sprintf(buf, "\\%03o", *str & 0xff);
                        count += strlen(buf) - 1;
                        fprintf(fp, "%s", buf);
                }
        }
        fprintf(fp, "%c", delim);
}

/* is_scalar --- true or false if we'll get a scalar value */

static int
is_scalar(NODETYPE type)
{
        switch (type) {
        case Node_var_new:
        case Node_var:
        case Node_var_array:
        case Node_val:
        case Node_BINMODE:
        case Node_CONVFMT: