NetBSD/gnu/dist/gawk/profile.c

/*	$NetBSD: profile.c,v 1.1.1.1 2003/10/06 15:46:56 wiz Exp $	*/

/*
 * 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:
	case Node_FIELDWIDTHS:
	case Node_FNR:
	case Node_FS:
	case Node_IGNORECASE:
	case Node_LINT:
	case Node_NF:
	case Node_NR:
	case Node_OFMT:
	case Node_OFS:
	case Node_ORS:
	case Node_RS:
	case Node_TEXTDOMAIN:
	case Node_subscript:
		return TRUE;
	default:
		return FALSE;
	}
}

/* prec_level --- return the precedence of an operator, for paren tests */

static int
prec_level(NODETYPE type)
{
	switch (type) {
	case Node_var_new:
	case Node_var:
	case Node_var_array:
	case Node_param_list:
	case Node_subscript:
	case Node_func_call:
	case Node_K_delete_loop:
	case Node_val:
	case Node_builtin:
	case Node_BINMODE:
	case Node_CONVFMT:
	case Node_FIELDWIDTHS:
	case Node_FNR:
	case Node_FS:
	case Node_IGNORECASE:
	case Node_LINT:
	case Node_NF:
	case Node_NR:
	case Node_OFMT:
	case Node_OFS:
	case Node_ORS:
	case Node_RS:
	case Node_TEXTDOMAIN:
		return 15;

	case Node_field_spec:
		return 14;

	case Node_exp:
		return 13;

	case Node_preincrement:
	case Node_predecrement:
	case Node_postincrement:
	case Node_postdecrement:
		return 12;

	case Node_unary_minus:
	case Node_not:
		return 11;

	case Node_times:
	case Node_quotient:
	case Node_mod:
		return 10;

	case Node_plus:
	case Node_minus:
		return 9;

	case Node_concat:
		return 8;

	case Node_equal:
	case Node_notequal:
	case Node_greater:
	case Node_leq:
	case Node_geq:
	case Node_match:
	case Node_nomatch:
		return 7;

	case Node_K_getline:
		return 6;

	case Node_less:
		return 5;

	case Node_in_array:
		return 5;

	case Node_and:
		return 4;

	case Node_or:
		return 3;

	case Node_cond_exp:
		return 2;

	case Node_assign:
	case Node_assign_times:
	case Node_assign_quotient:
	case Node_assign_mod:
	case Node_assign_plus:
	case Node_assign_minus:
	case Node_assign_exp:
		return 1;

	default:
		fatal(_("unexpected type %s in prec_level"), nodetype2str(type));
		return 0;	/* keep the compiler happy */
	}
}

/* parenthesize --- print a subtree in parentheses if need be */

static void
parenthesize(NODETYPE parent_type, NODE *tree)
{
	NODETYPE child_type;

	if (tree == NULL)
		return;

	child_type = tree->type;

	in_expr++;
	/* first the special cases, then the general ones */
	if (parent_type == Node_not && child_type == Node_in_array) {
		fprintf(prof_fp, "! (");
		pp_in_array(tree->lnode, tree->rnode);
		fprintf(prof_fp, ")");
	/* other special cases here, as needed */
	} else if (prec_level(child_type) < prec_level(parent_type)) {
		fprintf(prof_fp, "(");
		tree_eval(tree);
		fprintf(prof_fp, ")");
	} else
		tree_eval(tree);
	in_expr--;
}

#ifdef PROFILING
/* just_dump --- dump the profile and function stack and keep going */

static RETSIGTYPE
just_dump(int signum)
{
	extern NODE *begin_block, *expression_value, *end_block;

	dump_prog(begin_block, expression_value, end_block);
	dump_funcs();
	dump_fcall_stack(prof_fp);
	fflush(prof_fp);
	signal(signum, just_dump);	/* for OLD Unix systems ... */
}

/* dump_and_exit --- dump the profile, the function stack, and exit */

static RETSIGTYPE
dump_and_exit(int signum)
{
	just_dump(signum);
	exit(1);
}
#endif