#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "chn.h"
#include "chn.fn.h"
#include "cons.h"
#include "eliminate.fn.h"
#include "expr.h"
#include "expr.fn.h"
#include "expralloc.fn.h"
#include "forward.fn.h"
#include "hoist.fn.h"
#include "macros.h"
#include "mem.fn.h"
#include "parse.h"
#include "parse.fn.h"
#include "structs.fn.h"
#include "sym.fn.h"
#include "util.fn.h"

#define PARSE_SCOPE 1

extern symbolp *ccom_tmplsyms;
extern int ccom_tmplsymvarnum;
extern int ccom_error;
extern int ccom_fnnum;

FILE *ccom_ofile = stdout;
char *ccom_fnprefix = "";
char *ccom_fnsuffix = "";
int ccom_ansi = 1;
int ccom_fortran = 0;
int ccom_uppercase = 0;
int ccom_pass_scalars_by_value = 0;

char *ccom_current_tmpl;
int ccom_current_line;

union ccom_generic ccom_prop_null;

static struct parse_node *mk_pnode(enum pstmt_type t, int scope,
                                   char *tmplname, int tmplline)
{
  struct parse_node *result;

  result = ccom_malloc(sizeof(*result),scope);
  result->t = t;
  result->tmplname = tmplname;
  result->lineno = tmplline;
  result->partner = NULL;
  result->next = NULL;
  return result;
}

struct parse_node *ccom_pn_empty(int scope)
{
  struct parse_node *result = mk_pnode(pstmt_empty,scope,NULL,-1);

  return result;
}

struct parse_node *ccom_pn_intro(genericp tmpl, gchnp args, gchnp varargs,
				 gchnp localargs,
				 int scope, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_intro,scope,
				       tmpl->symbol.name,tmplline);

  result->guts.introblock.tmpl = tmpl;
  result->guts.introblock.args = args;
  result->guts.introblock.varargs = varargs;
  result->guts.introblock.localargs = localargs;
  return result;
}

struct parse_node *ccom_pn_head(struct parse_node *tree, int scope)
{
  struct parse_node *result = mk_pnode(pstmt_head,scope,NULL,-1);

  result->guts.head.tree = tree;
  return result;
}

struct parse_node *ccom_pn_expr(genericp expr, int scope,
				char *tmplname, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_expr,scope,tmplname,tmplline);

  result->guts.expr = expr;
  return result;
}

struct parse_node *ccom_pn_ctrlassn(genericp lhs, genericp rhs,
				    int scope, char *tmplname, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_ctrlassn,scope,tmplname,tmplline);

  result->guts.ctrlassn.lhs = lhs;
  result->guts.ctrlassn.rhs = rhs;
  return result;
}

struct parse_node *ccom_pn_ctrlif(genericp cond, struct parse_node *ifbranch,
				  struct parse_node *elsebranch,
				  int scope, char *tmplname, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_ctrlif,scope,tmplname,tmplline);

  result->guts.ifblock.cond = cond;
  result->guts.ifblock.ifbranch = ifbranch;
  result->guts.ifblock.elsebranch = elsebranch;
  return result;
}

struct parse_node *ccom_pn_if(genericp cond, struct parse_node *ifbranch,
			      struct parse_node *elsebranch,
			      int scope, char *tmplname, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_if,scope,tmplname,tmplline);

  result->guts.ifblock.cond = cond;
  result->guts.ifblock.ifbranch = ifbranch;
  result->guts.ifblock.elsebranch = elsebranch;
  return result;
}

struct parse_node *ccom_pn_while(genericp cond, struct parse_node *body,
				 int scope, char *tmplname, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_while,scope,tmplname,tmplline);

  result->guts.whileblock.cond = cond;
  result->guts.whileblock.body = body;
  result->guts.whileblock.nonzero_iters = 0;
  return result;
}

struct parse_node *ccom_pn_do(genericp cond, struct parse_node *body,
			      int scope, char *tmplname, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_do,scope,tmplname,tmplline);

  result->guts.doblock.cond = cond;
  result->guts.doblock.body = body;
  return result;
}

struct parse_node *ccom_pn_cwhile(genericp cond, struct parse_node *body,
				  int scope, char *tmplname, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_cwhile,scope,tmplname,tmplline);

  result->guts.whileblock.cond = cond;
  result->guts.whileblock.body = body;
  result->guts.whileblock.nonzero_iters = 0;
  return result;
}

struct parse_node *ccom_pn_for(genericp pre, genericp cond, genericp post,
                               struct parse_node *body,
                               int scope, char *tmplname, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_for,scope,tmplname,tmplline);

  result->guts.forblock.pre = pre;
  result->guts.forblock.post = post;
  result->guts.forblock.cond = cond;
  result->guts.forblock.body = body;
  result->guts.forblock.nonzero_iters = 0;
  return result;
}

struct parse_node *ccom_pn_include(genericp tmpl, gchnp args,
				   int scope, char *tmplname, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_include,scope,tmplname,tmplline);

  result->guts.includeblock.tmpl = tmpl;
  result->guts.includeblock.args = args;
  return result;
}

struct parse_node *ccom_pn_declare(genericp sym, xtypep type,
				   gchnp dimsizelist,
				   int scope, char *tmplname, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_declare,scope,tmplname,tmplline);

  result->guts.declareblock.sym = sym;
  result->guts.declareblock.type = type;
  result->guts.declareblock.dimsizelist = dimsizelist;
  return result;
}

struct parse_node *ccom_pn_sudeclare(char *name, xtypep type,
				     int scope, char *tmplname, int tmplline)
{
  struct parse_node *result = mk_pnode(pstmt_sudeclare,
				       scope,tmplname,tmplline);
  char *newname;

  newname = ccom_strdup(name,scope);
  result->guts.sudeclareblock.name = newname;
  result->guts.sudeclareblock.type = type;
  return result;
}

/* Adds a new node (or list of nodes) to the end of a parse tree
   statement list.  Unfortunately, this uses a horrible algorithm that
   walks to the end of the linked list to find the last node, and adds
   it afterwards.  */
struct parse_node *ccom_pn_add_node(struct parse_node *list,
				    struct parse_node *new)
{
  struct parse_node *result;

  if (list == NULL)
    return new;
  result = list;
  while (list->next != NULL)
    list = list->next;
  list->next = new;
  if (list->partner != NULL)
    list->partner->next = new;

  return result;
}

/* Copies an existing parse tree into scoping level 0. */
struct parse_node *ccom_copy_parse_tree(struct parse_node *tree)
{
  struct parse_node *result = NULL;

  if (tree == NULL)
    return tree;

  switch (tree->t)
    {
      case pstmt_intro:
	result = ccom_pn_intro(ccom_cpgeneric(0,tree->guts.introblock.tmpl),
			       ccom_cpgchn(0,tree->guts.introblock.args),
			       ccom_cpgchn(0,tree->guts.introblock.varargs),
			       ccom_cpgchn(0,tree->guts.introblock.localargs),
			       0,tree->lineno);
	break;
      case pstmt_head:
	result = ccom_pn_head(ccom_copy_parse_tree(tree->guts.head.tree),0);
	break;
      case pstmt_expr:
	result = ccom_pn_expr(ccom_cpgeneric(0,tree->guts.expr),
			      0,tree->tmplname,tree->lineno);
	break;
      case pstmt_include:
	result =
          ccom_pn_include(ccom_cpgeneric(0,tree->guts.includeblock.tmpl),
                          ccom_cpgchn(0,tree->guts.includeblock.args),
                          0,tree->tmplname,tree->lineno);
	break;
      case pstmt_ctrlassn:
	result = ccom_pn_ctrlassn(ccom_cpgeneric(0,tree->guts.ctrlassn.lhs),
				  ccom_cpgeneric(0,tree->guts.ctrlassn.rhs),
				  0,tree->tmplname,tree->lineno);
	break;
      case pstmt_ctrlif:
	result =
	  ccom_pn_ctrlif(ccom_cpgeneric(0,tree->guts.ifblock.cond),
			 ccom_copy_parse_tree(tree->guts.ifblock.ifbranch),
			 ccom_copy_parse_tree(tree->guts.ifblock.elsebranch),
			 0,tree->tmplname,tree->lineno);
	break;
      case pstmt_if:
	result =
	  ccom_pn_if(ccom_cpgeneric(0,tree->guts.ifblock.cond),
		     ccom_copy_parse_tree(tree->guts.ifblock.ifbranch),
		     ccom_copy_parse_tree(tree->guts.ifblock.elsebranch),
		     0,tree->tmplname,tree->lineno);
	break;
      case pstmt_while:
	result =
	  ccom_pn_while(ccom_cpgeneric(0,tree->guts.whileblock.cond),
			ccom_copy_parse_tree(tree->guts.whileblock.body),
			0,tree->tmplname,tree->lineno);
	break;
      case pstmt_cwhile:
	result =
	  ccom_pn_cwhile(ccom_cpgeneric(0,tree->guts.whileblock.cond),
			 ccom_copy_parse_tree(tree->guts.whileblock.body),
			 0,tree->tmplname,tree->lineno);
	break;
      case pstmt_do:
	result =
	  ccom_pn_do(ccom_cpgeneric(0,tree->guts.doblock.cond),
		     ccom_copy_parse_tree(tree->guts.doblock.body),
		     0,tree->tmplname,tree->lineno);
	break;
      case pstmt_for:
        result = ccom_pn_for(ccom_cpgeneric(0,tree->guts.forblock.pre),
                             ccom_cpgeneric(0,tree->guts.forblock.cond),
                             ccom_cpgeneric(0,tree->guts.forblock.post),
                             ccom_copy_parse_tree(tree->guts.forblock.body),
                             0,tree->tmplname,tree->lineno);
        break;
      case pstmt_declare:
	result =
          ccom_pn_declare(ccom_cpgeneric(0,tree->guts.declareblock.sym),
                          tree->guts.declareblock.type,
                          ccom_cpgchn(0,tree->guts.declareblock.dimsizelist),
                          0,tree->tmplname,tree->lineno);
	break;
      case pstmt_sudeclare:
	result = ccom_pn_sudeclare(tree->guts.sudeclareblock.name,
				   tree->guts.sudeclareblock.type,
				   0,tree->tmplname,tree->lineno);
	break;
      case pstmt_empty:
	result = mk_pnode(tree->t,0,NULL,-1);
	break;
    }
  result->next = ccom_copy_parse_tree(tree->next);

  return result;
}

static void pindent(int ind)
{
  int i;

  for (i=0;i<ind;i++)
    fprintf(ccom_ofile," ");
}

static void print_endline(struct parse_node *node)
{
  if (node->tmplname != NULL)
    fprintf(ccom_ofile,"  /* %s:%d */",node->tmplname,node->lineno);
  fprintf(ccom_ofile,"\n");
  fflush(ccom_ofile);
}

static void parse_print(struct parse_node *tree, int ind)
{
  gchnp dimsize;

  if (tree == NULL)
    return;

  while (tree != NULL)
    {
      switch (tree->t)
	{
	  case pstmt_head:
	    parse_print(tree->guts.head.tree,ind);
	    break;
	  case pstmt_expr:
	    if (tree->guts.expr != NULL)
	      {
		pindent(ind);
		ccom_printgeneric(tree->guts.expr);
		print_endline(tree);
	      }
	    break;
	  case pstmt_ctrlassn:
	    pindent(ind);
	    ccom_printgeneric(tree->guts.ctrlassn.lhs);
	    fprintf(ccom_ofile," := ");
	    ccom_printgeneric(tree->guts.ctrlassn.rhs);
	    print_endline(tree);
	    break;
	  case pstmt_ctrlif:
	    pindent(ind);
	    fprintf(ccom_ofile,"cif ");
	    ccom_printgeneric(tree->guts.ifblock.cond);
	    print_endline(tree);
	    parse_print(tree->guts.ifblock.ifbranch,ind+2);
	    if (tree->guts.ifblock.elsebranch != NULL)
	      {
		pindent(ind);
		fprintf(ccom_ofile,"else\n");
		parse_print(tree->guts.ifblock.elsebranch,ind+2);
	      }
	    pindent(ind);
	    fprintf(ccom_ofile,"endif\n");
	    break;
	  case pstmt_if:
	    pindent(ind);
	    fprintf(ccom_ofile,"if ");
	    ccom_printgeneric(tree->guts.ifblock.cond);
	    print_endline(tree);
	    parse_print(tree->guts.ifblock.ifbranch,ind+2);
	    if (tree->guts.ifblock.elsebranch != NULL)
	      {
		pindent(ind);
		fprintf(ccom_ofile,"else\n");
		parse_print(tree->guts.ifblock.elsebranch,ind+2);
	      }
	    pindent(ind);
	    fprintf(ccom_ofile,"endif\n");
	    break;
	  case pstmt_while:
	    pindent(ind);
	    fprintf(ccom_ofile,"while ");
	    ccom_printgeneric(tree->guts.whileblock.cond);
	    print_endline(tree);
	    parse_print(tree->guts.whileblock.body,ind+2);
	    pindent(ind);
	    fprintf(ccom_ofile,"endwhile\n");
	    break;
	  case pstmt_do:
	    pindent(ind);
	    fprintf(ccom_ofile,"do");
	    print_endline(tree);
	    parse_print(tree->guts.doblock.body,ind+2);
	    pindent(ind);
	    fprintf(ccom_ofile,"while ");
	    ccom_printgeneric(tree->guts.doblock.cond);
	    fprintf(ccom_ofile,"\n");
	    break;
	  case pstmt_cwhile:
	    pindent(ind);
	    fprintf(ccom_ofile,"cwhile ");
	    ccom_printgeneric(tree->guts.whileblock.cond);
	    print_endline(tree);
	    parse_print(tree->guts.whileblock.body,ind+2);
	    pindent(ind);
	    fprintf(ccom_ofile,"endwhile\n");
	    break;
          case pstmt_for:
            pindent(ind);
            fprintf(ccom_ofile,"for (");
            ccom_printgeneric(tree->guts.forblock.pre);
            fprintf(ccom_ofile,";");
            ccom_printgeneric(tree->guts.forblock.cond);
            fprintf(ccom_ofile,";");
            ccom_printgeneric(tree->guts.forblock.post);
            fprintf(ccom_ofile,")\n");
            parse_print(tree->guts.forblock.body,ind+2);
            pindent(ind);
	    fprintf(ccom_ofile,"endfor\n");
            break;
	  case pstmt_include:
	    pindent(ind);
	    fprintf(ccom_ofile,"include ");
	    ccom_printgeneric(tree->guts.includeblock.tmpl);
	    fprintf(ccom_ofile,"(");
	    ccom_printchn(tree->guts.includeblock.args);
	    fprintf(ccom_ofile,")");
	    print_endline(tree);
	    break;
	  case pstmt_declare:
	    pindent(ind);
	    ccom_print_type(tree->guts.declareblock.type,NULL);
	    ccom_printgeneric(tree->guts.declareblock.sym);
	    dimsize = tree->guts.declareblock.dimsizelist;
	    while (dimsize != NULL)
	      {
		fprintf(ccom_ofile,"[");
		ccom_printgeneric(dimsize->data);
		fprintf(ccom_ofile,"]");
		dimsize = dimsize->nextp;
	      }
	    print_endline(tree);
	    break;
	  case pstmt_sudeclare:
	    break;
	  case pstmt_intro:
	  case pstmt_empty:
	    break;
	}
      tree = tree->next;
    }
}

static void parse_printnp(struct parse_node *tree, int ind)
{
  gchnp dimsize;

  if (tree == NULL)
    return;

  while (tree != NULL)
    {
      if (tree->partner != NULL)
	tree = tree->partner;

      switch (tree->t)
	{
	  case pstmt_head:
	    parse_printnp(tree->guts.head.tree,ind);
	    break;
	  case pstmt_expr:
	    if (tree->guts.expr != NULL)
	      {
		pindent(ind);
		ccom_printgeneric(tree->guts.expr);
		print_endline(tree);
	      }
	    break;
	  case pstmt_ctrlassn:
	    pindent(ind);
	    ccom_printgeneric(tree->guts.ctrlassn.lhs);
	    fprintf(ccom_ofile," := ");
	    ccom_printgeneric(tree->guts.ctrlassn.rhs);
	    print_endline(tree);
	    break;
	  case pstmt_ctrlif:
	    pindent(ind);
	    fprintf(ccom_ofile,"cif ");
	    ccom_printgeneric(tree->guts.ifblock.cond);
	    print_endline(tree);
	    parse_printnp(tree->guts.ifblock.ifbranch,ind+2);
	    if (tree->guts.ifblock.elsebranch != NULL)
	      {
		pindent(ind);
		fprintf(ccom_ofile,"else\n");
		parse_printnp(tree->guts.ifblock.elsebranch,ind+2);
	      }
	    pindent(ind);
	    fprintf(ccom_ofile,"endif\n");
	    break;
	  case pstmt_if:
	    pindent(ind);
	    fprintf(ccom_ofile,"if ");
	    ccom_printgeneric(tree->guts.ifblock.cond);
	    print_endline(tree);
	    parse_printnp(tree->guts.ifblock.ifbranch,ind+2);
	    if (tree->guts.ifblock.elsebranch != NULL)
	      {
		pindent(ind);
		fprintf(ccom_ofile,"else\n");
		parse_printnp(tree->guts.ifblock.elsebranch,ind+2);
	      }
	    pindent(ind);
	    fprintf(ccom_ofile,"endif\n");
	    break;
	  case pstmt_while:
	    pindent(ind);
	    fprintf(ccom_ofile,"while ");
	    ccom_printgeneric(tree->guts.whileblock.cond);
	    print_endline(tree);
	    parse_printnp(tree->guts.whileblock.body,ind+2);
	    pindent(ind);
	    fprintf(ccom_ofile,"endwhile\n");
	    break;
	  case pstmt_do:
	    pindent(ind);
	    fprintf(ccom_ofile,"do");
	    print_endline(tree);
	    parse_printnp(tree->guts.doblock.body,ind+2);
	    pindent(ind);
	    fprintf(ccom_ofile,"while ");
	    ccom_printgeneric(tree->guts.doblock.cond);
	    fprintf(ccom_ofile,"\n");
	    break;
	  case pstmt_cwhile:
	    pindent(ind);
	    fprintf(ccom_ofile,"cwhile ");
	    ccom_printgeneric(tree->guts.whileblock.cond);
	    print_endline(tree);
	    parse_printnp(tree->guts.whileblock.body,ind+2);
	    pindent(ind);
	    fprintf(ccom_ofile,"endwhile\n");
	    break;
          case pstmt_for:
            pindent(ind);
            fprintf(ccom_ofile,"for (");
            ccom_printgeneric(tree->guts.forblock.pre);
            fprintf(ccom_ofile,";");
            ccom_printgeneric(tree->guts.forblock.cond);
            fprintf(ccom_ofile,";");
            ccom_printgeneric(tree->guts.forblock.post);
            fprintf(ccom_ofile,")\n");
            parse_printnp(tree->guts.forblock.body,ind+2);
            pindent(ind);
	    fprintf(ccom_ofile,"endfor\n");
            break;
	  case pstmt_include:
	    pindent(ind);
	    fprintf(ccom_ofile,"include ");
	    ccom_printgeneric(tree->guts.includeblock.tmpl);
	    fprintf(ccom_ofile,"(");
	    ccom_printchn(tree->guts.includeblock.args);
	    fprintf(ccom_ofile,")");
	    print_endline(tree);
	    break;
	  case pstmt_declare:
	    pindent(ind);
	    ccom_print_type(tree->guts.declareblock.type,NULL);
	    ccom_printgeneric(tree->guts.declareblock.sym);
	    dimsize = tree->guts.declareblock.dimsizelist;
	    while (dimsize != NULL)
	      {
		fprintf(ccom_ofile,"[");
		ccom_printgeneric(dimsize->data);
		fprintf(ccom_ofile,"]");
		dimsize = dimsize->nextp;
	      }
	    print_endline(tree);
	    break;
	  case pstmt_sudeclare:
	    break;
	  case pstmt_intro:
	  case pstmt_empty:
	    break;
	}
      tree = tree->next;
    }
}

/* Counts the number of aggregate statements in the parse tree.  A
   return value of 2 is meant to be "2 or more".  The function is used
   by emit_tree() to determine whether to use braces around a
   statement block; if the block contains exactly one statement, no
   braces are used. */
static int count_stmts(struct parse_node *tree)
{
  int result = 0;

  while (tree != NULL)
    {
      switch (tree->t)
	{
	  case pstmt_intro:
	  case pstmt_ctrlassn:
	  case pstmt_ctrlif:
	  case pstmt_cwhile:
	  case pstmt_include:
	  case pstmt_declare:
	  case pstmt_sudeclare:
	  case pstmt_empty:
	    break;
	  case pstmt_head:
	    result += count_stmts(tree->guts.head.tree);
	    break;
	  case pstmt_expr:
            if (tree->guts.expr != NULL)
              result ++;
            break;
	  case pstmt_if:
	  case pstmt_while:
	  case pstmt_do:
          case pstmt_for:
	    result ++;
	    break;
	}
      if (result >= 2)
	return 2;
      tree = tree->next;
    }

  return result;
}

/* Returns whether the parse tree evaluates to an IF statement without
   an ELSE clause.  It must be the case that count_stmts(tree)==1. */
static int is_ifstmt_without_else(struct parse_node *tree)
{
  int result = 0;

  while (tree != NULL)
    {
      switch (tree->t)
	{
	  case pstmt_head:
	    result += is_ifstmt_without_else(tree->guts.head.tree);
	    break;
	  case pstmt_intro:
	  case pstmt_ctrlassn:
	  case pstmt_ctrlif:
	  case pstmt_cwhile:
	  case pstmt_include:
	  case pstmt_declare:
	  case pstmt_sudeclare:
	  case pstmt_empty:
	    break;
	  case pstmt_expr:
	  case pstmt_while:
	  case pstmt_do:
	  case pstmt_for:
	    break;
	  case pstmt_if:
	    if (tree->guts.ifblock.elsebranch == NULL)
	      result ++;
	    break;
	}
      tree = tree->next;
    }

  return result;
}

/* Just like parse_print, except that it emits valid C syntax. */
static void parse_emit(struct parse_node *tree, int ind)
{
  int numstmts;

  while (tree != NULL)
    {
      switch (tree->t)
	{
	  case pstmt_head:
	    parse_emit(tree->guts.head.tree,ind);
	    break;
	  case pstmt_expr:
	    if (tree->guts.expr != NULL)
	      {
		pindent(ind);
		ccom_printgeneric(tree->guts.expr);
                fprintf(ccom_ofile,";");
		print_endline(tree);
	      }
	    break;
	  case pstmt_if:
	    pindent(ind);
	    fprintf(ccom_ofile,"if (");
	    ccom_printgeneric(tree->guts.ifblock.cond);
            fprintf(ccom_ofile,")");
	    print_endline(tree);
	    numstmts = count_stmts(tree->guts.ifblock.ifbranch);
	    if (numstmts == 1 && tree->guts.ifblock.elsebranch != NULL &&
		is_ifstmt_without_else(tree->guts.ifblock.ifbranch))
	      numstmts = -1;  /* just something != 1 */
            if (numstmts != 1)
              {
                pindent(ind+2);
                fprintf(ccom_ofile,"{\n");
                ind += 2;
              }
	    parse_emit(tree->guts.ifblock.ifbranch,ind+2);
            if (numstmts != 1)
              {
                ind -= 2;
                pindent(ind+2);
                fprintf(ccom_ofile,"}\n");
              }
            if (tree->guts.ifblock.elsebranch != NULL)
              {
                pindent(ind);
                fprintf(ccom_ofile,"else\n");
		numstmts = count_stmts(tree->guts.ifblock.elsebranch);
                if (numstmts != 1)
                  {
                    pindent(ind+2);
                    fprintf(ccom_ofile,"{\n");
                    ind += 2;
                  }
                parse_emit(tree->guts.ifblock.elsebranch,ind+2);
                if (numstmts != 1)
                  {
                    ind -= 2;
                    pindent(ind+2);
                    fprintf(ccom_ofile,"}\n");
                  }
              }
	    break;
	  case pstmt_while:
	    pindent(ind);
	    fprintf(ccom_ofile,"while (");
	    ccom_printgeneric(tree->guts.whileblock.cond);
	    fprintf(ccom_ofile,")");
	    print_endline(tree);
	    numstmts = count_stmts(tree->guts.whileblock.body);
            if (numstmts != 1)
              {
                pindent(ind+2);
                fprintf(ccom_ofile,"{\n");
                ind += 2;
              }
	    parse_emit(tree->guts.whileblock.body,ind+2);
            if (numstmts != 1)
              {
                ind -= 2;
                pindent(ind+2);
                fprintf(ccom_ofile,"}\n");
              }
	    break;
	  case pstmt_do:
	    pindent(ind);
	    fprintf(ccom_ofile,"do");
	    print_endline(tree);
	    numstmts = count_stmts(tree->guts.doblock.body);
            if (numstmts != 1)
              {
                pindent(ind+2);
                fprintf(ccom_ofile,"{\n");
                ind += 2;
              }
	    parse_emit(tree->guts.doblock.body,ind+2);
            if (numstmts != 1)
              {
                ind -= 2;
                pindent(ind+2);
                fprintf(ccom_ofile,"}\n");
              }
	    pindent(ind);
	    fprintf(ccom_ofile,"while (");
	    ccom_printgeneric(tree->guts.doblock.cond);
	    fprintf(ccom_ofile,");\n");
	    break;
          case pstmt_for:
	    pindent(ind);
	    fprintf(ccom_ofile,"for (");
            ccom_printgeneric(tree->guts.forblock.pre);
	    fprintf(ccom_ofile,"; ");
            ccom_printgeneric(tree->guts.forblock.cond);
	    fprintf(ccom_ofile,"; ");
            ccom_printgeneric(tree->guts.forblock.post);
	    fprintf(ccom_ofile,")");
	    print_endline(tree);
	    numstmts = count_stmts(tree->guts.forblock.body);
            if (numstmts != 1)
              {
                pindent(ind+2);
                fprintf(ccom_ofile,"{\n");
                ind += 2;
              }
	    parse_emit(tree->guts.forblock.body,ind+2);
            if (numstmts != 1)
              {
                ind -= 2;
                pindent(ind+2);
                fprintf(ccom_ofile,"}\n");
              }
            break;
	  case pstmt_ctrlassn:
	  case pstmt_ctrlif:
	  case pstmt_cwhile:
	  case pstmt_include:
	  case pstmt_declare:
	  case pstmt_sudeclare:
	  case pstmt_intro:
	  case pstmt_empty:
	    break;
	}
      tree = tree->next;
    }
}

static void clear_all_prop_fields(void)
{
  int i;

  for (i=0;i<ccom_tmplsymvarnum;i++)
    {
      ccom_tmplsyms[i]->cprop = PROPNULL;
      ccom_tmplsyms[i]->dprop = PROPNULL;
      ccom_tmplsyms[i]->b.lb = NULL;
      ccom_tmplsyms[i]->b.ub = NULL;
      ccom_tmplsyms[i]->propme = NULL;
      ccom_tmplsyms[i]->bpstack = NULL;
    }
}

static genericp de_tmplsym(genericp g);

static gchnp de_tmplsym_list(gchnp args)
{
  gchnp result = NULL;

  while (args != NULL)
    {
      result = cons3(0,de_tmplsym(args->data),result);
      args = args->nextp;
    }

  return ccom_revgchn(result);
}

/* This function does two things.  First, it inserts a pointer for
   each symbol it finds into the main symbol table, so that
   declarations will be emitted for exactly the symbols that are used.
   Second, it prints error messages for all remaining errnodes. */
static genericp de_tmplsym(genericp g)
{
  genericp result = NULL;
  genericp tmpfun;

  if (g == NULL)
    return g;

  switch (g->t)
    {
      case ccom_constant:
      case ccom_mstring:
      case ccom_slice: /* shouldn't occur */
      case ccom_opaque: /* shouldn't occur */
      case ccom_glist: /* shouldn't occur */
	result = g;
	break;
      case ccom_symbol:
	result = g;
	ccom_insert_raw_sym(&(g->symbol));
	break;
      case ccom_arrayref:
	result = ccom_mkarrayref(0,de_tmplsym(g->arrayref.array),
				 de_tmplsym_list(g->arrayref.args));
	break;
      case ccom_funcall:
	tmpfun = g->funcall.fun;
	if (tmpfun->t == ccom_symbol &&
	    tmpfun->symbol.type->contents != ccom_xtype_function &&
	    !ccom_contains_tspec(tmpfun->symbol.type,ccom_tspec_macro) &&
	    !ccom_contains_tspec(tmpfun->symbol.type,ccom_tspec_nodecl))
	  {
	    struct ccom_errnode *err;
	    char *errmsg = " wasn't declared as a function/macro/nodecl";
	    NEWG(err,0);
	    err->t = ccom_errnode;
	    err->b.lb = err->b.ub = NULL;
	    err->tmplname = tmpfun->symbol.tmplname;
	    err->tmplline = tmpfun->symbol.tmplline;
	    err->message =
	      ccom_malloc(1+strlen(tmpfun->symbol.name)+strlen(errmsg),0);
	    sprintf(err->message,"%s%s",
		    tmpfun->symbol.name,errmsg);
	    tmpfun = (genericp) err;
	  }
	result = ccom_mkfuncall(0,de_tmplsym(tmpfun),
				de_tmplsym_list(g->funcall.args));
	break;
      case ccom_expr:
	switch (g->expr.op)
	  {
	    case ccom_dot:
	    case ccom_arrow:
	      result = ccom_mkdotexpr(g->expr.scope,
				      de_tmplsym(g->expr.leftp),
				      g->expr.op,
				      g->expr.dotfield);
	      break;
	    default:
	      result = EXPR(g->expr.op,
			    de_tmplsym(g->expr.leftp),
			    de_tmplsym(g->expr.rightp));
	      break;
	  }
	break;
      case ccom_cast:
	result = ccom_mkcast(0,g->cast.type,de_tmplsym(g->cast.e));
	break;
      case ccom_errnode:
	fprintf(stderr,"Error: %s (template %s, line %d)\n",
		g->errnode.message,g->errnode.tmplname,g->errnode.tmplline);
	ccom_error ++;
	result = g;
	break;
      case ccom_sizof:
	result = ccom_mksizof(0,g->sizof.is_genericp,de_tmplsym(g->sizof.g),
			      g->sizof.type);
	break;
      case ccom_ternary:
	result = ccom_mkternary(0,de_tmplsym(g->ternary.cond),
				de_tmplsym(g->ternary.expr1),
				de_tmplsym(g->ternary.expr2));
	break;
    }

  return result;
}

static void de_tmplsym_tree(struct parse_node *tree)
{
  while (tree != NULL)
    {
      switch (tree->t)
	{
	  case pstmt_intro:
	  case pstmt_ctrlassn:
	  case pstmt_ctrlif:
	  case pstmt_cwhile:
	  case pstmt_include:
	  case pstmt_declare:
	  case pstmt_sudeclare:
	  case pstmt_empty:
	    break;
	  case pstmt_head:
	    de_tmplsym_tree(tree->guts.head.tree);
	    break;
	  case pstmt_expr:
	    tree->guts.expr = de_tmplsym(tree->guts.expr);
	    break;
	  case pstmt_if:
	    tree->guts.ifblock.cond = de_tmplsym(tree->guts.ifblock.cond);
	    de_tmplsym_tree(tree->guts.ifblock.ifbranch);
            de_tmplsym_tree(tree->guts.ifblock.elsebranch);
	    break;
	  case pstmt_while:
	    tree->guts.whileblock.cond =
              de_tmplsym(tree->guts.whileblock.cond);
	    de_tmplsym_tree(tree->guts.whileblock.body);
	    break;
	  case pstmt_do:
	    de_tmplsym_tree(tree->guts.doblock.body);
	    tree->guts.doblock.cond = de_tmplsym(tree->guts.doblock.cond);
	    break;
          case pstmt_for:
            tree->guts.forblock.pre = de_tmplsym(tree->guts.forblock.pre);
            tree->guts.forblock.cond = de_tmplsym(tree->guts.forblock.cond);
            tree->guts.forblock.post = de_tmplsym(tree->guts.forblock.post);
	    de_tmplsym_tree(tree->guts.forblock.body);
            break;
	}
      tree = tree->next;
    }
}

static struct parse_node *add_vararray_stuff(struct parse_node *result)
{
  gchnp vlist = ccom_vararrays(0);
  gchnp search;
  int varno = 0;
  int i;
  genericp dimsize;
  symbolp sym;
  genericp multvar;
  struct parse_node *prologue = NULL;
  struct parse_node *epilogue = NULL;
  struct parse_node *stmt;

  for (search=vlist;search!=NULL;search=search->nextp)
    {
      dimsize = ICON(1);
      sym = &(search->data->symbol);
      sym->varsize = 1;
      sym->addrvec = ccom_malloc(sym->ndim*sizeof(*sym->addrvec),0);
      for (i=sym->ndim-1;i>=0;i--)
	{
	  if (dimsize->t == ccom_constant)
	    {
	      sym->addrvec[i] = dimsize;
	    }
	  else
	    {
	      char *name = "amult";
	      char *str = ccom_malloc(1+strlen(name)+ccom_numstrlen(varno),0);
	      sprintf(str,"%s%d",name,varno++);
	      multvar = ccom_lookupsym(str,CCOM_INT);
	      sym->addrvec[i] = multvar;
              stmt = ccom_pn_expr(EXPR(ccom_assn,multvar,dimsize),0,NULL,-1);
              prologue = ccom_pn_add_node(prologue,stmt);
	    }
	  dimsize = EXPR(ccom_times,dimsize,(sym->final_dimsize)(sym,i));
	}
      if (sym->scope == 0)
	{
          genericp expr;
          genericp fun;
          xtypep type;
	  NEWG(type,0);
          type->contents = ccom_xtype_address;
#if 0
          type->ptrtype = sym->type;
#else
	  /* Cast to void* instead. */
	  type->ptrtype = CCOM_VOID;
#endif
          fun = ccom_lookupsym("malloc",CCOM_MACRO);
          expr = ccom_mkfuncall(0,fun,
                                cons3(0,EXPR(ccom_times,
                                             dimsize,
					     ccom_mksizof(0,0,NULL,sym->type)),
                                      NULL));
          expr = ccom_mkcast(0,type,expr);
          stmt = ccom_pn_expr(EXPR(ccom_assn,search->data,expr),0,NULL,-1);
          prologue = ccom_pn_add_node(prologue,stmt);
          fun = ccom_lookupsym("free",CCOM_MACRO);
          expr = ccom_mkfuncall(0,fun,cons3(0,search->data,NULL));
          stmt = ccom_pn_expr(expr,0,NULL,-1);
          epilogue = ccom_pn_add_node(stmt,epilogue);
	}
    }

  result = ccom_pn_add_node(prologue,result);
  result = ccom_pn_add_node(result,epilogue);

  return result;
}

/* Emits the completed function, including the dumping of the symbol
   table.  It should also create the function invocation (as a
   genericp) so that it can be returned to the calling compiler via
   the interface routines.  Warning: the function invocation is
   created using scoping level 0, so the interface routines need to
   copy it to a different scoping level if necessary, using
   ccom_cpgeneric() with the appropriate scoping level.

   Oh, one more thing.  For Fortran programs, scalars are passed by
   reference.  So we need to modify the function arglist to reflect
   this, and add a prolog that dereferences the pointers.  E.g.,
     void foo(int a, complex b, float c[10])
   changes to
     void foo(int *pa, complex *pb, float c[10])
       a = pa[0];
       b = pb[0];

   I have to change the model here.  In general, any scalar that is an
   input parameter may be modified by the template.  Thus *all*
   scalars need to be passed by reference.  (Note that arrays are
   already implicitly passed by reference.)  In Fortran, this already
   happens, so we need to make a special case otherwise.

   On the other hand, for my simple driver program, it's a pain to
   have scalars passed by reference.  So I'll add a flag to diable
   that.

   Also, in the epilogue, we need to copy the scalars back. */
static genericp produce_function(struct parse_node *tree)
{
  char *sfname;
  char *funstr = "ccom_fun_";
  gchnp arglist, retarglist, search;
  gchnp extraargs = NULL;
  genericp funname;
  genericp retval;
  struct parse_node *prologue = NULL;
  struct parse_node *epilogue = NULL;

  fprintf(ccom_ofile,"void %s%s%d%s(",ccom_fnprefix,
	  (ccom_uppercase ? "CCOM_FUN_" : "ccom_fun_"),
	  ccom_fnnum,ccom_fnsuffix);

  tree = add_vararray_stuff(tree);

  arglist = ccom_arglist(); /* list of all scope!=0 symbols */
  retarglist = ccom_arglist();
  /* I have to do something really sick.  For every element of the
     arglist I replace, we still need to declare the original arg.
     But ccom_dumpsymtab(0) won't handle them, because they don't have
     scope 0.  So I have to put them on a special list and declare
     them separately. */
  if (!ccom_pass_scalars_by_value)
    for (search=arglist;search!=NULL;search=search->nextp)
      {  /* look for scalar arguments */
	symbolp var = &(search->data->symbol);
	symbolp newvar;
	genericp newvarg;
	xtypep newvartype;
	char *varname;
	int scope = var->scope;
	struct parse_node *node;
	var->dprop = PROPNULL;
	var->propme = NULL;
	var->bpstack = NULL;
	if (var->ndim == 0)
	  {
	    switch (var->type->contents)
	      {
		case ccom_xtype_tspec:
		case ccom_xtype_struct:
		case ccom_xtype_union:
		case ccom_xtype_structname:
		case ccom_xtype_unionname:
		case ccom_xtype_typedef:
		  /* Create a new variable which is a pointer to the old
		     variable.  Add the new variable to the non-scope-0
		     symbol table.  Replace the original variable on the
		     function argument list with the new variable.  Add
		     the appropriate assignment statement to the
		     prologue.  Add the old variable to the "extraargs"
		     list so that it will be declared as well.  */
		  NEWG(newvartype,scope);
		  newvartype->contents = ccom_xtype_address;
		  newvartype->ptrtype = var->type;
		  varname = ccom_malloc(2+strlen(var->name),0);
		  sprintf(varname,"p%s",var->name);
		  newvarg = ccom_insertsym(scope,varname,newvartype,
					   var->opaque);
		  newvar = &(newvarg->symbol);
		  search->data = (genericp)newvar;
		  /* Copy in during the prologue. */
		  node = ccom_pn_expr(EXPR(ccom_assn,
					   (genericp)var,
					   ccom_mkarrayref(scope,
							   (genericp)newvar,
							   cons3(0,ICON(0),
								 NULL))),
				      0,NULL,-1);
		  prologue = ccom_pn_add_node(prologue,node);
		  /* Copy out during the epilogue. */
		  node = ccom_pn_expr(EXPR(ccom_assn,
					   ccom_mkarrayref(scope,
							   (genericp)newvar,
							   cons3(0,ICON(0),
								 NULL)),
					   (genericp)var),
				      0,NULL,-1);
		  epilogue = ccom_pn_add_node(epilogue,node);
		  extraargs = cons3(0,(genericp)var,extraargs);
		  break;
		case ccom_xtype_address:
		case ccom_xtype_array:
		case ccom_xtype_function:
		  break;
		case ccom_xtype_typeof:  /* shouldn't happen */
		  break;
	      }
	  }
      }
  tree = ccom_pn_add_node(prologue,tree);
  tree = ccom_pn_add_node(tree,epilogue);
  extraargs = ccom_revgchn(extraargs); /* not really necessary, but nicer */
  for (search=arglist;search!=NULL;search=search->nextp)
    {
      symbolp sym = &(search->data->symbol);
      if (ccom_ansi)
	ccom_declare(sym);
      else
	fprintf(ccom_ofile,"%s",sym->name);
      if (search->nextp != NULL)
	fprintf(ccom_ofile,", ");
    }
  fprintf(ccom_ofile,")\n");
  if (!ccom_ansi)
    {
      for (search=arglist;search!=NULL;search=search->nextp)
	{
	  symbolp sym = &(search->data->symbol);
	  ccom_declare(sym);
	  fprintf(ccom_ofile,";\n");
	}
    }
  fprintf(ccom_ofile,"{\n");
  ccom_print_sus();
  for (search=extraargs;search!=NULL;search=search->nextp)
    {
      fprintf(ccom_ofile,"  ");
      ccom_declare(&(search->data->symbol));
      fprintf(ccom_ofile,";\n");
    }
  ccom_dumpsymtab(0);
  fprintf(ccom_ofile,"\n");
  parse_emit(tree,2);
  fprintf(ccom_ofile,"}\n\n");

  /* Now generate the function invocation.  Note that I create the
     function symbol after the symbol table has already been dumped.
     Also, if !ccom_fortran, modify the scalars on the arglist so that
     their addresses are taken.  */
  sfname = ccom_malloc(1+strlen(funstr)+ccom_numstrlen(ccom_fnnum),0);
  sprintf(sfname,"%s%d",funstr,ccom_fnnum);
  funname = ccom_lookup_fun(sfname,CCOM_VOID);
  if (!ccom_fortran)
    {
      for (search=retarglist;search!=NULL;search=search->nextp)
	{
	  genericp arg = search->data;
	  if (arg->t == ccom_symbol && arg->symbol.ndim == 0)
	    {
	      search->data = EXPR(ccom_addr,arg,NULL);
	    }
	}
    }
  retval = ccom_mkfuncall(0,funname,retarglist);

  ccom_fnnum ++;
  return retval;
}

/* Passes an argument list to the given template, and parses and
   optimizes the necessary template files.  Produces a complete C
   function and returns the calling sequence as a genericp. */
genericp ccom_execute_tmpl(char *tmplname, gchnp arglist)
{
  struct parse_node *tree;

  /* Install an empty local and global symbol table. */
  ccom_init_global_symbols();
  ccom_set_local_tmplsym_table(NULL);
  ccom_clear_su();

  tree = ccom_parse_and_forward_pass(tmplname,arglist);

  clear_all_prop_fields();
  ccom_eliminate(tree);

  tree = ccom_hoist(tree);

  clear_all_prop_fields();
  de_tmplsym_tree(tree);
  return produce_function(tree);
}

/* Passes an argument list to the given template, and executes the
   control pass over the template.  The idea is that the given
   template just computes some value or values in the control pass,
   and no actual C code, and returns these values to the caller.  It
   returns a list of values returned by the template.  Note that an
   input value corresponds to a non-var template parameter, the output
   value will be unchanged. */
gchnp ccom_execute_control_tmpl(char *tmplname, gchnp arglist)
{
  struct parse_node *tree;
  char s[100];  /* enough space to hold "v%d" */
  gchnp search, newarglist, result;
  int i;
  genericp gsym;
  void *oldroot;

  /* Install an empty local and global symbol table. */
  /*ccom_init_global_symbols();*/
  oldroot = ccom_get_local_tmplsym_table();
  ccom_set_local_tmplsym_table(NULL);

  /* Construct some new variables and set their propagation values to
     be the arglist values. */
  newarglist = NULL;
  for (i=0,search=arglist;search!=NULL;i++,search=search->nextp)
    {
      sprintf(s,"v%d",i);
      gsym = ccom_lookuptmplsym_localonly(s,CCOM_INT,"<none>",-1);
      gsym->symbol.cprop = search->data;
      newarglist = cons3(0,gsym,newarglist);
    }
  newarglist = ccom_revgchn(newarglist);

  tree = ccom_parse_and_forward_pass(tmplname,newarglist);

  result = ccom_rebuild_list(newarglist);
  ccom_set_local_tmplsym_table(oldroot);

  return result;
}