las.c

/*
|| This file is part of Pike. For copyright information see COPYRIGHT.
|| Pike is distributed under GPL, LGPL and MPL. See the file COPYING
|| for more information.
|| $Id: las.c,v 1.434 2008/08/17 16:22:41 mast Exp $
*/

#include "global.h"
#include "interpret.h"
#include "las.h"
#include "array.h"
#include "object.h"
#include "stralloc.h"
#include "dynamic_buffer.h"
#include "lex.h"
#include "pike_types.h"
#include "constants.h"
#include "mapping.h"
#include "multiset.h"
#include "pike_error.h"
#include "docode.h"
#include "main.h"
#include "pike_memory.h"
#include "operators.h"
#include "callback.h"
#include "pike_macros.h"
#include "peep.h"
#include "builtin_functions.h"
#include "cyclic.h"
#include "opcodes.h"
#include "pikecode.h"
#include "gc.h"
#include "pike_compiler.h"
#include "block_alloc.h"

/* Define this if you want the optimizer to be paranoid about aliasing
 * effects to to indexing.
 */
/* #define PARANOID_INDEXING */

/* #define NEW_ARG_CHECK */

static node *eval(node *);
static void optimize(node *n);
static node *localopt(node *n);

int cumulative_parse_error=0;
extern char *get_type_name(int);

#define MAX_GLOBAL 2048

/* #define yywarning my_yyerror */

int car_is_node(node *n)
{
  if (!_CAR(n)) return 0;
  switch(n->token)
  {
  case F_EXTERNAL:
  case F_GET_SET:
  case F_IDENTIFIER:
  case F_TRAMPOLINE:
  case F_CONSTANT:
  case F_LOCAL:
  case F_THIS:
  case F_VERSION:
    return 0;

  default:
    return 1;
  }
}

int cdr_is_node(node *n)
{
  if (!_CDR(n)) return 0;
  switch(n->token)
  {
  case F_EXTERNAL:
  case F_GET_SET:
  case F_IDENTIFIER:
  case F_TRAMPOLINE:
  case F_CONSTANT:
  case F_LOCAL:
  case F_THIS:
  case F_VERSION:
    return 0;

  default:
    return 1;
  }
}

int node_is_leaf(node *n)
{
  switch(n->token)
  {
  case F_EXTERNAL:
  case F_GET_SET:
  case F_IDENTIFIER:
  case F_TRAMPOLINE:
  case F_CONSTANT:
  case F_LOCAL:
  case F_VERSION:
    return 1;
  }
  return 0;
}

#ifdef PIKE_DEBUG
void check_tree(node *n, int depth)
{
  node *orig_n = n;
  node *parent;

  if(!d_flag) return;

  if (!n) return;

  parent = n->parent;
  n->parent = NULL;

  while(n) {
    if(n->token==USHRT_MAX)
      Pike_fatal("Free node in tree.\n");

    switch(n->token)
    {
    case F_EXTERNAL:
    case F_GET_SET:
      if(n->type)
      {
	int parent_id = n->u.integer.a;
	int id_no = n->u.integer.b;
	struct program_state *state = Pike_compiler;
	while (state && (state->new_program->id != parent_id)) {
	  state = state->previous;
	}
	if (state && id_no != IDREF_MAGIC_THIS) {
	  struct identifier *id = ID_FROM_INT(state->new_program, id_no);
	  if (id) {
#if 0
#ifdef PIKE_DEBUG
	    /* FIXME: This test crashes on valid code because the type of the
	     * identifier can change in pass 2 - Hubbe
	     */
	    if(id->type != n->type)
	    {
	      fputs("Type of external node "
		    "is not matching its identifier.\nid->type: ",stderr);
	      simple_describe_type(id->type);
	      fputs("\nn->type : ", stderr);
	      simple_describe_type(n->type);
	      fputc('\n', stderr);

	      Pike_fatal("Type of external node is not matching its identifier.\n");
	    }
#endif
#endif
	  }
	}
      }
    }

    if(d_flag<2) break;

#ifdef PIKE_DEBUG
    if(!(depth & 1023))
    {
      node *q;
      for(q=n->parent;q;q=q->parent)
	if(q->parent==n)
	  Pike_fatal("Cyclic node structure found.\n");
    }
#endif

    if(car_is_node(n))
    {
      /* Update parent for CAR */
      CAR(n)->parent = n;
      depth++;
      n = CAR(n);
      continue;
    }

    if(cdr_is_node(n))
    {
      /* Update parent for CDR */
      CDR(n)->parent = n;
      depth++;
      n = CDR(n);
      continue;
    }

    while(n->parent &&
	  (!cdr_is_node(n->parent) || (CDR(n->parent) == n))) {
      /* Backtrack */
      n = n->parent;
      depth--;
    }

    if (n->parent && cdr_is_node(n->parent)) {
      /* Jump to the sibling */
      CDR(n->parent)->parent = n->parent;
      n = CDR(n->parent);
      continue;
    }
    break;
  }

  if (n != orig_n) {
    fputs("check_tree() lost track.\n", stderr);
    d_flag = 0;
    fputs("n:", stderr);
    print_tree(n);
    fputs("orig_n:", stderr);
    print_tree(orig_n);
    Pike_fatal("check_tree() lost track.\n");
  }
  n->parent = parent;
}
#endif

/* FIXME: Ought to use parent pointer to avoid recursion. */
INT32 count_args(node *n)
{
  int a,b;
  check_tree(n,0);

  fatal_check_c_stack(16384);

  if(!n) return 0;
  switch(n->token)
  {
  case F_COMMA_EXPR:
  case F_VAL_LVAL:
  case F_ARG_LIST:
    a=count_args(CAR(n));
    if(a==-1) return -1;
    b=count_args(CDR(n));
    if(b==-1) return -1;
    return a+b;

  case F_CAST:
    if(n->type == void_type_string)
      return 0;
    else
      return count_args(CAR(n));

  case F_SOFT_CAST:
    return count_args(CAR(n));

  case F_CASE:
  case F_CASE_RANGE:
  case F_FOR:
  case F_DO:
  case F_LOOP:
  case F_INC_LOOP:
  case F_DEC_LOOP:
  case F_DEC_NEQ_LOOP:
  case F_INC_NEQ_LOOP:
  case F_BREAK:
  case F_RETURN:
  case F_CONTINUE:
  case F_FOREACH:
    return 0;

  case '?':
  {
    int tmp1,tmp2;
    tmp1=count_args(CADR(n));
    tmp2=count_args(CDDR(n));
    if(tmp1==-1 || tmp2==-1) return -1;
    if(tmp1 < tmp2) return tmp1;
    return tmp2;
  }

  case F_PUSH_ARRAY:
    return -1;

  case F_APPLY:
    if(CAR(n)->token == F_CONSTANT &&
       CAR(n)->u.sval.type == T_FUNCTION &&
       CAR(n)->u.sval.subtype == FUNCTION_BUILTIN &&
       n->type == void_type_string)
      return 0;
    return 1;

  case F_RANGE_FROM_BEG:
  case F_RANGE_FROM_END:
    return 1;
  case F_RANGE_OPEN:
    return 0;

  default:
    if(n->type == void_type_string) return 0;
    return 1;
  }
}

/* FIXME: Ought to use parent pointer to avoid recursion. */
struct pike_type *find_return_type(node *n)
{
  struct pike_type *a, *b;

  check_tree(n,0);

  fatal_check_c_stack(16384);

  if(!n) return 0;

  optimize(n);

  if (n->token == F_RETURN) {
    if (CAR(n)) {
      if (CAR(n)->type) {
	copy_pike_type(a, CAR(n)->type);
      } else {
#ifdef PIKE_DEBUG
	if (l_flag > 2) {
	  fputs("Return with untyped argument.\n", stderr);
	  print_tree(n);
	}
#endif /* PIKE_DEBUG */
	copy_pike_type(a, mixed_type_string);
      }
    } else {
      copy_pike_type(a, zero_type_string);
    }
    return a;
  }

  if(!(n->tree_info & OPT_RETURN)) return 0;

  if(car_is_node(n))
    a=find_return_type(CAR(n));
  else
    a=0;

  if(cdr_is_node(n))
    b=find_return_type(CDR(n));
  else
    b=0;

  if(a)
  {
    if(b) {
      if (a != b) {
	struct pike_type *res = or_pike_types(a, b, 1);
	free_type(a);
	free_type(b);
	return res;
      }
      free_type(b);
    }
    return a;
  }
  return b;
}

int check_tailrecursion(void)
{
  int e;
  if (Pike_compiler->compiler_frame->lexical_scope & SCOPE_SCOPE_USED) {
    /* There might be a lambda around that has references to the old context
     * in which case we can't reuse it with a tail-recursive call.
     */
    return 0;
  }
  if(debug_options & NO_TAILRECURSION) return 0;
  for(e=0;e<Pike_compiler->compiler_frame->max_number_of_locals;e++)
  {
    if(!pike_type_allow_premature_toss(
      Pike_compiler->compiler_frame->variable[e].type))
      return 0;
  }
  return 1;
}

static int check_node_type(node *n, struct pike_type *t, const char *msg)
{
  if (pike_types_le(n->type, t)) return 1;
  if (!match_types(n->type, t)) {
    yytype_report(REPORT_ERROR, NULL, 0, t, NULL, 0, n->type, 0, msg);
    return 0;
  }
  if (THIS_COMPILATION->lex.pragmas & ID_STRICT_TYPES) {
    yytype_report(REPORT_WARNING, NULL, 0, t, NULL, 0, n->type, 0, msg);
  }
  if (runtime_options & RUNTIME_CHECK_TYPES) {
    node *p = n->parent;
    if (CAR(p) == n) {
      (_CAR(p) = mksoftcastnode(t, n))->parent = p;
    } else if (CDR(p) == n) {
      (_CDR(p) = mksoftcastnode(t, n))->parent = p;
    } else {
      yywarning("Failed to find place to insert soft cast.");
    }
  }
  return 1;
}

#undef BLOCK_ALLOC_NEXT
#define BLOCK_ALLOC_NEXT u.node.a

#undef PRE_INIT_BLOCK
#define PRE_INIT_BLOCK(NODE) do {					\
    NODE->token = USHRT_MAX;						\
  } while (0)

BLOCK_ALLOC_FILL_PAGES(node_s, 2)

#define NODES (sizeof (((struct node_s_block *) NULL)->x) / sizeof (struct node_s))

#undef BLOCK_ALLOC_NEXT
#define BLOCK_ALLOC_NEXT next

void free_all_nodes(void)
{
  if(!Pike_compiler->previous)
  {
    node *tmp;
    struct node_s_block *tmp2;
    size_t e=0;

#ifndef PIKE_DEBUG
    if(cumulative_parse_error)
    {
#endif
      
      for(tmp2=node_s_blocks;tmp2;tmp2=tmp2->next) e+=tmp2->used;
      if(e)
      {
        size_t e2=e;
	struct node_s_block *nextblk;
	for(tmp2=node_s_blocks;tmp2;tmp2=nextblk)
	{
	  int n = tmp2->used;
	  nextblk = tmp2->next;
	  /* We want to be able to access the token field of all
	   * the blocks...
	   */
	  PIKE_MEM_RW(tmp2->x);
	  for(e=0;n && e<NODES;e++)
	  {
	    if (tmp2->x[e].token != USHRT_MAX)
	    {
	      tmp=tmp2->x+e;
#ifdef PIKE_DEBUG
	      if(!cumulative_parse_error)
	      {
		fprintf(stderr,"Free node at %p, (%s:%d) (token=%d).\n",
			(void *)tmp, tmp->current_file->str, tmp->line_number,
			tmp->token);

		debug_malloc_dump_references(tmp,0,2,0);

		if(tmp->token==F_CONSTANT)
		  print_tree(tmp);
	      }
	      /* else */
#endif
	      {
		/* Free the node and be happy */
		/* Make sure we don't free any nodes twice */
		if(car_is_node(tmp)) _CAR(tmp)=0;
		if(cdr_is_node(tmp)) _CDR(tmp)=0;
#ifdef PIKE_DEBUG
		if (l_flag > 3) {
		  fprintf(stderr, "Freeing node that had %d refs.\n",
			  tmp->refs);
		}
#endif /* PIKE_DEBUG */
		/* Force the node to be freed. */
		tmp->refs = 1;
		debug_malloc_touch(tmp->type);
		free_node(tmp);
		--n;
	      }
	    }
	  }
	}
#ifdef PIKE_DEBUG
	if(!cumulative_parse_error)
	  Pike_fatal("Failed to free %"PRINTSIZET"d nodes when compiling!\n",e2);
#endif
      }
#ifndef PIKE_DEBUG
    }
#endif
    free_all_node_s_blocks();
    cumulative_parse_error=0;
  }
}

void debug_free_node(node *n)
{
  if(!n) return;

  if (sub_ref(n)) {
#ifdef PIKE_DEBUG
    if(l_flag>9)
      print_tree(n);
#endif /* PIKE_DEBUG */
    return;
  }

  n->parent = NULL;

  do {
#ifdef PIKE_DEBUG
   if(l_flag>9)
      print_tree(n);
#endif /* PIKE_DEBUG */

    debug_malloc_touch(n);

#ifdef PIKE_DEBUG
    if (n->refs) {
      Pike_fatal("Node with refs left about to be killed: %8p\n", n);
    }
#endif /* PIKE_DEBUG */

    switch(n->token)
    {
    case USHRT_MAX:
      Pike_fatal("Freeing node again!\n");
      break;

    case F_CONSTANT:
      free_svalue(&(n->u.sval));
      break;
    }

    if (car_is_node(n)) {
      /* Free CAR */

      if (sub_ref(_CAR(n))) {
	_CAR(n) = NULL;
      } else {
	_CAR(n)->parent = n;
	n = _CAR(n);
	_CAR(n->parent) = NULL;
	continue;
      }
    }
    if (cdr_is_node(n)) {
      /* Free CDR */

      if (sub_ref(_CDR(n))) {
	_CDR(n) = NULL;
      } else {
	_CDR(n)->parent = n;
	n = _CDR(n);
	_CDR(n->parent) = NULL;
	continue;
      }
    }
  backtrack:
    while (n->parent && !cdr_is_node(n->parent)) {
      /* Kill the node and backtrack */
      node *dead = n;

#ifdef PIKE_DEBUG
      if (dead->refs) {
	print_tree(dead);
	Pike_fatal("Killed node %p (%d) still has refs: %d\n",
		   dead, dead->token, dead->refs);
      }
#endif /* PIKE_DEBUG */

      n = n->parent;

      if(dead->type) free_type(dead->type);
      if(dead->name) free_string(dead->name);
      if(dead->current_file) free_string(dead->current_file);
      dead->token=USHRT_MAX;
      really_free_node_s(dead);
    }
    if (n->parent && cdr_is_node(n->parent)) {
      /* Kill node and jump to the sibling. */
      node *dead = n;

#ifdef PIKE_DEBUG
      if (dead->refs) {
	Pike_fatal("Killed node %p still has refs: %d\n", dead, dead->refs);
      }
#endif /* PIKE_DEBUG */

      n = n->parent;
      if(dead->type) free_type(dead->type);
      if(dead->name) free_string(dead->name);
      if(dead->current_file) free_string(dead->current_file);
      dead->token=USHRT_MAX;
      really_free_node_s(dead);

      if (sub_ref(_CDR(n))) {
	_CDR(n) = NULL;
	goto backtrack;
      } else {
	_CDR(n)->parent = n;
	n = _CDR(n);
	_CDR(n->parent) = NULL;
	continue;
      }
    }

    /* Kill root node. */

#ifdef PIKE_DEBUG
    if (n->refs) {
      Pike_fatal("Killed node %p still has refs: %d\n", n, n->refs);
    }
#endif /* PIKE_DEBUG */

    if(n->type) free_type(n->type);
    if(n->name) free_string(n->name);
    if(n->current_file) free_string(n->current_file);

    n->token=USHRT_MAX;
    really_free_node_s(n);
    break;
  } while (n->parent);
}


/* here starts routines to make nodes */
static node *debug_mkemptynode(void)
{
  node *res=alloc_node_s();

  CHECK_COMPILER();

#ifdef __CHECKER__
  MEMSET(res, 0, sizeof(node));
#endif /* __CHECKER__ */

  res->refs = 0;
  add_ref(res);	/* For DMALLOC... */
  res->token=0;
  res->line_number=THIS_COMPILATION->lex.current_line;
  copy_shared_string(res->current_file, THIS_COMPILATION->lex.current_file);
  res->type=0;
  res->name=0;
  res->node_info=0;
  res->tree_info=0;
  res->parent=0;
  return res;
}

#define mkemptynode()	dmalloc_touch(node *, debug_mkemptynode())


static int is_automap_arg_list(node *n)
{
  if(!n) return 0;
  switch(n->token)
  {
    default: return 0;
    case F_ARG_LIST:
      return is_automap_arg_list(CAR(n)) ||
	is_automap_arg_list(CDR(n));

    case F_AUTO_MAP_MARKER: return 1;
  }
}


node *debug_mknode(int token, node *a, node *b)
{
  node *res;

  switch(token)
  {
    case F_APPLY:
      if(is_automap_arg_list(b))
	token=F_AUTO_MAP;
      break;

    case F_INDEX:
      switch((is_automap_arg_list(a) << 1) |
	     is_automap_arg_list(b))
      {
	case 1:
	  res=mkefuncallnode("rows",mknode(F_ARG_LIST,a,copy_node(CAR(b))));
	  free_node(b);
	  return res;

	case 2:
	  res=mkefuncallnode("column",mknode(F_ARG_LIST,copy_node(CAR(a)),b));
	  free_node(a);
	  return res;

	case 3:
	  return mkefuncallnode("`[]",mknode(F_ARG_LIST,a,b));
      }
      break;

#ifdef PIKE_DEBUG
    case F_CAST:
    case F_SOFT_CAST:
      Pike_fatal("Attempt to create a cast-node with mknode()!\n");
    case F_CONSTANT:
      Pike_fatal("Attempt to create an F_CONSTANT-node with mknode()!\n");
    case F_LOCAL:
      Pike_fatal("Attempt to create an F_LOCAL-node with mknode()!\n");
    case F_IDENTIFIER:
      Pike_fatal("Attempt to create an F_IDENTIFIER-node with mknode()!\n");
    case F_TRAMPOLINE:
      Pike_fatal("Attempt to create an F_TRAMPOLINE-node with mknode()!\n");
    case F_EXTERNAL:
      Pike_fatal("Attempt to create an F_EXTERNAL-node with mknode()!\n");
    case F_GET_SET:
      Pike_fatal("Attempt to create an F_GET_SET-node with mknode()!\n");
#endif /* PIKE_DEBUG */
  }

  check_tree(a,0);
  check_tree(b,0);

  res = mkemptynode();
  _CAR(res) = dmalloc_touch(node *, a);
  _CDR(res) = dmalloc_touch(node *, b);
  if(a) {
    a->parent = res;
  }
  if(b) {
    b->parent = res;
  }

  res->token = token;
  res->type = 0;

  switch(token)
  {
  case F_CATCH:
    res->node_info |= OPT_SIDE_EFFECT;
    if (a) {
      res->tree_info |= a->tree_info & ~OPT_BREAK;
    }
    break;

  case F_AUTO_MAP:
  case F_APPLY:
    {
      unsigned INT16 opt_flags = OPT_SIDE_EFFECT | OPT_EXTERNAL_DEPEND;
      struct identifier *i = NULL;

      if (a) {
	switch(a->token) {
	case F_CONSTANT:
	  switch(a->u.sval.type)
	  {
	    case T_FUNCTION:
	      if (a->u.sval.subtype == FUNCTION_BUILTIN)
	      {
		opt_flags = a->u.sval.u.efun->flags;
	      } else if (a->u.sval.u.object->prog) {
		i = ID_FROM_INT(a->u.sval.u.object->prog, a->u.sval.subtype);
	      } else {
		yyerror("Calling function in destructed module.");
	      }
	      break;

	    case T_PROGRAM:
	      if(a->u.sval.u.program->flags & PROGRAM_CONSTANT) {
		opt_flags=0;
	      }
	      if (a->u.sval.u.program->flags & PROGRAM_USES_PARENT) {
		yyerror("Can not clone program without parent context.");
	      }
	      break;
	  }
	  break;
	case F_EXTERNAL:
	case F_GET_SET:
	  if (a->u.integer.b != IDREF_MAGIC_THIS) {
	    struct program_state *state = Pike_compiler;
	    int program_id = a->u.integer.a;
	    while (state && (state->new_program->id != program_id)) {
	      state = state->previous;
	    }
	    if (state) {
	      i = ID_FROM_INT(state->new_program, a->u.integer.b);
	    } else {
	      yyerror("Parent has left.");
	    }
	  }
	  break;
	case F_LOCAL:
	  /* FIXME: Should lookup functions in the local scope. */
	default:
	  res->tree_info |= a->tree_info;
	}
	if (i && IDENTIFIER_IS_FUNCTION(i->identifier_flags)) {
	  res->node_info |= i->opt_flags;
	} else {
	  res->node_info |= opt_flags;
	}
      } else {
	res->node_info |= opt_flags;
      }
      res->node_info |= OPT_APPLY;
      if(b) res->tree_info |= b->tree_info;
    }
    break;

  case F_POP_VALUE:
    copy_pike_type(res->type, void_type_string);
    
    if(a) res->tree_info |= a->tree_info;
    if(b) res->tree_info |= b->tree_info;
    break;

  case F_MAGIC_SET_INDEX:
    res->node_info |= OPT_ASSIGNMENT;
    /* FALL_THROUGH */
  case F_MAGIC_INDEX:
  case F_MAGIC_INDICES:
  case F_MAGIC_VALUES:
  {
    int e;
    struct program_state *state = Pike_compiler;
    res->node_info |= OPT_EXTERNAL_DEPEND;
    if (!b) break;	/* Paranoia; probably compiler error. */
    for(e=0;e<b->u.sval.u.integer;e++)
    {
      state->new_program->flags |= PROGRAM_USES_PARENT | PROGRAM_NEEDS_PARENT;
      state=state->previous;
    }
      
    break;
  }

  case F_UNDEFINED:
    res->node_info |= OPT_EXTERNAL_DEPEND | OPT_SIDE_EFFECT;
    break;

  case F_RETURN:
    res->node_info |= OPT_RETURN;
    break;

  case F_BREAK:
    res->node_info |= OPT_BREAK;
    break;

  case F_CONTINUE:
    res->node_info |= OPT_CONTINUE;
    break;

  case F_DEFAULT:
  case F_CASE:
  case F_CASE_RANGE:
    res->node_info |= OPT_CASE;
    break;

  case F_INC_LOOP:
  case F_INC_NEQ_LOOP:
  case F_DEC_LOOP:
  case F_DEC_NEQ_LOOP:
    res->node_info |= OPT_ASSIGNMENT;
    if (a) {
      res->tree_info |= a->tree_info;
    }
    if (b) {
      res->tree_info |= (b->tree_info & ~(OPT_BREAK|OPT_CONTINUE));
    }
    break;

  case F_SSCANF:
    if(!b || count_args(b) == 0) break;
    res->node_info |= OPT_ASSIGNMENT;
    break;

  case F_APPEND_ARRAY:
  case F_MULTI_ASSIGN:
  case F_ASSIGN:
  case F_MOD_EQ:
  case F_AND_EQ:
  case F_MULT_EQ:
  case F_ADD_EQ:
  case F_SUB_EQ:
  case F_DIV_EQ:
  case F_LSH_EQ:
  case F_RSH_EQ:
  case F_XOR_EQ:
  case F_OR_EQ:
    res->node_info |= OPT_ASSIGNMENT;
    if (a) {
      res->tree_info |= a->tree_info;
    }
    if (b) {
      res->tree_info |= b->tree_info;
    }
    break;

  case F_INC:
  case F_DEC:
  case F_POST_INC:
  case F_POST_DEC:
    res->node_info |= OPT_ASSIGNMENT;
    if (a) {
      res->tree_info |= a->tree_info;
    }
    break;

  case ':':
  case F_RANGE_FROM_BEG:
  case F_RANGE_FROM_END:
  case F_RANGE_OPEN:
    res->node_info |= OPT_FLAG_NODE;
    break;

  default:
    if(a) res->tree_info |= a->tree_info;
    if(b) res->tree_info |= b->tree_info;
  }

  /* We try to optimize most things, but argument lists are hard... */
  if((token != F_ARG_LIST) && (a || b))
    res->node_info |= OPT_TRY_OPTIMIZE;

  res->tree_info |= res->node_info;

#ifdef PIKE_DEBUG
  if(d_flag > 3)
    verify_shared_strings_tables();
#endif

  check_tree(res,0);

#ifdef PIKE_DEBUG
  if(d_flag > 3)
    verify_shared_strings_tables();
#endif

  return res;
}

node *debug_mkstrnode(struct pike_string *str)
{
  node *res = mkemptynode();
  res->token = F_CONSTANT;
  res->u.sval.type = T_STRING;
#ifdef __CHECKER__
  res->u.sval.subtype = 0;
#endif
  copy_shared_string(res->u.sval.u.string, str);
  res->type = get_type_of_svalue(&res->u.sval);
  res->tree_info = OPT_SAFE;
  return res;
}

node *debug_mkintnode(INT_TYPE nr)
{
  node *res = mkemptynode();
  res->token = F_CONSTANT;
  res->u.sval.type = T_INT;
  res->u.sval.subtype = NUMBER_NUMBER;
  res->u.sval.u.integer = nr;
  res->type=get_type_of_svalue( & res->u.sval);
  res->tree_info = OPT_SAFE;

  return res;
}

node *debug_mknewintnode(INT_TYPE nr)
{
  node *res = mkemptynode();
  res->token = F_CONSTANT;
  res->u.sval.type = T_INT;
  res->u.sval.subtype = NUMBER_NUMBER;
  res->u.sval.u.integer = nr;
  res->type=get_type_of_svalue( & res->u.sval);
  res->tree_info = OPT_SAFE;
  return res;
}

node *debug_mkfloatnode(FLOAT_TYPE foo)
{
  node *res = mkemptynode();
  res->token = F_CONSTANT;
  copy_pike_type(res->type, float_type_string);
  res->u.sval.type = T_FLOAT;
#ifdef __CHECKER__
  res->u.sval.subtype = 0;
#endif
  res->u.sval.u.float_number = foo;
  res->tree_info = OPT_SAFE;

  return res;
}


node *debug_mkprgnode(struct program *p)
{
  struct svalue s;
  s.u.program=p;
  s.type = T_PROGRAM;
#ifdef __CHECKER__
  s.subtype = 0;
#endif
  return mkconstantsvaluenode(&s);
}

node *debug_mkapplynode(node *func,node *args)
{
  return mknode(F_APPLY, func, args);
}

node *debug_mkefuncallnode(char *function, node *args)
{
  struct pike_string *name;
  node *n;
  /* Force resolving since we don't want to get tangled up in the
   * placeholder object here. The problem is really that the
   * placeholder purport itself to contain every identifier, which
   * makes it hide the real ones in find_module_identifier. This
   * kludge will fail if the class being placeholded actually contains
   * these identifiers, but then again I think it's a bit odd in the
   * first place to look up these efuns in the module being compiled.
   * Wouldn't it be better if this function consulted
   * compiler_handler->get_default_module? /mast */
  int orig_flags;
  SET_FORCE_RESOLVE(orig_flags);
  name = findstring(function);
  if(!name || !(n=find_module_identifier(name,0)))
  {
    UNSET_FORCE_RESOLVE(orig_flags);
    my_yyerror("Internally used efun undefined: %s",function);
    return mkintnode(0);
  }
  UNSET_FORCE_RESOLVE(orig_flags);
  n = mkapplynode(n, args);
  return n;
}

node *debug_mkopernode(char *oper_id, node *arg1, node *arg2)
{
  if(arg1 && arg2)
    arg1=mknode(F_ARG_LIST,arg1,arg2);

  return mkefuncallnode(oper_id, arg1);
}

node *debug_mkversionnode(int major, int minor)
{
  node *res = mkemptynode();
  res->token = F_VERSION;
#ifdef __CHECKER__
  _CDR(res) = 0;
#endif
  res->u.integer.a = major;
  res->u.integer.b = minor;
  return res;
}

node *debug_mklocalnode(int var, int depth)
{
  struct compiler_frame *f;
  int e;
  node *res = mkemptynode();
  res->token = F_LOCAL;

  f=Pike_compiler->compiler_frame;
  for(e=0;e<depth;e++) f=f->previous;
  copy_pike_type(res->type, f->variable[var].type);

  res->node_info = OPT_NOT_CONST;
  res->tree_info = res->node_info;
#ifdef __CHECKER__
  _CDR(res) = 0;
#endif
  res->u.integer.a = var;
  if (depth < 0) {
    /* First appearance of this variable.
     * Add initialization code.
     */
    res->node_info |= OPT_ASSIGNMENT;
    res->u.integer.b = 0;
  } else {
    res->u.integer.b = depth;
  }

  return res;
}

node *debug_mkidentifiernode(int i)
{
#if 1
  node *res = mkexternalnode(Pike_compiler->new_program, i);
  check_tree(res,0);
  return res;
#else
  node *res = mkemptynode();
  res->token = F_IDENTIFIER;
  copy_shared_string(res->type, ID_FROM_INT(Pike_compiler->new_program, i)->type);

  /* FIXME */
  if(IDENTIFIER_IS_CONSTANT(ID_FROM_INT(Pike_compiler->new_program, i)->identifier_flags))
  {
    res->node_info = OPT_EXTERNAL_DEPEND;
  }else{
    res->node_info = OPT_NOT_CONST;
  }
  res->tree_info=res->node_info;

#ifdef __CHECKER__
  _CDR(res) = 0;
#endif
  res->u.id.number = i;
#ifdef SHARED_NODES
  res->u.id.prog = Pike_compiler->new_program;
#endif /* SHARED_NODES */

  check_tree(res,0);
  return res;
#endif
}

node *debug_mktrampolinenode(int i, struct compiler_frame *frame)
{
  struct compiler_frame *f;
  node *res = mkemptynode();

  res->token = F_TRAMPOLINE;
  copy_pike_type(res->type, ID_FROM_INT(Pike_compiler->new_program, i)->type);

  /* FIXME */
  if(IDENTIFIER_IS_CONSTANT(ID_FROM_INT(Pike_compiler->new_program, i)->identifier_flags))
  {
    res->node_info = OPT_EXTERNAL_DEPEND;
  }else{
    res->node_info = OPT_NOT_CONST;
  }
  res->tree_info=res->node_info;

#ifdef __CHECKER__
  _CDR(res) = 0;
#endif
  res->u.trampoline.ident=i;
  res->u.trampoline.frame=frame;
  
  for(f=Pike_compiler->compiler_frame;f != frame;f=f->previous)
    f->lexical_scope|=SCOPE_SCOPED;
  f->lexical_scope|=SCOPE_SCOPE_USED;

#ifdef SHARED_NODES
  res->u.trampoline.prog = Pike_compiler->new_program;
#endif /* SHARED_NODES */

  check_tree(res,0);
  return res;
}

node *debug_mkexternalnode(struct program *parent_prog, int i)
{
#if 0
  return mkidentifiernode(add_ext_ref(Pike_compiler, parent_prog, i));

#else /* !0 */
  struct program_state *state;
  node *res = mkemptynode();
  res->token = F_EXTERNAL;

  if (i == IDREF_MAGIC_THIS) {
    type_stack_mark();
    push_object_type (0, parent_prog->id);
    res->type = pop_unfinished_type();
    res->node_info = OPT_NOT_CONST;
    Pike_compiler->compiler_frame->opt_flags |= OPT_EXTERNAL_DEPEND;
  }
  else {
    struct identifier *id = ID_FROM_INT(parent_prog, i);
#ifdef PIKE_DEBUG
    if(d_flag)
    {
      check_type_string(id->type);
      check_string(id->name);
    }
#endif

    /* Mark the identifier reference as used. */
    PTR_FROM_INT(parent_prog, i)->id_flags |= ID_USED;

    copy_pike_type(res->type, id->type);

    /* FIXME */
    if(IDENTIFIER_IS_CONSTANT(id->identifier_flags))
    {
      res->node_info = OPT_EXTERNAL_DEPEND;
    }else{
      res->node_info = OPT_NOT_CONST;
      if (IDENTIFIER_IS_VARIABLE(id->identifier_flags) &&
	  (id->run_time_type == PIKE_T_GET_SET)) {
	/* Special case of F_EXTERNAL for ease of detection. */
	res->token = F_GET_SET;
      }
    }
    if (i) {
      Pike_compiler->compiler_frame->opt_flags |= OPT_EXTERNAL_DEPEND;
    }
  }
  res->tree_info = res->node_info;

#ifdef __CHECKER__
  _CDR(res) = 0;
#endif
  res->u.integer.a = parent_prog->id;
  res->u.integer.b = i;

  /* Bzot-i-zot */
  state = Pike_compiler;
  while(parent_prog != state->new_program)
  {
    state->new_program->flags |= PROGRAM_USES_PARENT | PROGRAM_NEEDS_PARENT;
    state=state->previous;
  }

  return res;
#endif /* 0 */
}

node *debug_mkthisnode(struct program *parent_prog, int inherit_num)
{
  struct program_state *state;
  node *res;

#ifdef PIKE_DEBUG
  if ((inherit_num < -1) || (inherit_num > 65535)) {
    Pike_fatal("This is bad: %p, %d\n", parent_prog, inherit_num);
  }
#endif /* PIKE_DEBUG */

  res = mkemptynode();
  res->token = F_THIS;
  type_stack_mark();
  if (inherit_num >= 0) {
    push_object_type(1, parent_prog->inherits[inherit_num].prog->id);
  } else {
    push_object_type(0, parent_prog->id);
  }
  res->type = pop_unfinished_type();
  res->tree_info = res->node_info = OPT_NOT_CONST;

#ifdef __CHECKER__
  _CDR(res) = 0;
#endif
  res->u.integer.a = parent_prog->id;
  res->u.integer.b = inherit_num;

  /* Bzot-i-zot */
  state = Pike_compiler;
  while(parent_prog != state->new_program)
  {
    state->new_program->flags |= PROGRAM_USES_PARENT | PROGRAM_NEEDS_PARENT;
    state=state->previous;
  }

  return res;
}

node *debug_mkcastnode(struct pike_type *type, node *n)
{
  node *res;

  if(!n) return 0;

#ifdef PIKE_DEBUG
  if (!type) {
    Pike_fatal("Casting to no type!\n");
  }
#endif /* PIKE_DEBUG */

  if (type == void_type_string) return mknode(F_POP_VALUE, n, 0);

#if 0
  /* It's not always safe to ignore the cast in this case. E.g. if n
   * has type program, the value can contain a function style program
   * pointer which the cast will turn into a real program
   * reference. */
  if(type==n->type) return n;
#endif

  res = mkemptynode();
  res->token = F_CAST;

  /* FIXME: Consider strengthening the node type [bug 4435].
   *        E.g. the cast in the code
   *
   *          mapping(string:string) m = (["a":"A", "b":"B"]);
   *          return (array)m;
   *
   *        should have a result type of array(array(string)),
   *        rather than array(mixed).
   */     
  copy_pike_type(res->type, type);

  if(match_types(object_type_string, type) ||
     match_types(program_type_string, type))
    res->node_info |= OPT_SIDE_EFFECT;

  res->tree_info |= n->tree_info;

  _CAR(res) = n;
  _CDR(res) = mktypenode(type);

  n->parent = res;

  return res;
}

node *debug_mksoftcastnode(struct pike_type *type, node *n)
{
  node *res;
  struct pike_type *result_type = NULL;

  if(!n) return 0;

#ifdef PIKE_DEBUG
  if (!type) {
    Pike_fatal("Soft cast to no type!\n");
  }
#endif /* PIKE_DEBUG */

  if (Pike_compiler->compiler_pass == 2) {
    if (type == void_type_string) {
      yywarning("Soft cast to void.");
      return mknode(F_POP_VALUE, n, 0);
    }

    if(type==n->type) {
      struct pike_string *t1 = describe_type(type);
      yywarning("Soft cast to %S is a noop.", t1);
      free_string(t1);
      return n;
    }

    if (n->type) {
#ifdef NEW_ARG_CHECK
      if (!(result_type = soft_cast(type, n->type, 0))) {
	ref_push_type_value(n->type);
	ref_push_type_value(type);
	yytype_report(REPORT_ERROR,
		      NULL, 0, NULL,
		      NULL, 0, NULL,
		      2, "Soft cast of %O to %O isn't a valid cast.");
      } else if (result_type == n->type) {
	ref_push_type_value(n->type);
	ref_push_type_value(type);
	yytype_report(REPORT_WARNING,
		      NULL, 0, NULL,
		      NULL, 0, NULL,
		      2, "Soft cast of %O to %O is a noop.");
      }
#else /* !NEW_ARG_CHECK */
      if (!check_soft_cast(type, n->type)) {
	ref_push_type_value(type);
	ref_push_type_value(n->type);
	yytype_report(REPORT_WARNING,
		      NULL, 0, NULL,
		      NULL, 0, NULL,
		      2, "Soft cast to %S isn't a restriction of %S.");
      }
      /* FIXME: check_soft_cast() is weaker than pike_types_le()
       * The resulting type should probably be the and between the old
       * and the new type.
       */
#endif
    }
  }

  res = mkemptynode();
  res->token = F_SOFT_CAST;
  if (result_type) {
    res->type = result_type;
  } else {
    copy_pike_type(res->type, type);
  }

  res->tree_info |= n->tree_info;

  _CAR(res) = n;
  _CDR(res) = mktypenode(type);

  n->parent = res;

  return res;
}

void resolv_constant(node *n)
{
  struct identifier *i;
  struct program *p;
  INT32 numid;

  check_tree(n,0);

  if(!n)
  {
    push_int(0);
  }else{
    switch(n->token)
    {
    case F_CONSTANT:
      push_svalue(& n->u.sval);
      return;

    case F_EXTERNAL:
    case F_GET_SET:
      if (n->u.integer.b == IDREF_MAGIC_THIS) {
	yyerror ("Expected constant, got reference to this");
	push_int (0);
	return;
      }

      else {
	struct program_state *state = Pike_compiler;
	while (state && (state->new_program->id != n->u.integer.a)) {
	  state = state->previous;
	}
	if(!state)
	{
	  yyerror("Failed to resolve external constant.");
	  push_int(0);
	  return;
	}
	p = state->new_program;
	numid=n->u.integer.b;
      }
      break;

    case F_IDENTIFIER:
      p=Pike_compiler->new_program;
      numid=n->u.id.number;
      break;

    case F_LOCAL:
      /* FIXME: Ought to have the name of the identifier in the message. */
      yyerror("Expected constant, got local variable.");
      push_int(0);
      return;

    case F_GLOBAL:
      /* FIXME: Ought to have the name of the identifier in the message. */
      yyerror("Expected constant, got global variable.");
      push_int(0);
      return;

    case F_UNDEFINED:
      if(Pike_compiler->compiler_pass==2) {
	/* FIXME: Ought to have the name of the identifier in the message. */
	yyerror("Expected constant, got undefined identifier.");
      }
      push_int(0);
      return;

    default:
    {
      if(is_const(n))
      {
	ptrdiff_t args=eval_low(n,1);
	if(args==1) return;

	if(args!=-1)
	{
	  if(!args)
	  {
	    yyerror("Expected constant, got void expression.");
	  }else{
	    yyerror("Possible internal error!!!");
	    pop_n_elems(DO_NOT_WARN(args-1));
	    return;
	  }
	} else {
	  yyerror("Failed to evaluate constant expression.");
	}
      } else {
	yyerror("Expected constant expression.");
      }
      push_int(0);
      return;
    }
    }

    i=ID_FROM_INT(p, numid);
    
    /* Warning:
     * This code doesn't produce function pointers for class constants,
     * which can be harmful...
     * /Hubbe
     */
    if(IDENTIFIER_IS_CONSTANT(i->identifier_flags))
    {
      if(i->func.offset != -1)
      {
	push_svalue(&PROG_FROM_INT(p, numid)->constants[i->func.offset].sval);
      }else{
	if(Pike_compiler->compiler_pass!=1)
	  yyerror("Constant is not defined yet.");
	push_int(0);
      }
    }else{
      my_yyerror("Identifier %S is not a constant", i->name);
      push_int(0);
    }
  }
}

/* Leaves a function or object on the stack */
void resolv_class(node *n)
{
  check_tree(n,0);

  resolv_constant(n);
  switch(Pike_sp[-1].type)
  {
    case T_OBJECT:
      if(!Pike_sp[-1].u.object->prog)
      {
	pop_stack();
	push_int(0);
      }else{
	f_object_program(1);
      }
      break;

    default:
      if (Pike_compiler->compiler_pass!=1)
	yyerror("Illegal program identifier");
      pop_stack();
      push_int(0);
      
    case T_FUNCTION:
    case T_PROGRAM:
      break;
  }
}

/* This one always leaves a program if possible */
void resolv_program(node *n)
{
  check_tree(n,0);

  resolv_class(n);
  switch(Pike_sp[-1].type)
  {
    case T_FUNCTION:
      if(program_from_function(Pike_sp-1))
	break;
      
    default:
      if (Pike_compiler->compiler_pass!=1)
	yyerror("Illegal program identifier");
      pop_stack();
      push_int(0);
      
    case T_PROGRAM:
      break;
  }
}

node *index_node(node *n, char *node_name, struct pike_string *id)
{
  node *ret;
  JMP_BUF tmp;

  check_tree(n,0);

  if (!is_const(n) && !TEST_COMPAT(7, 6)) {
    /* Index dynamically. */
    return mknode(F_INDEX, copy_node(n), mkstrnode(id));
  }

  if(SETJMP(tmp))
  {
    if (node_name) {
      handle_compile_exception ("Couldn't index module %s.", node_name);
    } else {
      handle_compile_exception ("Couldn't index module.");
    }
  }else{
    resolv_constant(n);
    switch(Pike_sp[-1].type)
    {
    case T_INT:
      if (!Pike_sp[-1].u.integer) {
	if(!Pike_compiler->num_parse_error) {
	  if (node_name) {
	    my_yyerror("Failed to index module %s with '%S'. "
		       "(Module doesn't exist?)",
		       node_name, id);
	  } else {
	    my_yyerror("Failed to index module with '%S'. "
		       "(Module doesn't exist?)",
		       id);
	  }
	}
	break;
      }
      /* Fall through. */

    case T_FLOAT:
    case T_STRING:
    case T_ARRAY:
      if (node_name) {
	my_yyerror("Failed to index module %s, got %s. (Not a module?)",
		   node_name, get_name_of_type (Pike_sp[-1].type));
      } else {
	my_yyerror("Failed to index a module, got %s. (Not a module?)",
		   get_name_of_type (Pike_sp[-1].type));
      }
      pop_stack();
      push_int(0);
      break;

    case T_OBJECT:
    case T_PROGRAM:
      if(!(Pike_compiler->new_program->flags & PROGRAM_PASS_1_DONE))
      {
	struct program *p;
	if(Pike_sp[-1].type == T_OBJECT)
	  p=Pike_sp[-1].u.object->prog;
	else
	  p=Pike_sp[-1].u.program;

	if(p && !(p->flags & PROGRAM_PASS_1_DONE))
	{
	  if(report_compiler_dependency(p))
	  {
	    pop_stack();
#if 0
	    fprintf(stderr, "Placeholder deployed for %p when indexing ", p);
	    print_tree(n);
	    fprintf(stderr, "with %s\n", id->str);
#endif
	    ref_push_object(placeholder_object);
	    break;
	  }
	}
      }

    default:
    {
      ptrdiff_t c;
      DECLARE_CYCLIC();
      c = PTR_TO_INT(BEGIN_CYCLIC(Pike_sp[-1].u.refs, id));
      if(c>1)
      {
	my_yyerror("Recursive module dependency when indexing with '%S'.", id);
	pop_stack();
	push_int(0);
      }else{
	volatile int exception = 0;
	SET_CYCLIC_RET(c+1);
	ref_push_string(id);
	{
	  JMP_BUF recovery;
	  STACK_LEVEL_START(2);
	  if (SETJMP_SP(recovery, 2)) {
	    if (node_name) {
	      handle_compile_exception ("Error looking up '%S' in module %s.",
					id, node_name);
	    } else {
	      handle_compile_exception ("Error looking up '%S' in module.",
					id);
	    }
	    push_undefined();
	    exception = 1;
	  } else {
	    f_index(2);
	  }
	  STACK_LEVEL_DONE(1);
	  UNSETJMP(recovery);
	}
      
	if(Pike_sp[-1].type == T_INT &&
	   !Pike_sp[-1].u.integer &&
	   Pike_sp[-1].subtype==NUMBER_UNDEFINED)
	{
	  if(Pike_compiler->new_program->flags & PROGRAM_PASS_1_DONE)
	  {
	    if (!exception) {
	      struct compilation *c = THIS_COMPILATION;
	      if (node_name) {
		my_yyerror("Index '%S' not present in module %s.",
			   id, node_name);
	      } else {
		my_yyerror("Index '%S' not present in module.", id);
	      }
	      resolv_constant(n);
	      low_yyreport(REPORT_ERROR, NULL, 0, parser_system_string,
			   1, "Indexed module was: %O.");
	    }
	  }else if (!(Pike_compiler->flags & COMPILATION_FORCE_RESOLVE)) {
	    /* Hope it's there in pass 2 */
	    pop_stack();
#if 0
	    fprintf(stderr, "Placeholder deployed when indexing ");
	    print_tree(n);
	    fprintf(stderr, "with %s\n", id->str);
#endif
	    ref_push_object(placeholder_object);
	  }
	}

	else if (Pike_compiler->new_program->flags & PROGRAM_PASS_1_DONE) {
	  if (((Pike_sp[-1].type == T_OBJECT &&
		Pike_sp[-1].u.object == placeholder_object) ||
	       (Pike_sp[-1].type == T_PROGRAM &&
		Pike_sp[-1].u.program == placeholder_program)) &&
	      /* Ugly special case: We must be able to get
	       * predef::__placeholder_object. */
	      (!node_name || strcmp (node_name, "predef"))) {
	    if (node_name)
	      my_yyerror("Got placeholder %s when indexing "
			 "module %s with '%S'. (Resolver problem.)",
			 get_name_of_type (Pike_sp[-1].type),
			 node_name, id);
	    else
	      my_yyerror("Got placeholder %s when indexing "
			 "module with '%S'. (Resolver problem.)",
			 get_name_of_type (Pike_sp[-1].type),
			 id);
	  }
	}

	else {
	  /* If we get a program that hasn't gone through pass 1 yet
	   * then we have to register a dependency now in our pass 1
	   * so that our pass 2 gets delayed. Otherwise the other
	   * program might still be just as unfinished when we come
	   * back here in pass 2. */
	  struct program *p = NULL;
	  if (Pike_sp[-1].type == T_PROGRAM)
	    p = Pike_sp[-1].u.program;
	  else if (Pike_sp[-1].type == T_OBJECT ||
		   (Pike_sp[-1].type == T_FUNCTION &&
		    Pike_sp[-1].subtype != FUNCTION_BUILTIN))
	    p = Pike_sp[-1].u.object->prog;
	  if (p && !(p->flags & PROGRAM_PASS_1_DONE))
	    report_compiler_dependency (p);
	}
      }
      END_CYCLIC();
    }
    }
  }
  UNSETJMP(tmp);
  ret=mkconstantsvaluenode(Pike_sp-1);
  pop_stack();
  return ret;
}


/* FIXME: Ought to use parent pointer to avoid recursion. */
int node_is_eq(node *a,node *b)
{
  check_tree(a,0);
  check_tree(b,0);

  if(a == b) return 1;
  if(!a || !b) return 0;
  if(a->token != b->token) return 0;

  fatal_check_c_stack(16384);

  switch(a->token)
  {
  case F_TRAMPOLINE: /* FIXME, the context has to be the same! */
#ifdef SHARED_NODES
    if(a->u.trampoline.prog != b->u.trampoline.prog)
      return 0;
#endif
    return a->u.trampoline.ident == b->u.trampoline.ident &&
      a->u.trampoline.frame == b->u.trampoline.frame;
      
  case F_EXTERNAL:
  case F_GET_SET:
  case F_LOCAL:
    return a->u.integer.a == b->u.integer.a &&
      a->u.integer.b == b->u.integer.b;
      
  case F_IDENTIFIER:
    return a->u.id.number == b->u.id.number;

  case F_CAST:
  case F_SOFT_CAST:
    return a->type == b->type && node_is_eq(CAR(a), CAR(b));

  case F_CONSTANT:
    return is_equal(&(a->u.sval), &(b->u.sval));

  default:
    if( a->type != b->type ) return 0;
    if(car_is_node(a) && !node_is_eq(CAR(a), CAR(b))) return 0;
    if(cdr_is_node(a) && !node_is_eq(CDR(a), CDR(b))) return 0;
    return 1;
  }
}

node *debug_mktypenode(struct pike_type *t)
{
  node *res = mkemptynode();
  res->token = F_CONSTANT;
  copy_pike_type(res->u.sval.u.type, t);
  res->u.sval.type = T_TYPE;
  /* FIXME: Should be type(val) */
  type_stack_mark();
  push_finished_type(t);
  push_type(T_TYPE);
  res->type = pop_unfinished_type();
  return res;
}

node *low_mkconstantsvaluenode(const struct svalue *s)
{
  node *res = mkemptynode();
  res->token = F_CONSTANT;
  assign_svalue_no_free(& res->u.sval, s);
  if(s->type == T_OBJECT ||
     (s->type==T_FUNCTION && s->subtype!=FUNCTION_BUILTIN))
  {
    if(!(s->u.object->prog && (s->u.object->prog->flags & PROGRAM_CONSTANT)))
      res->node_info|=OPT_EXTERNAL_DEPEND;
  }
  res->type = get_type_of_svalue(s);
  res->tree_info |= OPT_SAFE;
  return res;
}

node *debug_mkconstantsvaluenode(const struct svalue *s)
{
  return low_mkconstantsvaluenode(s);
}

node *debug_mkliteralsvaluenode(const struct svalue *s)
{
  node *res = low_mkconstantsvaluenode(s);

  if(s->type!=T_STRING && s->type!=T_INT && s->type!=T_FLOAT)
    res->node_info|=OPT_EXTERNAL_DEPEND;

  return res;
}

node *debug_mksvaluenode(struct svalue *s)
{
  switch(s->type)
  {
  case T_ARRAY:
    return make_node_from_array(s->u.array);
    
  case T_MULTISET:
    return make_node_from_multiset(s->u.multiset);

  case T_MAPPING:
    return make_node_from_mapping(s->u.mapping);

  case T_OBJECT:
#ifdef PIKE_DEBUG
    if (s->u.object->prog == placeholder_program &&
	Pike_compiler->compiler_pass == 2)
      Pike_fatal("Got placeholder object in second pass.\n");
#endif
    if(s->u.object == Pike_compiler->fake_object)
    {
      return mkefuncallnode("this_object", 0);
    }
    if(s->u.object->next == s->u.object)
    {
      int x=0;
      node *n=mkefuncallnode("this_object", 0);
#ifndef PARENT_INFO
      struct object *o;
      for(o=Pike_compiler->fake_object;o!=s->u.object;o=o->parent)
      {
	n=mkefuncallnode("function_object",
			 mkefuncallnode("object_program",n));
      }
#else
      struct program_state *state=Pike_compiler;;
      for(;state->fake_object!=s->u.object;state=state->previous)
      {
	state->new_program->flags |= PROGRAM_USES_PARENT | PROGRAM_NEEDS_PARENT;
	n=mkefuncallnode("function_object",
			 mkefuncallnode("object_program",n));
      }
#endif
      return n;
    }
    break;

  case T_FUNCTION:
  {
    if(s->subtype != FUNCTION_BUILTIN)
    {
      if(s->u.object == Pike_compiler->fake_object)
	return mkidentifiernode(s->subtype);

      if(s->u.object->next == s->u.object)
      {
	return mkexternalnode(s->u.object->prog, s->subtype);
      }

/*      yyerror("Non-constant function pointer! (should not happen!)"); */
    }
  }
  }

  return mkconstantsvaluenode(s);
}


/* these routines operates on parsetrees and are mostly used by the
 * optimizer
 */


/* FIXME: Ought to use parent pointer to avoid recursion.
 * In the SHARED_NODES case there's no need of course.
 */
node *copy_node(node *n)
{
  node *b;
  debug_malloc_touch(n);
  debug_malloc_touch(n->type);
#if 0
  /* The following needs to be node type specific. */
  debug_malloc_touch(n->u.node.a);
  debug_malloc_touch(n->u.node.b);
#endif
  check_tree(n,0);
  if(!n) return n;
  switch(n->token)
  {
  case F_LOCAL:
  case F_IDENTIFIER:
  case F_TRAMPOLINE:
    b=mknewintnode(0);
    if(b->type) free_type(b->type);
    *b=*n;
    copy_pike_type(b->type, n->type);
    return b;

  default:
    add_ref(n);
    return n;
  }
  if(n->name)
  {
    if(b->name) free_string(b->name);
    add_ref(b->name=n->name);
  }
  /* FIXME: Should b->name be kept if n->name is NULL?
   * /grubba 1999-09-22
   */
  b->line_number = n->line_number;
  b->node_info = n->node_info;
  b->tree_info = n->tree_info;
  return b;
}

int is_const(node *n)
{
  if(!n) return 1;
  return !(n->tree_info & (OPT_SIDE_EFFECT |
			   OPT_NOT_CONST |
			   OPT_ASSIGNMENT |
			   OPT_CASE |
			   OPT_CONTINUE |
			   OPT_BREAK |
			   OPT_RETURN
			   ));
}

int node_is_tossable(node *n)
{
  if (!(n->tree_info & (OPT_SIDE_EFFECT |
			OPT_ASSIGNMENT |
			OPT_CASE |
			OPT_CONTINUE |
			OPT_BREAK |
			OPT_RETURN
		       ))) {
    ptrdiff_t args;
    if (n->tree_info & (OPT_NOT_CONST|OPT_SAFE))
      return 1;
    args = eval_low (n, 0);
    if (args == -1) {
      n->tree_info |= OPT_SIDE_EFFECT; /* A constant that throws. */
      return 0;
    }
    else {
      pop_n_elems (args);
      n->tree_info |= OPT_SAFE;
      return 1;
    }
  }
  return 0;
}

/* this one supposes that the value is optimized */
int node_is_true(node *n)
{
  if(!n) return 0;
  switch(n->token)
  {
    case F_CONSTANT: return !SAFE_IS_ZERO(& n->u.sval);
    default: return 0;
  }
}

/* this one supposes that the value is optimized */
int node_is_false(node *n)
{
  if(!n) return 0;
  switch(n->token)
  {
    case F_CONSTANT: return SAFE_IS_ZERO(& n->u.sval);
    default: return 0;
  }
}

int node_may_overload(node *n, int lfun)
{
  if(!n) return 0;
  if(!n->type) return 1;
  return type_may_overload(n->type, lfun);
}

/* FIXME: Ought to use parent pointer to avoid recursion. */
node **last_cmd(node **a)
{
  node **n;
  if(!a || !*a) return (node **)NULL;

  fatal_check_c_stack(16384);

  if(((*a)->token == F_CAST) ||
     ((*a)->token == F_SOFT_CAST) ||
     ((*a)->token == F_POP_VALUE)) return last_cmd(&_CAR(*a));
  if(((*a)->token != F_ARG_LIST) &&
     ((*a)->token != F_COMMA_EXPR)) return a;
  if(CDR(*a))
  {
    if(CDR(*a)->token != F_CAST &&
       CDR(*a)->token != F_SOFT_CAST &&
       CDR(*a)->token != F_POP_VALUE &&
       CDR(*a)->token != F_ARG_LIST &&
       CDR(*a)->token != F_COMMA_EXPR)
      return &_CDR(*a);
    if((n=last_cmd(&_CDR(*a))))
      return n;
  }
  if(CAR(*a))
  {
    if(CAR(*a)->token != F_CAST &&
       CAR(*a)->token != F_SOFT_CAST &&
       CAR(*a)->token != F_POP_VALUE &&
       CAR(*a)->token != F_ARG_LIST &&
       CAR(*a)->token != F_COMMA_EXPR)
      return &_CAR(*a);
    if((n=last_cmd(&_CAR(*a))))
      return n;
  }
  return 0;
}

/* FIXME: Ought to use parent pointer to avoid recursion. */
static node **low_get_arg(node **a,int *nr)
{
  node **n;
  if (!a[0]) return NULL;
  if(a[0]->token != F_ARG_LIST)
  {
    if(!(*nr)--)
      return a;
    else
      return NULL;
  }

  fatal_check_c_stack(16384);

  if(CAR(*a))
    if((n=low_get_arg(&_CAR(*a),nr)))
      return n;

  if(CDR(*a))
    if((n=low_get_arg(&_CDR(*a),nr)))
      return n;

  return 0;
}

node **my_get_arg(node **a,int n) { return low_get_arg(a,&n); }

node **is_call_to(node *n, c_fun f)
{
  switch(n->token)
  {
    case F_AUTO_MAP:
    case F_APPLY:
      if(CAR(n) &&
	 CAR(n)->token == F_CONSTANT &&
	 CAR(n)->u.sval.type == T_FUNCTION &&
	 CAR(n)->u.sval.subtype == FUNCTION_BUILTIN &&
	 CAR(n)->u.sval.u.efun->function == f)
	return &_CDR(n);
  }
  return 0;
}


/* FIXME: Ought to use parent pointer to avoid recursion. */
static void low_print_tree(node *foo,int needlval)
{
  if(!foo) return;
  if(l_flag>9)
  {
    fprintf(stderr, "/*%x*/",foo->tree_info);
  }

  fatal_check_c_stack(16384);

  switch(l_flag > 99 ? -1 : foo->token)
  {
  case USHRT_MAX:
    fputs("FREED_NODE", stderr);
    break;
  case F_LOCAL:
    if(needlval) fputc('&', stderr);
    if(foo->u.integer.b)
    {
      fprintf(stderr, "$<%ld>%ld",(long)foo->u.integer.b,(long)foo->u.integer.a);
    }else{
      fprintf(stderr, "$%ld",(long)foo->u.integer.a);
    }
    break;

  case '?':
    fputc('(', stderr);
    low_print_tree(_CAR(foo),0);
    fputs(")?(", stderr);
    if (_CDR(foo)) {
      low_print_tree(_CADR(foo),0);
      fputs("):(", stderr);
      low_print_tree(_CDDR(foo),0);
    } else {
      fputs("0:0", stderr);
    }
    fputc(')', stderr);
    break;

  case F_IDENTIFIER:
    if(needlval) fputc('&', stderr);
    if (Pike_compiler->new_program) {
      fprintf(stderr, "id(%s)",ID_FROM_INT(Pike_compiler->new_program, foo->u.id.number)->name->str);
    } else {
      fputs("unknown identifier", stderr);
    }
    break;

  case F_EXTERNAL:
  case F_GET_SET:
    if(needlval) fputc('&', stderr);
    {
      struct program_state *state = Pike_compiler;
      char *name = "?";
      int program_id = foo->u.integer.a;
      int level = 0;
      int id_no = foo->u.integer.b;
      while(state && (state->new_program->id != program_id)) {
	state = state->previous;
	level++;
      }
      if (id_no == IDREF_MAGIC_THIS)
	name = "this";
      else if (state) {
	struct identifier *id = ID_FROM_INT(state->new_program, id_no);
	if (id && id->name) {
	  name = id->name->str;
	}
      }
      fprintf(stderr, "ext(%d:%s)", level, name);
    }
    break;

  case F_TRAMPOLINE:
    if (Pike_compiler->new_program) {
      fprintf(stderr, "trampoline<%s>",
	      ID_FROM_INT(Pike_compiler->new_program, foo->u.trampoline.ident)->name->str);
    } else {
      fputs("trampoline<unknown identifier>", stderr);
    }
    break;

  case F_ASSIGN:
    low_print_tree(_CDR(foo),1);
    fputc('=', stderr);
    low_print_tree(_CAR(foo),0);
    break;

  case F_POP_VALUE:
    fputc('{', stderr);
    low_print_tree(_CAR(foo), 0);
    fputc('}', stderr);
    break;

  case F_CAST:
  {
    dynamic_buffer save_buf;
    char *s;
    init_buf(&save_buf);
    my_describe_type(foo->type);
    s=simple_free_buf(&save_buf);
    fprintf(stderr, "(%s){",s);
    free(s);
    low_print_tree(_CAR(foo),0);
    fputc('}', stderr);
    break;
  }

  case F_SOFT_CAST:
  {
    dynamic_buffer save_buf;
    char *s;
    init_buf(&save_buf);
    my_describe_type(foo->type);
    s=simple_free_buf(&save_buf);
    fprintf(stderr, "[%s(", s);
    free(s);
    low_print_tree(_CDR(foo), 0);
    fprintf(stderr, ")]{");
    low_print_tree(_CAR(foo),0);
    fputc('}', stderr);
    break;
  }

  case F_COMMA_EXPR:
    low_print_tree(_CAR(foo),0);
    if(_CAR(foo) && _CDR(foo))
    {
      if(_CAR(foo)->type == void_type_string &&
	 _CDR(foo)->type == void_type_string)
	fputs(";\n", stderr);
      else
	fputs(",\n", stderr);
    }
    low_print_tree(_CDR(foo),needlval);
    return;

  case F_ARG_LIST:
    low_print_tree(_CAR(foo),0);
    if(_CAR(foo) && _CDR(foo))
    {
      if(_CAR(foo)->type == void_type_string &&
	 _CDR(foo)->type == void_type_string)
	fputs(";\n", stderr);
      else
	fputc(',', stderr);
    }
    low_print_tree(_CDR(foo),needlval);
    return;

    case F_ARRAY_LVALUE:
      fputc('[', stderr);
      low_print_tree(_CAR(foo),1);
      fputc(']', stderr);
      break;

  case F_LVALUE_LIST:
    low_print_tree(_CAR(foo),1);
    if(_CAR(foo) && _CDR(foo)) fputc(',', stderr);
    low_print_tree(_CDR(foo),1);
    return;

  case F_CONSTANT:
  {
    dynamic_buffer save_buf;
    char *s;
    init_buf(&save_buf);
    describe_svalue(& foo->u.sval, 0, 0);
    s=simple_free_buf(&save_buf);
    fprintf(stderr, "const(%s)",s);
    free(s);
    break;
  }

  case F_VAL_LVAL:
    low_print_tree(_CAR(foo),0);
    fputs(",&", stderr);
    low_print_tree(_CDR(foo),0);
    return;

  case F_AUTO_MAP:
    fputs("__automap__ ", stderr);
    low_print_tree(_CAR(foo),0);
    fputc('(', stderr);
    low_print_tree(_CDR(foo),0);
    fputc(')', stderr);
    return;
  case F_AUTO_MAP_MARKER:
    low_print_tree(_CAR(foo),0);
    fputs("[*]", stderr);
    return;
  case F_APPLY:
    low_print_tree(_CAR(foo),0);
    fputc('(', stderr);
    low_print_tree(_CDR(foo),0);
    fputc(')', stderr);
    return;

  case F_NORMAL_STMT_LABEL:
  case F_CUSTOM_STMT_LABEL:
    fprintf(stderr, "%s:", _CAR(foo)->u.sval.u.string->str);
    low_print_tree(_CDR(foo),0);
    return;

  case F_LOOP:
    fputs("loop(", stderr);
    if(car_is_node(foo)) low_print_tree(_CAR(foo),0);
    fputs(",{", stderr);
    if(cdr_is_node(foo)) low_print_tree(_CDR(foo),0);
    fputs("})", stderr);
    return;

  default:
    if(!car_is_node(foo) && !cdr_is_node(foo))
    {
      fputs(get_token_name(foo->token), stderr);
      return;
    }
    if(foo->token<256)
    {
      fputc(foo->token, stderr);
    }else{
      fputs(get_token_name(foo->token), stderr);
    }
    fputc('(', stderr);
    if(car_is_node(foo)) low_print_tree(_CAR(foo),0);
    if(car_is_node(foo) && cdr_is_node(foo))
      fputc(',', stderr);
    if(cdr_is_node(foo)) low_print_tree(_CDR(foo),0);
    fputc(')', stderr);
    return;
  }
}

void print_tree(node *n)
{
  check_tree(n,0);
  low_print_tree(n,0);
  fputc('\n', stderr);
}


/* The following routines need much better commenting. */
/* They also needed to support lexical scoping and external variables.
 * /grubba 2000-08-27
 */

/*
 * Known bugs:
 *  * Aliasing is not handled.
 *  * Called functions are assumed not to use lexical scoping.
 */

#if MAX_LOCAL > MAX_GLOBAL
#define MAX_VAR	MAX_LOCAL
#else /* MAX_LOCAL <= MAX_GLOBAL */
#define MAX_VAR MAX_GLOBAL
#endif /* MAX_LOCAL > MAX_GLOBAL */

/* FIXME: Should perhaps use BLOCK_ALLOC for struct scope_info? */
struct scope_info
{
  struct scope_info *next;
  int scope_id;
  char vars[MAX_VAR];
};

struct used_vars
{
  int err;
  int ext_flags;
  /* Note that the locals and externals linked lists are sorted on scope_id. */
  struct scope_info *locals;	/* Lexical scopes. scope_id == depth */
  struct scope_info *externals;	/* External scopes. scope_id == program_id */
};

#define VAR_BLOCKED   0
#define VAR_UNUSED    1
#define VAR_USED      3

/* FIXME: Shouldn't the following two functions be named "*_or_vars"? */

/* Perform a merge into a.
 * Note that b is freed.
 */
static void low_and_vars(struct scope_info **a, struct scope_info *b)
{
  while (*a && b) {
    if ((*a)->scope_id < b->scope_id) {
      a = &((*a)->next);
    } else if ((*a)->scope_id > b->scope_id) {
      struct scope_info *tmp = *a;
      *a = b;
      b = b->next;
      (*a)->next = tmp;
    } else {
      struct scope_info *tmp = b;
      int e;
      for (e = 0; e < MAX_VAR; e++) {
	(*a)->vars[e] |= b->vars[e];
      }
      a = &((*a)->next);
      b = b->next;
      free(tmp);
    }
  }
  if (!*a) {
    *a = b;
  }
}

/* NOTE: The second argument will be freed. */
static void do_and_vars(struct used_vars *a,struct used_vars *b)
{
  low_and_vars(&(a->locals), b->locals);
  low_and_vars(&(a->externals), b->externals);

  a->err |= b->err;
  a->ext_flags |= b->ext_flags;
  free(b);
}

/* Makes a copy of a.
 * Note: Can throw errors on out of memory.
 */
static struct used_vars *copy_vars(struct used_vars *a)
{
  struct used_vars *ret;
  struct scope_info *src;
  struct scope_info **dst;
  ret=(struct used_vars *)xalloc(sizeof(struct used_vars));
  src = a->locals;
  dst = &(ret->locals);
  *dst = NULL;
  while (src) {
    *dst = malloc(sizeof(struct scope_info));
    if (!*dst) {
      src = ret->locals;
      while(src) {
	struct scope_info *tmp = src->next;
	free(src);
	src = tmp;
      }
      free(ret);
      Pike_error("Out of memory in copy_vars.\n");
      return NULL;	/* Make sure that the optimizer knows we exit here. */
    }
    MEMCPY(*dst, src, sizeof(struct scope_info));
    src = src->next;
    dst = &((*dst)->next);
    *dst = NULL;
  }
  src = a->externals;
  dst = &(ret->externals);
  *dst = NULL;
  while (src) {
    *dst = malloc(sizeof(struct scope_info));
    if (!*dst) {
      src = ret->locals;
      while(src) {
	struct scope_info *tmp = src->next;
	free(src);
	src = tmp;
      }
      src = ret->externals;
      while(src) {
	struct scope_info *tmp = src->next;
	free(src);
	src = tmp;
      }
      free(ret);
      Pike_error("Out of memory in copy_vars.\n");
      return NULL;	/* Make sure that the optimizer knows we exit here. */
    }
    MEMCPY(*dst, src, sizeof(struct scope_info));
    src = src->next;
    dst = &((*dst)->next);
    *dst = NULL;
  }
  
  ret->err = a->err;
  ret->ext_flags = a->ext_flags;
  return ret;
}

/* Find the insertion point for the variable a:scope_id:num.
 * Allocates a new scope if needed.
 * Can throw errors on out of memory.
 */
char *find_q(struct scope_info **a, int num, int scope_id)
{
  struct scope_info *new;

#ifdef PIKE_DEBUG
  if (l_flag > 3) {
    fprintf(stderr, "find_q %d:%d\n", scope_id, num);
  }
#endif /* PIKE_DEBUG */
  while (*a && ((*a)->scope_id < scope_id)) {
    a = &((*a)->next);
  }
  if ((*a) && ((*a)->scope_id == scope_id)) {
#ifdef PIKE_DEBUG
    if (l_flag > 4) {
      fputs("scope found.\n", stderr);
    }
#endif /* PIKE_DEBUG */
    return (*a)->vars + num;
  }
#ifdef PIKE_DEBUG
  if (l_flag > 4) {
    fputs("Creating new scope.\n", stderr);
  }
#endif /* PIKE_DEBUG */
  new = (struct scope_info *)xalloc(sizeof(struct scope_info));
  MEMSET(new, VAR_UNUSED, sizeof(struct scope_info));
  new->next = *a;
  new->scope_id = scope_id;
  *a = new;
  return new->vars + num;
}

/* FIXME: Ought to use parent pointer to avoid recursion. */
/* Find the variables that are used in the tree n. */
/* noblock: Don't mark unused variables that are written to as blocked.
 * overwrite: n is an lvalue that is overwritten.
 */
static int find_used_variables(node *n,
			       struct used_vars *p,
			       int noblock,
			       int overwrite)
{
  struct used_vars *a;
  char *q;

  if(!n) return 0;

  fatal_check_c_stack(16384);

  switch(n->token)
  {
  case F_LOCAL:
    q = find_q(&(p->locals), n->u.integer.a, n->u.integer.b);
#ifdef PIKE_DEBUG
    if (l_flag > 2) {
      fprintf(stderr, "local %d:%d is ",
	      n->u.integer.b, n->u.integer.a);
    }
#endif /* PIKE_DEBUG */
    goto set_pointer;

  case F_EXTERNAL:
  case F_GET_SET:
    q = find_q(&(p->externals), n->u.integer.b, n->u.integer.a);
#ifdef PIKE_DEBUG
    if (l_flag > 2) {
      fprintf(stderr, "external %d:%d is ",
	      n->u.integer.a, n->u.integer.b);
    }
#endif /* PIKE_DEBUG */
    goto set_pointer;

  case F_IDENTIFIER:
    q = find_q(&(p->externals), n->u.id.number,
	       Pike_compiler->new_program->id);
    if(n->u.id.number > MAX_GLOBAL)
    {
      p->err=1;
      return 0;
    }
#ifdef PIKE_DEBUG
      if (l_flag > 2) {
	fprintf(stderr, "external %d:%d is ",
		Pike_compiler->new_program->id, n->u.id.number);
      }
#endif /* PIKE_DEBUG */

  set_pointer:
    if(overwrite)
    {
      if(*q == VAR_UNUSED && !noblock) {
	*q = VAR_BLOCKED;
#ifdef PIKE_DEBUG
	if (l_flag > 2) {
	  fputs("blocked\n", stderr);
	}
      } else {
	if (l_flag > 2) {
	  fputs("overwritten\n", stderr);
	}
#endif /* PIKE_DEBUG */
      }
    }
    else
    {
      if(*q == VAR_UNUSED) {
	*q = VAR_USED;
#ifdef PIKE_DEBUG
	if (l_flag > 2) {
	  fputs("used\n", stderr);
	}
      } else {
	if (l_flag > 2) {
	  fputs("kept\n", stderr);
	}
#endif /* PIKE_DEBUG */
      }
    }
    break;

  case F_ARROW:
  case F_INDEX:
#ifdef PARANOID_INDEXING
    /* Be paranoid, and assume aliasing. */
    p->ext_flags = VAR_USED;
#endif /* PARANOID_INDEXING */
    if(car_is_node(n)) find_used_variables(CAR(n),p,noblock,0);
    if(cdr_is_node(n)) find_used_variables(CDR(n),p,noblock,0);
    break;

  case F_ASSIGN:
    find_used_variables(CAR(n),p,noblock,0);
    find_used_variables(CDR(n),p,noblock,1);
    break;

  case '?':
    find_used_variables(CAR(n),p,noblock,0);
    a=copy_vars(p);
    find_used_variables(CADR(n),a,noblock,0);
    find_used_variables(CDDR(n),p,noblock,0);
    do_and_vars(p, a);
    break;

  case F_INC_NEQ_LOOP:
  case F_DEC_NEQ_LOOP:
  case F_INC_LOOP:
  case F_DEC_LOOP:
  case F_LOOP:
  case F_FOREACH:
  case F_FOR:
    find_used_variables(CAR(n),p,noblock,0);
    a=copy_vars(p);
    find_used_variables(CDR(n),a,noblock,0);
    do_and_vars(p, a);
    break;

  case F_SWITCH:
    find_used_variables(CAR(n),p,noblock,0);
    a=copy_vars(p);
    find_used_variables(CDR(n),a,1,0);
    do_and_vars(p, a);
    break;

   case F_DO:
    a=copy_vars(p);
    find_used_variables(CAR(n),a,noblock,0);
    do_and_vars(p, a);
    find_used_variables(CDR(n),p,noblock,0);
    break;

  default:
    if(car_is_node(n)) find_used_variables(CAR(n),p,noblock,0);
    if(cdr_is_node(n)) find_used_variables(CDR(n),p,noblock,0);
  }
  return 0;
}

/* FIXME: Ought to use parent pointer to avoid recursion. */
/* no subtility needed */
static void find_written_vars(node *n,
			      struct used_vars *p,
			      int lvalue)
{
  if(!n) return;

  fatal_check_c_stack(16384);

  switch(n->token)
  {
  case F_LOCAL:
    if(lvalue) {
#ifdef PIKE_DEBUG
      if (l_flag > 2) {
	fprintf(stderr, "local %d:%d is written\n",
		n->u.integer.b, n->u.integer.a);
      }
#endif /* PIKE_DEBUG */
      *find_q(&(p->locals), n->u.integer.a, n->u.integer.b) = VAR_USED;
    }
    break;

  case F_EXTERNAL:
  case F_GET_SET:
    if(lvalue) {
#ifdef PIKE_DEBUG
      if (l_flag > 2) {
	fprintf(stderr, "external %d:%d is written\n",
		n->u.integer.a, n->u.integer.b);
      }
#endif /* PIKE_DEBUG */
      *find_q(&(p->externals), n->u.integer.b, n->u.integer.a) = VAR_USED;
    }
    break;

  case F_IDENTIFIER:
    if(lvalue)
    {
      if(n->u.id.number >= MAX_VAR)
      {
	p->err=1;
	return;
      }
#ifdef PIKE_DEBUG
      if (l_flag > 2) {
	fprintf(stderr, "external %d:%d is written\n",
		Pike_compiler->new_program->id, n->u.id.number);
      }
#endif /* PIKE_DEBUG */
      *find_q(&(p->externals), n->u.id.number,
	      Pike_compiler->new_program->id) = VAR_USED;
    }
    break;

  case F_APPLY:
  case F_AUTO_MAP:
    if(n->tree_info & OPT_SIDE_EFFECT) {
      p->ext_flags = VAR_USED;
    }
    find_written_vars(CAR(n), p, 0);
    find_written_vars(CDR(n), p, 0);
    break;

  case F_AUTO_MAP_MARKER:
    find_written_vars(CAR(n), p, lvalue);
    break;

  case F_INDEX:
  case F_ARROW:
#ifdef PARANOID_INDEXING
    /* Be paranoid and assume aliasing. */
    if (lvalue)
      p->ext_flags = VAR_USED;
    find_written_vars(CAR(n), p, 0);
#else /* !PARAONID_INDEXING */
    /* Propagate the change to the indexed value.
     * Note: This is sensitive to aliasing effects.
     */
    find_written_vars(CAR(n), p, lvalue);
#endif /* PARANOID_INDEXING */
    find_written_vars(CDR(n), p, 0);
    break;

  case F_SOFT_CAST:
    find_written_vars(CAR(n), p, lvalue);
    break;

  case F_INC:
  case F_DEC:
  case F_POST_INC:
  case F_POST_DEC:
    find_written_vars(CAR(n), p, 1);
    break;

  case F_ASSIGN:
    find_written_vars(CAR(n), p, 0);
    find_written_vars(CDR(n), p, 1);
    break;

    case F_AND_EQ:
    case F_OR_EQ:
    case F_XOR_EQ:
    case F_LSH_EQ:
    case F_RSH_EQ:
    case F_ADD_EQ:
    case F_SUB_EQ:
    case F_MULT_EQ:
    case F_MOD_EQ:
    case F_DIV_EQ:
      find_written_vars(CAR(n), p, 1);
      find_written_vars(CDR(n), p, 0);
      break;

  case F_SSCANF:
    find_written_vars(CAR(n), p, 0);
    /* FIXME: Marks arg 2 as written for now.
     */
    find_written_vars(CDR(n), p, 1);
    break;

    case F_ARRAY_LVALUE:
    find_written_vars(CAR(n), p, 1);
    break;
      
  case F_LVALUE_LIST:
    find_written_vars(CAR(n), p, 1);
    find_written_vars(CDR(n), p, 1);
    break;

  case F_VAL_LVAL:
    find_written_vars(CAR(n), p, 0);
    find_written_vars(CDR(n), p, 1);
    break;
    
  default:
    if(car_is_node(n)) find_written_vars(CAR(n), p, 0);
    if(cdr_is_node(n)) find_written_vars(CDR(n), p, 0);
  }
}

void free_vars(struct used_vars *a)
{
  struct scope_info *tmp;

  tmp = a->locals;
  while(tmp) {
    struct scope_info *next = tmp->next;
    free(tmp);
    tmp = next;
  }
  tmp = a->externals;
  while(tmp) {
    struct scope_info *next = tmp->next;
    free(tmp);
    tmp = next;
  }
}

/* return 1 if A depends on B */
static int depend_p2(node *a, node *b)
{
  struct used_vars aa, bb;
  int e;
  ONERROR free_aa;
  ONERROR free_bb;

  if(!a || !b || is_const(a)) return 0;
  aa.err = 0;
  bb.err = 0;
  aa.ext_flags = 0;
  bb.ext_flags = 0;
  aa.locals = NULL;
  bb.locals = NULL;
  aa.externals = NULL;
  bb.externals = NULL;

  SET_ONERROR(free_aa, free_vars, &aa);
  SET_ONERROR(free_bb, free_vars, &bb);

  /* A depends on B if A uses stuff that is written to by B. */

  find_used_variables(a, &aa, 0, 0);
  find_written_vars(b, &bb, 0);

#ifdef PIKE_DEBUG
  if (l_flag > 2) {
    struct scope_info *aaa = aa.locals;
    while (aaa) {
      fputs("Used locals:\n", stderr);
      for (e = 0; e < MAX_VAR; e++) {
	if (aaa->vars[e] == VAR_USED) {
	  fprintf(stderr, "\t%d:%d\n", aaa->scope_id, e);
	}
      }
      aaa = aaa->next;
    }
    aaa = bb.locals;
    while (aaa) {
      fputs("Written locals:\n", stderr);
      for (e = 0; e < MAX_VAR; e++) {
	if (aaa->vars[e] != VAR_UNUSED) {
	  fprintf(stderr, "\t%d:%d\n", aaa->scope_id, e);
	}
      }
      aaa = aaa->next;
    }
  }
#endif /* PIKE_DEBUG */

  UNSET_ONERROR(free_bb);
  UNSET_ONERROR(free_aa);

  /* If there was an error or
   * If A has external dependencies due to indexing, we won't
   * investigate further.
   */
  if(aa.err || bb.err || aa.ext_flags == VAR_USED) {
    free_vars(&aa);
    free_vars(&bb);
    return 1;
  }

  /* Check for overlap in locals. */
  {
    struct scope_info *aaa = aa.locals;
    struct scope_info *bbb = bb.locals;

    while (aaa) {
      while (bbb && (bbb->scope_id < aaa->scope_id)) {
	bbb = bbb->next;
      }
      if (!bbb) break;
      if (bbb->scope_id == aaa->scope_id) {
	for (e = 0; e < MAX_VAR; e++) {
	  if ((aaa->vars[e] == VAR_USED) &&
	      (bbb->vars[e] != VAR_UNUSED)) {
	    free_vars(&aa);
	    free_vars(&bb);
	    return 1;
	  }	  
	}
      }
      aaa = aaa->next;
    }
  }

  if (bb.ext_flags == VAR_USED) {
    /* B has side effects.
     *
     * A is dependant if A uses any externals at all.
     */

    /* No need to look closer at b */
    struct scope_info *aaa = aa.externals;

    /* FIXME: Probably only needed to check if aaa is NULL or not. */

    while (aaa) {
      for (e = 0; e < MAX_VAR; e++) {
	if (aaa->vars[e] == VAR_USED) {
	  free_vars(&aa);
	  free_vars(&bb);
	  return 1;
	}
      }
      aaa = aaa->next;
    }    
  } else {
    /* Otherwise check for overlaps. */
    struct scope_info *aaa = aa.externals;
    struct scope_info *bbb = bb.externals;

    while (aaa) {
      while (bbb && (bbb->scope_id < aaa->scope_id)) {
	bbb = bbb->next;
      }
      if (!bbb) break;
      if (bbb->scope_id == aaa->scope_id) {
	for (e = 0; e < MAX_VAR; e++) {
	  if ((aaa->vars[e] == VAR_USED) &&
	      (bbb->vars[e] != VAR_UNUSED)) {
	    free_vars(&aa);
	    free_vars(&bb);
	    return 1;
	  }	  
	}
      }
      aaa = aaa->next;
    }
  }
  free_vars(&aa);
  free_vars(&bb);
  return 0;
}

static int depend_p3(node *a,node *b)
{
  if(!b) return 0;
#if 0
  if(!(b->tree_info & OPT_SIDE_EFFECT) && 
     (b->tree_info & OPT_EXTERNAL_DEPEND))
    return 1;
#endif

  if((a->tree_info & OPT_EXTERNAL_DEPEND)) return 1;
    
  return depend_p2(a,b);
}

#ifdef PIKE_DEBUG
static int depend_p(node *a,node *b)
{
  if(l_flag > 3)
  {
    fputs("Checking if: ", stderr);
    print_tree(a);
    fputs("Depends on: ", stderr);
    print_tree(b);
    if(depend_p3(a,b))
    {
      fputs("The answer is (drumroll) : yes\n", stderr);
      return 1;
    }else{
      fputs("The answer is (drumroll) : no\n", stderr);
      return 0;
    }
  }
  return depend_p3(a,b);
}
#else
#define depend_p depend_p3
#endif

/* Check if n depends on the lvalue lval */
static int depend2_p(node *n, node *lval)
{
  node *tmp;
  int ret;

  /* Make a temporary node (lval = 0), so that we can use depend_p(). */
  ADD_NODE_REF2(lval,
		tmp = mknode(F_ASSIGN, mkintnode(0), lval));
  ret = depend_p(n, tmp);
  free_node(tmp);
  return ret;
}

static int function_type_max=0;

/* FIXME: Ought to use parent pointer to avoid recursion. */
static void low_build_function_type(node *n)
{
  if(!n) return;
  if(function_type_max++ > 999)
  {
    reset_type_stack();

    push_type(T_MIXED);
    push_type(T_VOID);
    push_type(T_OR);  /* return type is void or mixed */

    push_type(T_MIXED);
    push_type(T_VOID);
    push_type(T_OR);  /* varargs */

    push_type(T_MANY);
    return;
  }
  switch(n->token)
  {
  case F_COMMA_EXPR:
  case F_ARG_LIST:
    fatal_check_c_stack(16384);

    low_build_function_type(CDR(n));
    low_build_function_type(CAR(n));
    break;

  case F_PUSH_ARRAY:
    {
      struct pike_type *so_far;
      struct pike_type *arg_type;
      struct pike_type *tmp;

      so_far = pop_type();

      copy_pike_type(arg_type, void_type_string);

      /* Convert fun(a,b,c...:d) to fun(a|b|c|void...:d)
       */

      while(so_far->type == T_FUNCTION) {
	tmp = or_pike_types(arg_type, so_far->car, 1);
	free_type(arg_type);
	arg_type = tmp;
	copy_pike_type(tmp, so_far->cdr);
	free_type(so_far);
	so_far = tmp;
      }

      tmp = or_pike_types(arg_type, so_far->car, 1);
      free_type(arg_type);
      arg_type = tmp;

      push_finished_type(so_far->cdr);	/* Return type */

      free_type(so_far);

      so_far = index_type(CAR(n)->type, int_type_string, n);
      tmp = or_pike_types(arg_type, so_far, 1);
      push_finished_type(tmp);
      if (tmp == mixed_type_string) {
	/* Ensure "or void"... */
	push_type(T_VOID);
	push_type(T_OR);
      }
      free_type(arg_type);
      free_type(so_far);
      free_type(tmp);
      push_type(T_MANY);
    }
    return;

  default:
    if(n->type)
    {
      if(n->type == void_type_string) return;
      push_finished_type(n->type);
    }else{
      push_type(T_MIXED);
    }
    push_type(T_FUNCTION);
  }
}

static struct pike_string *get_name_of_function(node *n)
{
  struct pike_string *name = NULL;
  if (!n) {
    MAKE_CONST_STRING(name, "NULL");
    return name;
  }
  switch(n->token)
  {
#if 0 /* FIXME */
  case F_TRAMPOLINE:
#endif
  case F_IDENTIFIER:
    name = ID_FROM_INT(Pike_compiler->new_program, n->u.id.number)->name;
    break;

  case F_ARROW:
  case F_INDEX:
    if(CDR(n)->token == F_CONSTANT &&
       CDR(n)->u.sval.type == T_STRING)
    {
      name = CDR(n)->u.sval.u.string;
    }else{
      MAKE_CONST_STRING(name, "dynamically resolved function");
    }
    break;

  case F_CONSTANT:
    switch(n->u.sval.type)
    {
    case T_FUNCTION:
      if(n->u.sval.subtype == FUNCTION_BUILTIN)
      {
	name = n->u.sval.u.efun->name;
      }else{
	name = ID_FROM_INT(n->u.sval.u.object->prog, n->u.sval.subtype)->name;
      }
      break;

    case T_ARRAY:
      MAKE_CONST_STRING(name, "array call");
      break;

    case T_PROGRAM:
      MAKE_CONST_STRING(name, "clone call");
      break;

    default:
      MAKE_CONST_STRING(name, "`() (function call)");
      break;
    }
    break;

  case F_EXTERNAL:
  case F_GET_SET:
    {
      int id_no = n->u.integer.b;

      if (id_no == IDREF_MAGIC_THIS) {
	MAKE_CONST_STRING(name, "this");	/* Should perhaps qualify it. */
      } else {
	int program_id = n->u.integer.a;
	struct program_state *state = Pike_compiler;

	while (state && (state->new_program->id != program_id)) {
	  state = state->previous;
	}

	if (state) {
	  struct identifier *id = ID_FROM_INT(state->new_program, id_no);
	  if (id && id->name) {
	    name = id->name;
#if 0
#ifdef PIKE_DEBUG
	    /* FIXME: This test crashes on valid code because the type of the
	     * identifier can change in pass 2 -Hubbe
	     */
	    if(id->type != f)
	    {
	      printf("Type of external node is not matching it's identifier.\nid->type: ");
	      simple_describe_type(id->type);
	      printf("\nf       : ");
	      simple_describe_type(f);
	      printf("\n");
	      
	      Pike_fatal("Type of external node is not matching it's identifier.\n");
	    }
#endif
#endif
	  }
	}
	if (!name) {
	  MAKE_CONST_STRING(name, "external symbol");
	}
      }
    }
    break;

  case F_CAST:
  case F_SOFT_CAST:
    name = get_name_of_function(CAR(n));
    break;

  case F_TRAMPOLINE:
    MAKE_CONST_STRING(name, "trampoline function");
    break;

  case F_LOCAL:
    MAKE_CONST_STRING(name, "local variable");
    break;

  case F_APPLY:
    if ((CAR(n)->token == F_CONSTANT) &&
	(CAR(n)->u.sval.type == T_FUNCTION) &&
	(CAR(n)->u.sval.subtype == FUNCTION_BUILTIN) &&
	(CAR(n)->u.sval.u.efun->function == debug_f_aggregate)) {
      if (CDR(n)) {
	n = CDR(n);
	while (n && (n->token == F_ARG_LIST)) n = CAR(n);
	if (n) {
	  /* FIXME: Should really join the names of all the args. */
	  name = get_name_of_function(n);
	} else {
	  MAKE_CONST_STRING(name, "dynamic array");
	}
      } else {
	MAKE_CONST_STRING(name, "empty array");
      }
    } else {
      MAKE_CONST_STRING(name, "returned value");
    }
    break;
	  
  default:
    /* fprintf(stderr, "Node token: %s(%d)\n",
       get_f_name(n->token), n->token); */
    MAKE_CONST_STRING(name, "unknown function");
  }
#ifdef PIKE_DEBUG
  if (!name) {
    Pike_fatal("Failed to get name of function.\n");
  }
#endif
  return name;
}

void fix_type_field(node *n)
{
  struct compilation *c = THIS_COMPILATION;
  struct pike_type *type_a, *type_b;
  struct pike_type *old_type;

  if (n->type && !(n->node_info & OPT_TYPE_NOT_FIXED))
    return; /* assume it is correct */

  old_type = n->type;
  n->type = 0;
  n->node_info &= ~OPT_TYPE_NOT_FIXED;

  switch(n->token)
  {
  case F_SOFT_CAST:
    if (CAR(n) && CAR(n)->type) {
#ifdef NEW_ARG_CHECK
      struct pike_type *soft_type = NULL;
      if (CDR(n) && (CDR(n)->token == F_CONSTANT) &&
	  (CDR(n)->u.sval.type == T_TYPE)) {
	soft_type = CDR(n)->u.sval.u.type;
	if ((n->type = soft_cast(soft_type, CAR(n)->type, 0))) {
	  /* Success. */
	  break;
	}
	ref_push_type_value(CAR(n)->type);
	ref_push_type_value(soft_type);
	yytype_report(REPORT_ERROR, NULL, 0, NULL, NULL, 0, NULL,
		      2, "Soft cast of %O to %O isn't a valid cast.");
      } else {
	yytype_report(REPORT_ERROR, NULL, 0, type_type_string,
		      NULL, 0, CDR(n)->type, 0,
		      "Soft cast with non-type.");
      }
      /* Failure: Fall through to the old code. */
#else /* !NEW_ARG_CHECK */
      if (!check_soft_cast(old_type, CAR(n)->type)) {
	ref_push_type_value(old_type);
	ref_push_type_value(CAR(n)->type);
	yytype_report(REPORT_ERROR, NULL, 0, NULL, NULL, 0, NULL,
		      2, "Soft cast to %S isn't a restriction of %S.",
		      t1, t2);
      }
      /* FIXME: check_soft_cast() is weaker than pike_types_le()
       * The resulting type should probably be the AND between the old
       * and the new type.
       */
#endif /* NEW_ARG_CHECK */
    }
    /* FALL_THROUGH */
  case F_CAST:
    /* Type-field is correct by definition. */
    copy_pike_type(n->type, old_type);
    break;

  case F_LAND:
  case F_LOR:
    if (!CAR(n) || CAR(n)->type == void_type_string) {
      yyerror("Conditional uses void expression.");
      copy_pike_type(n->type, mixed_type_string);
      break;
    }
    if(!match_types(CAR(n)->type, mixed_type_string))
      yyerror("Bad conditional expression.");

    if (!CDR(n) || CDR(n)->type == void_type_string)
      copy_pike_type(n->type, void_type_string);
    else if(n->token == F_LAND || CAR(n)->type == CDR(n)->type)
    {
      copy_pike_type(n->type, CDR(n)->type);
    }else{
      n->type = or_pike_types(CAR(n)->type, CDR(n)->type, 0);
    }
    break;

  case F_APPEND_ARRAY:
    if (!CAR(n) || (CAR(n)->type == void_type_string)) {
      yyerror("Assigning a void expression.");
      copy_pike_type(n->type, void_type_string);
    } else if (!CDR(n)) {
      copy_pike_type(n->type, CAR(n)->type);
    } else {
      struct pike_type *tmp;
      /* Ensure that the type-fields are up to date. */
      fix_type_field(CAR(n));
      fix_type_field(CDR(n));
      type_stack_mark();
      push_finished_type(CDR(n)->type);
      push_type(T_ARRAY);
      n->type = and_pike_types(CAR(n)->type, tmp = pop_unfinished_type());
      free_type(tmp);
    }
    break;

  case F_ASSIGN:
    if (!CAR(n) || (CAR(n)->type == void_type_string)) {
      yyerror("Assigning a void expression.");
      copy_pike_type(n->type, void_type_string);
    } else if (!CDR(n)) {
      copy_pike_type(n->type, CAR(n)->type);
    } else {
      /* Ensure that the type-fields are up to date. */
      fix_type_field(CAR(n));
      fix_type_field(CDR(n));
#if 0
      /* This test isn't sufficient, see below. */
      check_node_type(CAR(n), CDR(n)->type, "Bad type in assignment.");
#else /* !0 */
      if (!pike_types_le(CAR(n)->type, CDR(n)->type)) {
	/* a["b"]=c and a->b=c can be valid when a is an array.
	 *   
	 * FIXME: Exactly what case is the problem?
	 *	/grubba 2005-02-15
	 *
	 * Example:
	 *   array tmp = ({([]),([])});
	 *   tmp->foo = 7;		// Multi-assign.
	 *	/grubba 2007-04-27
	 */
	if (((CDR(n)->token != F_INDEX && CDR(n)->token != F_ARROW) ||
	     !((TEST_COMPAT (7, 6) && /* Bug compatibility. */
		match_types(array_type_string, CDR(n)->type)) ||
	       match_types(array_type_string, CADR(n)->type))) &&
	    !match_types(CDR(n)->type,CAR(n)->type)) {
	  yytype_report(REPORT_ERROR, NULL, 0, CDR(n)->type,
			NULL, 0, CAR(n)->type,
			0, "Bad type in assignment.");
	} else {
	  if (c->lex.pragmas & ID_STRICT_TYPES) {
	    struct pike_string *t1 = describe_type(CAR(n)->type);
	    struct pike_string *t2 = describe_type(CDR(n)->type);
#ifdef PIKE_DEBUG
	    if (l_flag > 0) {
	      fputs("Warning: Invalid assignment: ", stderr);
	      print_tree(n);
	    }
#endif /* PIKE_DEBUG */
	    yywarning("An expression of type %S cannot be assigned to "
		      "a variable of type %S.", t1, t2);
	    free_string(t2);
	    free_string(t1);
	  }
	  if (runtime_options & RUNTIME_CHECK_TYPES) {
	    _CAR(n) = mksoftcastnode(CDR(n)->type, CAR(n));
	  }
	}
      }
#endif /* 0 */
      n->type = and_pike_types(CAR(n)->type, CDR(n)->type);
    }
    break;

  case F_ARRAY_LVALUE:
    {
      node *lval_list;
      if (!(lval_list = CAR(n))) {
	copy_pike_type(n->type, mixed_type_string);
      } else {
	struct pike_type *t;
	node *n2;

	if (lval_list->token == F_LVALUE_LIST) {
	  n2 = CAR(lval_list);
	} else {
	  n2 = lval_list;
	}

	if (n2) {
	  copy_pike_type(t, n2->type);
	} else {
	  copy_pike_type(t, zero_type_string);
	}
	while ((n2 != lval_list) && (lval_list = CDR(lval_list))) {
	  if (lval_list->token == F_LVALUE_LIST) {
	    n2 = CAR(lval_list);
	  } else {
	    n2 = lval_list;
	  }
	  if (n2) {
	    struct pike_type *tmp = or_pike_types(t, n2->type, 1);
	    free_type(t);
	    t = tmp;
	  }
	}
	type_stack_mark();
	push_finished_type(t);
	push_type(T_ARRAY);
	free_type(t);
	n->type = pop_unfinished_type();
      }
    }
    break;

  case F_INDEX:
  case F_ARROW:
    if (!CAR(n) || (CAR(n)->type == void_type_string)) {
      yyerror("Indexing a void expression.");
      /* The optimizer converts this to an expression returning 0. */
      copy_pike_type(n->type, zero_type_string);
    } else if (CDR(n)) {
      int valid;
      type_a=CAR(n)->type;
      type_b=CDR(n)->type;
      if((valid = check_indexing(type_a, type_b, n)) <= 0)
	if(!Pike_compiler->catch_level)
	  yytype_report((!valid)?REPORT_ERROR:REPORT_WARNING,
			NULL, 0, NULL, NULL, 0, type_b,
			0, "Indexing on illegal type.");
      n->type = index_type(type_a, type_b, n);
    } else {
      copy_pike_type(n->type, mixed_type_string);
    }
    break;

  case F_RANGE:
    if (!CAR(n)) {
      /* Unlikely to occur, and if it does, it has probably
       * already been complained about.
       */
      copy_pike_type(n->type, mixed_type_string);
    }
    else {
      node *low = CADR (n), *high = CDDR (n);
      n->type = range_type(CAR(n)->type,
			   low->token == F_RANGE_OPEN ? NULL : CAR (low)->type,
			   high->token == F_RANGE_OPEN ? NULL : CAR (high)->type);
    }
    break;

  case F_PUSH_ARRAY:
    if (CAR(n)) {
      struct pike_type *array_type;
      MAKE_CONSTANT_TYPE(array_type, tArr(tZero));
      if (!pike_types_le(array_type, CAR(n)->type)) {
	yytype_report(REPORT_ERROR, NULL, 0, array_type,
		      NULL, 0, CAR(n)->type,
		      0, "Bad argument to splice operator.");
      }
      free_type(array_type);
      /* FIXME: The type field of the splice operator is not yet utilized.
       *
       * It probably ought to be something similar to MANY(..., VOID).
       */
      n->type = index_type(CAR(n)->type, int_type_string, n);
    } else {
      copy_pike_type(n->type, mixed_type_string);
    }
    break;

  case F_AUTO_MAP_MARKER:
    if (!CAR(n) || (CAR(n)->type == void_type_string)) {
      yyerror("Indexing a void expression.");
      /* The optimizer converts this to an expression returning 0. */
      copy_pike_type(n->type, zero_type_string);
    } else {
      type_a=CAR(n)->type;
      if(!match_types(type_a, array_type_string))
	if(!Pike_compiler->catch_level)
	  yytype_report(REPORT_ERROR,
			NULL, 0, array_type_string,
			NULL, 0, type_a,
			0, "[*] on non-array.");
      n->type=index_type(type_a, int_type_string, n);
    }
    break;

  case F_AUTO_MAP:
  case F_APPLY:
    if (!CAR(n) || (CAR(n)->type == void_type_string)) {
      yyerror("Calling a void expression.");
    } else {
      struct pike_type *f;	/* Expected type. */
      struct pike_type *s;	/* Actual type */
      struct pike_string *name = NULL;
#ifndef NEW_ARG_CHECK
      char *alternate_name = NULL;
#endif
      INT32 args;

#ifdef NEW_ARG_CHECK

      args = 0;

      name = get_name_of_function(CAR(n));

#ifdef PIKE_DEBUG
      if (l_flag>2)
	safe_pike_fprintf (stderr, "Checking call to %S at %S:%d.\n", name,
			   n->current_file, n->line_number);
#endif /* PIKE_DEBUG */

      /* NOTE: new_check_call() steals a reference from f! */
      copy_pike_type(f, CAR(n)->type);
      f = debug_malloc_pass(new_check_call(name, f, CDR(n), &args, 0));

      if (!f) {
	/* Errors have been generated. */
	copy_pike_type(n->type, mixed_type_string);
	break;
      }

      if ((n->type = new_get_return_type(dmalloc_touch(struct pike_type *, f),
					 0))) {
	/* Type/argument-check OK. */
	debug_malloc_touch(n->type);

	free_type(f);
	if(n->token == F_AUTO_MAP)
	{
	  push_finished_type(n->type);
	  push_type(T_ARRAY);
	  free_type(n->type);
	  n->type = pop_type();
	}
	break;
      }

      /* Too few arguments or similar. */
      copy_pike_type(n->type, mixed_type_string);

      if ((s = get_first_arg_type(dmalloc_touch(struct pike_type *, f), 0))) {
	yytype_report(REPORT_ERROR, NULL, 0, s,
		      NULL, 0, NULL,
		      0, "Too few arguments to %S (got %d).",
		      name, args);
	free_type(s);
	yytype_report(REPORT_ERROR, NULL, 0, NULL,
		      NULL, 0, CAR(n)->type,
		      0, "Function type:");
      } else {
	yytype_report(REPORT_ERROR, NULL, 0, function_type_string,
		      NULL, 0, f,
		      0, "Attempt to call a non function value %S.",
		      name);
      }
      free_type(f);
      break;
#else /* !NEW_ARG_CHECK */

      if (!match_types(CAR(n)->type, function_type_string) &&
	  !match_types(CAR(n)->type, array_type_string)) {
	yytype_report(REPORT_ERROR, NULL, 0, function_type_string,
		      NULL, 0, CAR(n)->type,
		      0, "Calling non function value.");
	copy_pike_type(n->type, mixed_type_string);

	/* print_tree(n); */
	break;
      }

      push_type(T_MIXED); /* match any return type */
      push_type(T_VOID);  /* even void */
      push_type(T_OR);

      push_type(T_VOID); /* not varargs */
      push_type(T_MANY);
      function_type_max=0;
      low_build_function_type(CDR(n));
      s = pop_type();
      f = CAR(n)->type?CAR(n)->type:mixed_type_string;
      n->type = check_call(s, f,
			   (c->lex.pragmas & ID_STRICT_TYPES) &&
			   !(n->node_info & OPT_WEAK_TYPE));
      args = count_arguments(s);
      max_args = count_arguments(f);
      if(max_args<0) max_args = 0x7fffffff;


      if (n->type) {
	/* Type/argument-check OK. */
	free_type(s);

	if(n->token == F_AUTO_MAP)
	{
	  push_finished_type(n->type);
	  push_type(T_ARRAY);
	  free_type(n->type);
	  n->type = pop_type();
	}

	break;
      }

      switch(CAR(n)->token)
      {
#if 0 /* FIXME */
      case F_TRAMPOLINE:
#endif
      case F_IDENTIFIER:
	name=ID_FROM_INT(Pike_compiler->new_program, CAR(n)->u.id.number)->name;
	break;

	case F_ARROW:
	case F_INDEX:
	  if(CDAR(n)->token == F_CONSTANT &&
	     CDAR(n)->u.sval.type == T_STRING)
	  {
	    name=CDAR(n)->u.sval.u.string;
	  }else{
	    alternate_name="dynamically resolved function";
	  }
	  break;

      case F_CONSTANT:
	switch(CAR(n)->u.sval.type)
	{
	case T_FUNCTION:
	  if(CAR(n)->u.sval.subtype == FUNCTION_BUILTIN)
	  {
	    name=CAR(n)->u.sval.u.efun->name;
	  }else{
	    name=ID_FROM_INT(CAR(n)->u.sval.u.object->prog,
			     CAR(n)->u.sval.subtype)->name;
	  }
	  break;

	case T_ARRAY:
	  alternate_name="array call";
	  break;

	case T_PROGRAM:
	  alternate_name="clone call";
	  break;

	default:
	  alternate_name="`() (function call)";
	  break;
	}
	break;

      case F_EXTERNAL:
      case F_GET_SET:
	{
	  int id_no = CAR(n)->u.integer.b;

	  if (id_no == IDREF_MAGIC_THIS)
	    alternate_name = "this";	/* Should perhaps qualify it. */

	  else {
	    int program_id = CAR(n)->u.integer.a;
	    struct program_state *state = Pike_compiler;

	    alternate_name="external symbol";

	    while (state && (state->new_program->id != program_id)) {
	      state = state->previous;
	    }

	    if (state) {
	      struct identifier *id = ID_FROM_INT(state->new_program, id_no);
	      if (id && id->name) {
		name = id->name;
#if 0
#ifdef PIKE_DEBUG
		/* FIXME: This test crashes on valid code because the type of the
		 * identifier can change in pass 2 -Hubbe
		 */
		if(id->type != f)
		{
		  printf("Type of external node is not matching it's identifier.\nid->type: ");
		  simple_describe_type(id->type);
		  printf("\nf       : ");
		  simple_describe_type(f);
		  printf("\n");

		  Pike_fatal("Type of external node is not matching it's identifier.\n");
		}
#endif
#endif
	      }
	    }
	  }
	}
	break;
	  
      default:
	alternate_name="unknown function";
      }

      if(max_args < args)
      {
	if(TEST_COMPAT(0,6))
	{
	  free_type(s);
	  copy_pike_type(n->type, mixed_type_string);
	  break;
	}
	if (name) {
	  my_yyerror("Too many arguments to %S.", name);
	} else {
	  my_yyerror("Too many arguments to %s.", alternate_name);
	}
      }
      else if(max_correct_args == args)
      {
	if (name) {
	  my_yyerror("Too few arguments to %S.", name);
	} else {
	  my_yyerror("Too few arguments to %s.", alternate_name);
	}
      } else if (name) {
	my_yyerror("Bad argument %d to %S.", max_correct_args+1, name);
      } else {
	my_yyerror("Bad argument %d to %s.",
		   max_correct_args+1, alternate_name);
      }
      
      yytype_error(NULL, f, s, 0);

      /* print_tree(n); */

      free_type(s);
#endif /* NEW_ARG_CHECK */
    }
    copy_pike_type(n->type, mixed_type_string);
    break;

  case '?':
    if (!CAR(n) || (CAR(n)->type == void_type_string)) {
      yyerror("Conditional expression is void.");
    } else if(!match_types(CAR(n)->type, mixed_type_string))
      yyerror("Bad conditional expression.");

    if(!CDR(n) || !CADR(n) || !CDDR(n) ||
       CADR(n)->type == void_type_string ||
       CDDR(n)->type == void_type_string)
    {
      copy_pike_type(n->type, void_type_string);
      break;
    }
    
    if(CADR(n)->type == CDDR(n)->type)
    {
      copy_pike_type(n->type, CADR(n)->type);
      break;
    }

    n->type = or_pike_types(CADR(n)->type, CDDR(n)->type, 0);
    break;

  case F_AND_EQ:
  case F_OR_EQ:
  case F_XOR_EQ:
  case F_LSH_EQ:
  case F_RSH_EQ:
  case F_ADD_EQ:
  case F_SUB_EQ:
  case F_MULT_EQ:
  case F_MOD_EQ:
  case F_DIV_EQ:
    if (CAR(n)) {
      struct pike_string *op_string = NULL;
      struct pike_type *call_type;
      node *op_node;

      /* Go via var = OP(var, expr);
       *
       * FIXME: To restrict the type further:
       * type = typeof(OP(var, expr)) AND typeof(var);
       */
      switch(n->token) {
      case F_AND_EQ:
	MAKE_CONST_STRING(op_string, "`&");
	break;
      case F_OR_EQ:
	MAKE_CONST_STRING(op_string, "`|");
	break;
      case F_XOR_EQ:
	MAKE_CONST_STRING(op_string, "`^");
	break;
      case F_LSH_EQ:
	MAKE_CONST_STRING(op_string, "`<<");
	break;
      case F_RSH_EQ:
	MAKE_CONST_STRING(op_string, "`>>");
	break;
      case F_ADD_EQ:
	MAKE_CONST_STRING(op_string, "`+");
	break;
      case F_SUB_EQ:
	MAKE_CONST_STRING(op_string, "`-");
	break;
      case F_MULT_EQ:
	MAKE_CONST_STRING(op_string, "`*");
	break;
      case F_MOD_EQ:
	MAKE_CONST_STRING(op_string, "`%");
	break;
      case F_DIV_EQ:
	MAKE_CONST_STRING(op_string, "`/");
	break;
      default:
	Pike_fatal("fix_type_field(): Unhandled token: %d\n", n->token);
	break;
      }
      if (!(op_node = find_module_identifier(op_string, 0))) {
	my_yyerror("Internally used efun undefined for token %d: %S",
		   n->token, op_string);
	copy_pike_type(n->type, mixed_type_string);
	break;
      }

      if (!op_node->type) {
	fix_type_field(op_node);
      }

      push_finished_type(CAR(n)->type);
      push_type(T_VOID);
      push_type(T_MANY);
      push_finished_type(CDR(n)?CDR(n)->type:mixed_type_string);
      push_type(T_FUNCTION);
      push_finished_type(CAR(n)->type);
      push_type(T_FUNCTION);

      call_type = pop_type();

      n->type = check_call(call_type,
			   op_node->type ? op_node->type : mixed_type_string,
			   (c->lex.pragmas & ID_STRICT_TYPES) &&
			   !(op_node->node_info & OPT_WEAK_TYPE));
      if (n->type) {
	/* Type check ok. */
	free_node(op_node);
	free_type(call_type);
	break;
      }
      yytype_report(REPORT_ERROR, NULL, 0,
		    op_node->type ? op_node->type : mixed_type_string,
		    NULL, 0, call_type,
		    0, "Bad arguments to %S.", op_string);
      free_node(op_node);
      free_type(call_type);
    }
    copy_pike_type(n->type, mixed_type_string);
    break;

  case F_INC:
  case F_DEC:
  case F_POST_INC:
  case F_POST_DEC:
    if (CAR(n)) {
      /* The expression gets the type from the variable. */
      /* FIXME: Ought to strip non-applicable subtypes from the type. */
      copy_pike_type(n->type, CAR(n)->type);
    } else {
      copy_pike_type(n->type, mixed_type_string);
    }
    break;

  case F_RETURN:
    if (!CAR(n) || (CAR(n)->type == void_type_string)) {
      yywarning("Returning a void expression. Converted to zero.");
      if (!CAR(n)) {
	_CAR(n) = mkintnode(0);
	copy_pike_type(n->type, CAR(n)->type);
      } else {
	_CAR(n) = mknode(F_COMMA_EXPR, CAR(n), mkintnode(0));
	copy_pike_type(n->type, CDAR(n)->type);
      }
      break;
    } else if(Pike_compiler->compiler_frame &&
	      Pike_compiler->compiler_frame->current_return_type) {
      if ((Pike_compiler->compiler_frame->current_return_type !=
	   void_type_string) ||
	  (CAR(n)->token != F_CONSTANT) ||
	  !SAFE_IS_ZERO(& CAR(n)->u.sval)) {
	check_node_type(CAR(n),
			Pike_compiler->compiler_frame->current_return_type,
			"Wrong return type.");
      }
    }
    copy_pike_type(n->type, void_type_string);
    break;

  case F_CASE_RANGE:
    if (CDR(n) && CAR(n) && !TEST_COMPAT(0,6)) {
      /* case 1 .. 2: */
      if (!match_types(CAR(n)->type, CDR(n)->type)) {
	if (!match_types(CAR(n)->type, int_type_string) ||
	    !match_types(CDR(n)->type, int_type_string)) {
	  yytype_report(REPORT_ERROR,
			NULL, 0, CAR(n)->type,
			NULL, 0, CDR(n)->type,
			0, "Type mismatch in case range.");
	}
      } else if ((c->lex.pragmas & ID_STRICT_TYPES) &&
		 (CAR(n)->type != CDR(n)->type)) {
	/* The type should be the same for both CAR & CDR. */
	if (!pike_types_le(CDR(n)->type, CAR(n)->type)) {
	  /* Note that zero should be handled as int(0..0) here. */
	  if (!(CAR(n)->type == zero_type_string) ||
	      !(pike_types_le(CDR(n)->type, int_type_string))) {
	    yytype_report(REPORT_ERROR,
			  NULL, 0, CAR(n)->type,
			  NULL, 0, CDR(n)->type,
			  0, "Type mismatch in case range.");
	  }
	} else if (!pike_types_le(CAR(n)->type, CDR(n)->type)) {
	  if (!(CDR(n)->type == zero_type_string) ||
	      !(pike_types_le(CAR(n)->type, int_type_string))) {
	    yytype_report(REPORT_WARNING,
			  NULL, 0, CAR(n)->type,
			  NULL, 0, CDR(n)->type,
			  0, "Type mismatch in case range.");
	  }
	}
      }
    }
    /* FALL_THROUGH */
  case F_CASE:
  case F_INC_LOOP:
  case F_DEC_LOOP:
  case F_DEC_NEQ_LOOP:
  case F_INC_NEQ_LOOP:
  case F_LOOP:
  case F_CONTINUE:
  case F_BREAK:
  case F_DEFAULT:
  case F_POP_VALUE:
    copy_pike_type(n->type, void_type_string);
    break;

  case F_DO:
    if (!CDR(n) || (CDR(n)->type == void_type_string)) {
      yyerror("do - while(): Conditional expression is void.");
    } else if(!match_types(CDR(n)->type, mixed_type_string))
      yyerror("Bad conditional expression do - while().");
    copy_pike_type(n->type, void_type_string);
    break;
    
  case F_FOR:
    if (!CAR(n) || (CAR(n)->type == void_type_string)) {
      yyerror("for(): Conditional expression is void.");
    } else if(!match_types(CAR(n)->type, mixed_type_string))
      yyerror("Bad conditional expression for().");
    copy_pike_type(n->type, void_type_string);
    break;

  case F_SWITCH:
    if (!CAR(n) || (CAR(n)->type == void_type_string)) {
      yyerror("switch(): Conditional expression is void.");
    } else if(!match_types(CAR(n)->type, mixed_type_string))
      yyerror("Bad switch expression.");
    copy_pike_type(n->type, void_type_string);
    break;

  case F_CONSTANT:
    n->type = get_type_of_svalue(&n->u.sval);
    break;

  case F_FOREACH:
    if (!CAR(n) || (CAR(n)->token != F_VAL_LVAL)) {
      yyerror("foreach(): No expression to loop over.");
    } else {
      if (!CAAR(n) || pike_types_le(CAAR(n)->type, void_type_string)) {
	yyerror("foreach(): Looping over a void expression.");
      } else {
	if(CDAR(n) && CDAR(n)->token == ':')
	{
	  /* Check the iterator type */
	  struct pike_type *iterator_type;
	  struct pike_type *foreach_call_type;
	  MAKE_CONSTANT_TYPE(iterator_type,
			     tOr5(tArray, tStr, tObj,
				  tMapping, tMultiset));
	  if (!check_node_type(CAAR(n), iterator_type,
			       "Bad argument 1 to foreach()")) {
	    /* No use checking the index and value types if
	     * the iterator type is bad.
	     */
	    free_type(iterator_type);
	    goto foreach_type_check_done;
	  }
	  free_type(iterator_type);

	  push_type(T_MIXED);
	  push_type(T_VOID);
	  push_type(T_MANY);
	  push_finished_type(CAAR(n)->type);
	  push_type(T_FUNCTION);

	  foreach_call_type = pop_type();

	  if (CADAR(n)) {
	    /* Check the index type */
	    struct pike_type *index_fun_type;
	    struct pike_type *index_type;
	    MAKE_CONSTANT_TYPE(index_fun_type,
			       tOr4(tFunc(tOr(tArray, tStr), tZero),
				    tFunc(tMap(tSetvar(0, tMix),
					       tMix), tVar(0)),
				    tFunc(tSet(tSetvar(1, tMix)),
					  tVar(1)),
				    tFunc(tObj, tZero)));
	    index_type = check_call(foreach_call_type, index_fun_type, 0);
	    if (!index_type) {
	      /* Should not happen. */
	      yytype_report(REPORT_ERROR,
			    NULL, 0, NULL,
			    NULL, 0, NULL,
			    0, "Bad iterator type for index in foreach().");
	    } else {
	      if (!pike_types_le(index_type, CADAR(n)->type)) {
		int level = REPORT_NOTICE;
		if (!match_types(CADAR(n)->type, index_type)) {
		  level = REPORT_ERROR;
		} else if (c->lex.pragmas & ID_STRICT_TYPES) {
		  level = REPORT_WARNING;
		}
		yytype_report(level,
			      NULL, 0, index_type,
			      NULL, 0, CADAR(n)->type,
			      0, "Type mismatch for index in foreach().");
	      }
	      free_type(index_type);
	    }
	    free_type(index_fun_type);
	  }
	  if (CDDAR(n)) {
	    /* Check the value type */
	    struct pike_type *value_fun_type;
	    struct pike_type *value_type;
	    MAKE_CONSTANT_TYPE(value_fun_type,
			       tOr5(tFunc(tArr(tSetvar(0, tMix)),
					  tVar(0)),
				    tFunc(tStr, tZero),
				    tFunc(tMap(tMix,tSetvar(1, tMix)),
					  tVar(1)),
				    tFunc(tMultiset, tInt1),
				    tFunc(tObj, tZero)));
	    value_type = check_call(foreach_call_type, value_fun_type, 0);
	    if (!value_type) {
	      /* Should not happen. */
	      yytype_report(REPORT_ERROR,
			    NULL, 0, NULL,
			    NULL, 0, NULL,
			    0, "Bad iterator type for value in foreach().");
	    } else {
	      if (!pike_types_le(value_type, CDDAR(n)->type)) {
		int level = REPORT_NOTICE;
		if (!match_types(CDDAR(n)->type, value_type)) {
		  level = REPORT_ERROR;
		} else if (c->lex.pragmas & ID_STRICT_TYPES) {
		  level = REPORT_WARNING;
		}
		yytype_report(level,
			      NULL, 0, value_type,
			      NULL, 0, CDDAR(n)->type,
			      0, "Type mismatch for value in foreach().");
	      }
	      free_type(value_type);
	    }
	    free_type(value_fun_type);
	  }
	  free_type(foreach_call_type);
	} else {
	  /* Old-style foreach */
	  struct pike_type *array_zero;
	  MAKE_CONSTANT_TYPE(array_zero, tArr(tZero));
	  
	  if (!pike_types_le(array_zero, CAAR(n)->type)) {
	    yytype_report(REPORT_ERROR,
			  NULL, 0, array_zero,
			  NULL, 0, CAAR(n)->type,
			  0, "Bad argument 1 to foreach().");
	  } else {
	    if ((c->lex.pragmas & ID_STRICT_TYPES) &&
		!pike_types_le(CAAR(n)->type, array_type_string)) {
	      yytype_report(REPORT_WARNING,
			    NULL, 0, CAAR(n)->type,
			    NULL, 0, array_type_string,
			    0,
			    "Argument 1 to foreach() is not always an array.");
	    }
	    
	    if (!CDAR(n)) {
	      /* No loop variable. Will be converted to a counted loop
	       * by treeopt. */
	    } else if (pike_types_le(CDAR(n)->type, void_type_string)) {
	      yyerror("Bad argument 2 to foreach().");
	    } else {
	      struct pike_type *array_value_type;

	      type_stack_mark();
	      push_finished_type(CDAR(n)->type);
	      push_type(T_ARRAY);
	      array_value_type = pop_unfinished_type();

	      check_node_type(CAAR(n), array_value_type,
			      "Bad argument 1 to foreach().");
	      free_type(array_value_type);
	    }
	  }
	  free_type(array_zero);
	}
      }
    }
  foreach_type_check_done:
    copy_pike_type(n->type, void_type_string);
    break;

  case F_SSCANF:
    if (!CAR(n) || (CAR(n)->token != ':') ||
	!CDAR(n) || (CDAR(n)->token != F_ARG_LIST) ||
	!CADAR(n) || !CDDAR(n)) {
      yyerror("Too few arguments to sscanf().");
      MAKE_CONSTANT_TYPE(n->type, tIntPos);
    } else {
      struct pike_string *sscanf_name;
      struct pike_type *sscanf_type;
      node *args;
      INT32 argno = 0;
      if (CAAR(n)->u.sval.u.integer & SSCANF_FLAG_76_COMPAT) {
	MAKE_CONST_STRING(sscanf_name, "sscanf_76");
	add_ref(sscanf_type = sscanf_76_type_string);
      } else {
	MAKE_CONST_STRING(sscanf_name, "sscanf");
	add_ref(sscanf_type = sscanf_type_string);
      }	
      args = mknode(F_ARG_LIST, CDAR(n), CDR(n));
      add_ref(CDAR(n));
      if (CDR(n)) add_ref(CDR(n));
      sscanf_type = new_check_call(sscanf_name, sscanf_type, args, &argno, 0);
      free_node(args);
      if (sscanf_type) {
	if (!(n->type = new_get_return_type(sscanf_type, 0))) {
	  struct pike_type *expected;
	  if ((expected = get_first_arg_type(sscanf_type, 0))) {
	    yytype_report(REPORT_ERROR,
			  NULL, 0, expected,
			  NULL, 0, NULL,
			  0, "Too few arguments to %S (got %d).",
			  sscanf_name, argno);
	    free_type(expected);
	  } else {
	    /* Most likely not reached. */
	    yytype_report(REPORT_ERROR,
			  NULL, 0, function_type_string,
			  NULL, 0, sscanf_type,
			  0, "Attempt to call a non function value %S.",
			  sscanf_name);
	  }
	}
	free_type(sscanf_type);
      }
      if (!n->type) {
	MAKE_CONSTANT_TYPE(n->type, tIntPos);
      }
    }
    break;

  case F_UNDEFINED:
    copy_pike_type(n->type, zero_type_string);
    break;

  case F_ARG_LIST:
    if (n->parent) {
      /* Propagate the changed type all the way up to the apply node. */
      n->parent->node_info |= OPT_TYPE_NOT_FIXED;
    }
    /* FALL_THROUGH */
  case F_COMMA_EXPR:
    if(!CAR(n) || CAR(n)->type==void_type_string)
    {
      if(CDR(n))
	copy_pike_type(n->type, CDR(n)->type);
      else
	copy_pike_type(n->type, void_type_string);
      break;
    }

    if(!CDR(n) || CDR(n)->type == void_type_string)
    {
      if(CAR(n))
	copy_pike_type(n->type, CAR(n)->type);
      else
	copy_pike_type(n->type, void_type_string);
      break;
    }
    if (n->token == F_ARG_LIST) {
      n->type = or_pike_types(CAR(n)->type, CDR(n)->type, 0);
    } else {
      copy_pike_type(n->type, CDR(n)->type);
    }
    break;

  case F_MAGIC_INDEX:
    /* FIXME: Could have a stricter type for ::`->(). */
    /* FIXME: */
    MAKE_CONSTANT_TYPE(n->type, tFunc(tMix tOr(tVoid,tInt),tMix));
    break;
  case F_MAGIC_SET_INDEX:
    /* FIXME: Could have a stricter type for ::`->=(). */
    /* FIXME: */
    MAKE_CONSTANT_TYPE(n->type, tFunc(tMix tSetvar(0,tMix) tOr(tVoid,tInt), tVar(0)));
    break;
  case F_MAGIC_INDICES:
    MAKE_CONSTANT_TYPE(n->type, tFunc(tOr(tVoid,tInt), tArr(tString)));
    break;
  case F_MAGIC_VALUES:
    /* FIXME: Could have a stricter type for ::_values. */
    MAKE_CONSTANT_TYPE(n->type, tFunc(tOr(tVoid,tInt), tArray));
    break;

  case F_CATCH:
    /* FALL_THROUGH */
  default:
    copy_pike_type(n->type, mixed_type_string);
  }

  if (n->type != old_type) {
    if (n->parent) {
      n->parent->node_info |= OPT_TYPE_NOT_FIXED;
    }
  }
  if (old_type) {
    free_type(old_type);
  }
#ifdef PIKE_DEBUG
  check_type_string(n->type);
#endif /* PIKE_DEBUG */
}

static void zapp_try_optimize(node *n)
{
  node *parent;
  node *orig_n = n;

  if(!n) return;

  parent = n->parent;
  n->parent = NULL;

  while(1) {
    n->node_info &= ~OPT_TRY_OPTIMIZE;
    n->tree_info &= ~OPT_TRY_OPTIMIZE;

    if (car_is_node(n)) {
      CAR(n)->parent = n;
      n = CAR(n);
      continue;
    }
    if (cdr_is_node(n)) {
      CDR(n)->parent = n;
      n = CDR(n);
      continue;
    }
    while (n->parent && 
	   (!cdr_is_node(n->parent) || (CDR(n->parent) == n))) {
      n = n->parent;
    }
    if (n->parent && cdr_is_node(n->parent)) {
      CDR(n->parent)->parent = n->parent;
      n = CDR(n->parent);
      continue;
    }
    break;
  }
#ifdef PIKE_DEBUG
  if (n != orig_n) {
    Pike_fatal("zzap_try_optimize() lost track of parent.\n");
  }
#endif /* PIKE_DEBUG */
  n->parent = parent;
}

#if defined(SHARED_NODES)
/* FIXME: Ought to use parent pointer to avoid recursion. */
static void find_usage(node *n, unsigned char *usage,
		       unsigned char *switch_u,
		       const unsigned char *cont_u,
		       const unsigned char *break_u,
		       const unsigned char *catch_u)
{
  if (!n)
    return;

  fatal_check_c_stack(16384);

  switch(n->token) {
  case F_ASSIGN:
    if ((CDR(n)->token == F_LOCAL) && (!CDR(n)->u.integer.b)) {
      usage[CDR(n)->u.integer.a] = 0;
    } else if (CDR(n)->token == F_ARRAY_LVALUE) {
      find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
    }
    find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
    return;

  case F_SSCANF:
    {
      int i;

      /* catch_usage is restored if sscanf throws an error. */
      for (i=0; i < MAX_LOCAL; i++) {
	usage[i] |= catch_u[i];
      }
      /* Only the first two arguments are evaluated. */
      if (CAR(n) && CDAR(n)) {
	find_usage(CDDAR(n), usage, switch_u, cont_u, break_u, catch_u);
	find_usage(CADAR(n), usage, switch_u, cont_u, break_u, catch_u);
      }
      return;
    }

  case F_CATCH:
    {
      unsigned char catch_usage[MAX_LOCAL];
      int i;

      MEMCPY(catch_usage, usage, MAX_LOCAL);
      find_usage(CAR(n), usage, switch_u, cont_u, catch_usage, catch_usage);
      for(i=0; i < MAX_LOCAL; i++) {
	usage[i] |= catch_usage[i];
      }
      return;
    }

  case F_AUTO_MAP:
  case F_APPLY:
    {
      int i;

      /* catch_usage is restored if the function throws an error. */
      for (i=0; i < MAX_LOCAL; i++) {
	usage[i] |= catch_u[i];
      }
      find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
      find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
      return;
    }

  case F_LVALUE_LIST:
    find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
    if (CAR(n)) {
      if ((CAR(n)->token == F_LOCAL) && (!CAR(n)->u.integer.b)) {
	usage[CAR(n)->u.integer.a] = 0;
      }
    }
    return;

  case F_ARRAY_LVALUE:
    find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
    return;

  case F_CONTINUE:
    MEMCPY(usage, cont_u, MAX_LOCAL);
    return;

  case F_BREAK:
    MEMCPY(usage, break_u, MAX_LOCAL);
    return;

  case F_DEFAULT:
  case F_CASE:
  case F_CASE_RANGE:
    {
      int i;

      find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
      find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
      for(i = 0; i < MAX_LOCAL; i++) {
	switch_u[i] |= usage[i];
      }
      return;
    }

  case F_SWITCH:
    {
      unsigned char break_usage[MAX_LOCAL];
      unsigned char switch_usage[MAX_LOCAL];
      int i;

      MEMSET(switch_usage, 0, MAX_LOCAL);
      MEMCPY(break_usage, usage, MAX_LOCAL);

      find_usage(CDR(n), usage, switch_usage, cont_u, break_usage, catch_u);

      for(i = 0; i < MAX_LOCAL; i++) {
	usage[i] |= switch_usage[i];
      }

      find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
      return;
    }

  case F_RETURN:
    MEMSET(usage, 0, MAX_LOCAL);
    /* FIXME: The function arguments should be marked "used", since
     * they are seen in backtraces.
     */
    return;

  case F_LOR:
  case F_LAND:
    {
      unsigned char trail_usage[MAX_LOCAL];
      int i;

      MEMCPY(trail_usage, usage, MAX_LOCAL);

      find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);

      for(i=0; i < MAX_LOCAL; i++) {
	usage[i] |= trail_usage[i];
      }

      find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
      return;
    }

  case '?':
    {
      unsigned char cadr_usage[MAX_LOCAL];
      unsigned char cddr_usage[MAX_LOCAL];
      int i;

      MEMCPY(cadr_usage, usage, MAX_LOCAL);
      MEMCPY(cddr_usage, usage, MAX_LOCAL);

      find_usage(CADR(n), cadr_usage, switch_u, cont_u, break_u, catch_u);
      find_usage(CDDR(n), cddr_usage, switch_u, cont_u, break_u, catch_u);

      for (i=0; i < MAX_LOCAL; i++) {
	usage[i] = cadr_usage[i] | cddr_usage[i];
      }
      find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
      return;
    }
    
  case F_DO:
    {
      unsigned char break_usage[MAX_LOCAL];
      unsigned char continue_usage[MAX_LOCAL];

      MEMCPY(break_usage, usage, MAX_LOCAL);

      find_usage(CDR(n), usage, switch_u, cont_u, break_usage, catch_u);

      MEMCPY(continue_usage, usage, MAX_LOCAL);

      find_usage(CAR(n), usage, switch_u, break_usage, continue_usage,
		 catch_u);
      return;
    }

  case F_FOR:
    {
      unsigned char loop_usage[MAX_LOCAL];
      unsigned char break_usage[MAX_LOCAL];
      unsigned char continue_usage[MAX_LOCAL];
      int i;

      MEMCPY(break_usage, usage, MAX_LOCAL);

      /* for(;a;b) c; is handled like:
       *
       * if (a) { do { c; b; } while(a); }
       */

      MEMSET(loop_usage, 0, MAX_LOCAL);

      find_usage(CAR(n), loop_usage, switch_u, cont_u, break_u, catch_u);
      if (CDR(n)) {
	find_usage(CDDR(n), loop_usage, switch_u, cont_u, break_usage,
		   catch_u);

	MEMCPY(continue_usage, loop_usage, MAX_LOCAL);

	find_usage(CADR(n), loop_usage, switch_u, continue_usage, break_usage,
		   catch_u);
      }

      for (i = 0; i < MAX_LOCAL; i++) {
	usage[i] |= loop_usage[i];
      }

      find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
      return;
    }

  case F_FOREACH:
    {
      unsigned char loop_usage[MAX_LOCAL];
      unsigned char break_usage[MAX_LOCAL];
      unsigned char continue_usage[MAX_LOCAL];
      int i;
      
      MEMCPY(break_usage, usage, MAX_LOCAL);

      /* Find the usage from the loop */

      MEMSET(loop_usage, 0, MAX_LOCAL);

      MEMCPY(continue_usage, usage, MAX_LOCAL);

      find_usage(CDR(n), loop_usage, switch_u, continue_usage, break_usage,
		 catch_u);
      if (CDAR(n)->token == F_LOCAL) {
	if (!(CDAR(n)->u.integer.b)) {
	  loop_usage[CDAR(n)->u.integer.a] = 0;
	}
      } else if (CDAR(n)->token == F_LVALUE_LIST) {
	find_usage(CDAR(n), loop_usage, switch_u, cont_u, break_u, catch_u);
      }

      for(i=0; i < MAX_LOCAL; i++) {
	usage[i] |= loop_usage[i];
      }

      find_usage(CAAR(n), usage, switch_u, cont_u, break_u, catch_u);
      return;
    }

  case F_LOCAL:
    /* Use of local variable. */
    if (!n->u.integer.b) {
      /* Recently used, and used at all */
      usage[n->u.integer.a] = 3;
    }
    return;

  default:
    if (cdr_is_node(n)) {
      find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
    }
    if (car_is_node(n)) {
      find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
    }
    return;
  }
}

/* Note: Always builds a new tree. */
static node *low_localopt(node *n,
			  unsigned char *usage,
			  unsigned char *switch_u,
			  const unsigned char *cont_u,
			  const unsigned char *break_u,
			  const unsigned char *catch_u)
{
  node *car, *cdr;

  if (!n)
    return NULL;
  
  switch(n->token) {
    /* FIXME: Does not support F_LOOP yet. */
  case F_ASSIGN:
    if ((CDR(n)->token == F_LOCAL) && (!CDR(n)->u.integer.b)) {
      /* Assignment of local variable */
      if (!(usage[CDR(n)->u.integer.a] & 1)) {
	/* Value isn't used. */
	struct pike_type *ref_type;
	MAKE_CONSTANT_TYPE(ref_type, tOr(tComplex, tString));
	if (!match_types(CDR(n)->type, ref_type)) {
	  /* The variable doesn't hold a refcounted value. */
	  free_type(ref_type);
	  return low_localopt(CAR(n), usage, switch_u, cont_u,
			      break_u, catch_u);
	}
	free_type(ref_type);
      }
      usage[CDR(n)->u.integer.a] = 0;
      cdr = CDR(n);
      ADD_NODE_REF(cdr);
    } else if (CDR(n)->token == F_ARRAY_LVALUE) {
      cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
    } else {
      cdr = CDR(n);
      ADD_NODE_REF(cdr);
    }
    return mknode(F_ASSIGN, low_localopt(CAR(n), usage, switch_u, cont_u,
					 break_u, catch_u), cdr);

  case F_SSCANF:
    {
      int i;
      
      /* catch_usage is restored if sscanf throws an error. */
      for (i=0; i < MAX_LOCAL; i++) {
	usage[i] |= catch_u[i];
      }
      /* Only the first two arguments are evaluated. */
      if (CAR(n) && CDAR(n)) {
	cdr = low_localopt(CDDAR(n), usage, switch_u, cont_u, break_u, catch_u);
	car = low_localopt(CADAR(n), usage, switch_u, cont_u, break_u, catch_u);
	
	if (CDR(n)) {
	  ADD_NODE_REF(CDR(n));
	}
	return mknode(F_SSCANF, mknode(':', CAAR(n),
				       mknode(F_ARG_LIST, car, cdr)), CDR(n));
      }
      ADD_NODE_REF(n);
      return n;
    }

  case F_CATCH:
    {
      unsigned char catch_usage[MAX_LOCAL];
      int i;

      MEMCPY(catch_usage, usage, MAX_LOCAL);
      car = low_localopt(CAR(n), usage, switch_u, cont_u, catch_usage,
			 catch_usage);
      for(i=0; i < MAX_LOCAL; i++) {
	usage[i] |= catch_usage[i];
      }
      return mknode(F_CATCH, car, 0);
    }
    break;

  case F_AUTO_MAP:
  case F_APPLY:
    {
      int i;

      /* catch_usage is restored if the function throws an error. */
      for (i=0; i < MAX_LOCAL; i++) {
	usage[i] |= catch_u[i];
      }
      cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
      car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
      return mknode(n->token, car, cdr);
    }

  case F_LVALUE_LIST:
    cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
    if (CAR(n)) {
      if ((CAR(n)->token == F_LOCAL) && (!CAR(n)->u.integer.b)) {
	/* Array assignment of local variable. */
	if (!(usage[CDR(n)->u.integer.a] & 1)) {
	  /* Variable isn't used. */
	  /* FIXME: Warn? */
	}
	usage[CAR(n)->u.integer.a] = 0;
      }
      ADD_NODE_REF(CAR(n));
    }
    return mknode(F_LVALUE_LIST, CAR(n), cdr);

  case F_ARRAY_LVALUE:
    return mknode(F_ARRAY_LVALUE, low_localopt(CAR(n), usage, switch_u, cont_u,
					       break_u, catch_u), 0);

    

  case F_CAST:
    return mkcastnode(n->type, low_localopt(CAR(n), usage, switch_u, cont_u,
					    break_u, catch_u));

  case F_SOFT_CAST:
    return mksoftcastnode(n->type, low_localopt(CAR(n), usage, switch_u,
						cont_u, break_u, catch_u));

  case F_CONTINUE:
    MEMCPY(usage, cont_u, MAX_LOCAL);
    ADD_NODE_REF(n);
    return n;

  case F_BREAK:
    MEMCPY(usage, break_u, MAX_LOCAL);
    ADD_NODE_REF(n);
    return n;

  case F_DEFAULT:
  case F_CASE:
  case F_CASE_RANGE:
    {
      int i;

      cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
      car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
      for(i = 0; i < MAX_LOCAL; i++) {
	switch_u[i] |= usage[i];
      }
      return mknode(n->token, car, cdr);
    }

  case F_SWITCH:
    {
      unsigned char break_usage[MAX_LOCAL];
      unsigned char switch_usage[MAX_LOCAL];
      int i;

      MEMSET(switch_usage, 0, MAX_LOCAL);
      MEMCPY(break_usage, usage, MAX_LOCAL);

      cdr = low_localopt(CDR(n), usage, switch_usage, cont_u, break_usage,
			 catch_u);

      for(i = 0; i < MAX_LOCAL; i++) {
	usage[i] |= switch_usage[i];
      }

      car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
      return mknode(F_SWITCH, car, cdr);
    }

  case F_RETURN:
    MEMSET(usage, 0, MAX_LOCAL);
    /* FIXME: The function arguments should be marked "used", since
     * they are seen in backtraces.
     */
    return mknode(F_RETURN, low_localopt(CAR(n), usage, switch_u, cont_u,
					 break_u, catch_u), 0);

  case F_LOR:
  case F_LAND:
    {
      unsigned char trail_usage[MAX_LOCAL];
      int i;

      MEMCPY(trail_usage, usage, MAX_LOCAL);

      cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);

      for(i=0; i < MAX_LOCAL; i++) {
	usage[i] |= trail_usage[i];
      }

      car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u);

      return mknode(n->token, car, cdr);
    }

  case '?':
    {
      unsigned char cadr_usage[MAX_LOCAL];
      unsigned char cddr_usage[MAX_LOCAL];
      int i;

      MEMCPY(cadr_usage, usage, MAX_LOCAL);
      MEMCPY(cddr_usage, usage, MAX_LOCAL);

      car = low_localopt(CADR(n), cadr_usage, switch_u, cont_u, break_u,
			 catch_u);
      cdr = low_localopt(CDDR(n), cddr_usage, switch_u, cont_u, break_u,
			 catch_u);

      for (i=0; i < MAX_LOCAL; i++) {
	usage[i] = cadr_usage[i] | cddr_usage[i];
      }
      cdr = mknode(':', car, cdr);
      car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
      return mknode('?', car, cdr);
    }
    
  case F_DO:
    {
      unsigned char break_usage[MAX_LOCAL];
      unsigned char continue_usage[MAX_LOCAL];
      int i;

      MEMCPY(break_usage, usage, MAX_LOCAL);

      /* Find the usage from the loop */
      find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);

      MEMCPY(continue_usage, usage, MAX_LOCAL);

      find_usage(CAR(n), usage, switch_u, continue_usage, break_usage,
		 catch_u);

      for (i = 0; i < MAX_LOCAL; i++) {
	usage[i] |= break_usage[i];
      }

      cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_usage,
			 catch_u);

      MEMCPY(continue_usage, usage, MAX_LOCAL);

      car = low_localopt(CAR(n), usage, switch_u, continue_usage, break_usage,
			 catch_u);

      return mknode(F_DO, car, cdr);
    }

  case F_FOR:
    {
      unsigned char loop_usage[MAX_LOCAL];
      unsigned char break_usage[MAX_LOCAL];
      unsigned char continue_usage[MAX_LOCAL];
      int i;

      MEMCPY(break_usage, usage, MAX_LOCAL);

      /*
       * if (a A|B) {
       *     B
       *   do {
       *       B
       *     c;
       *   continue:
       *       D
       *     b;
       *       C
       *   } while (a A|B);
       *     A
       * }
       * break:
       *   A
       */

      /* Find the usage from the loop. */

      MEMSET(loop_usage, 0, MAX_LOCAL);

      find_usage(CAR(n), loop_usage, switch_u, cont_u, break_u, catch_u);
      if (CDR(n)) {
	find_usage(CDDR(n), loop_usage, switch_u, cont_u, break_usage,
		   catch_u);

	MEMCPY(continue_usage, loop_usage, MAX_LOCAL);

	find_usage(CADR(n), loop_usage, switch_u, continue_usage, break_usage,
		   catch_u);
      }

      for (i = 0; i < MAX_LOCAL; i++) {
	usage[i] |= loop_usage[i];
      }

      /* The last thing to be evaluated is the conditional */
      car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u);

      if (CDR(n)) {
	node *cadr, *cddr;

	/* The incrementor */
	cddr = low_localopt(CDDR(n), usage, switch_u, cont_u, break_usage,
			    catch_u);

	MEMCPY(continue_usage, usage, MAX_LOCAL);

	/* The body */
	cadr = low_localopt(CADR(n), usage, switch_u, continue_usage,
			    break_usage, catch_u);
	cdr = mknode(':', cadr, cddr);
      } else {
	cdr = 0;
      }

      for (i = 0; i < MAX_LOCAL; i++) {
	usage[i] |= break_usage[i];
      }

      /* The conditional is also the first thing to be evaluated. */
      find_usage(car, usage, switch_u, cont_u, break_u, catch_u);

      return mknode(F_FOR, car, cdr);
    }

  case F_FOREACH:
    {
      unsigned char loop_usage[MAX_LOCAL];
      unsigned char break_usage[MAX_LOCAL];
      unsigned char continue_usage[MAX_LOCAL];
      int i;

      MEMCPY(break_usage, usage, MAX_LOCAL);

      /*
       *   D
       * arr = copy_value(arr);
       * int i = 0;
       *   A|B
       * while (i < sizeof(arr)) {
       *     B
       *   loopvar = arr[i];
       *     C
       *   body;
       *   continue:
       *     A|B
       * }
       * break:
       *   A
       */

      /* Find the usage from the loop */
      MEMSET(loop_usage, 0, MAX_LOCAL);

      MEMCPY(continue_usage, usage, MAX_LOCAL);

      find_usage(CDR(n), loop_usage, switch_u, continue_usage, break_usage,
		 catch_u);
      if (CDAR(n)->token == F_LOCAL) {
	if (!(CDAR(n)->u.integer.b)) {
	  loop_usage[CDAR(n)->u.integer.a] = 0;
	}
      } else if (CDAR(n)->token == F_LVALUE_LIST) {
	find_usage(CDAR(n), loop_usage, switch_u, cont_u, break_u, catch_u);
      }

      for (i = 0; i < MAX_LOCAL; i++) {
	usage[i] |= loop_usage[i];
      }

      MEMCPY(continue_usage, usage, MAX_LOCAL);
      cdr = low_localopt(CDR(n), usage, switch_u, continue_usage, break_usage,
			 catch_u);
      if (CDAR(n)->token == F_LOCAL) {
	if (!(CDAR(n)->u.integer.b)) {
	  usage[CDAR(n)->u.integer.a] = 0;
	}
      } else if (CDAR(n)->token == F_LVALUE_LIST) {
	find_usage(CDAR(n), usage, switch_u, cont_u, break_u, catch_u);
      }

      for (i = 0; i < MAX_LOCAL; i++) {
	usage[i] |= break_usage[i];
      }

      car = low_localopt(CAAR(n), usage, switch_u, cont_u, break_u, catch_u);
      ADD_NODE_REF(CDAR(n));
      return mknode(F_FOREACH, mknode(F_VAL_LVAL, car, CDAR(n)), cdr);
    }

  case F_LOCAL:
    /* Use of local variable. */
    if (!n->u.integer.b) {
      /* Recently used, and used at all */
      usage[n->u.integer.a] = 3;
    }
    ADD_NODE_REF(n);
    return n;

  default:
    if (cdr_is_node(n)) {
      cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
      return mknode(n->token, low_localopt(CAR(n), usage, switch_u, cont_u,
					   break_u, catch_u),
		    cdr);
    }
    if (car_is_node(n)) {
      ADD_NODE_REF(CDR(n));
      return mknode(n->token, low_localopt(CAR(n), usage, switch_u, cont_u,
					   break_u, catch_u),
		    CDR(n));
    }
    ADD_NODE_REF(n);
    return n;
  }
}

static node *localopt(node *n)
{
  unsigned char usage[MAX_LOCAL];
  unsigned char b_usage[MAX_LOCAL];
  unsigned char c_usage[MAX_LOCAL];
  unsigned char s_usage[MAX_LOCAL];
  unsigned char catch_usage[MAX_LOCAL];
  node *n2;

  MEMSET(usage, 0, MAX_LOCAL);
  MEMSET(b_usage, 0, MAX_LOCAL);
  MEMSET(c_usage, 0, MAX_LOCAL);
  MEMSET(s_usage, 0, MAX_LOCAL);
  MEMSET(catch_usage, 0, MAX_LOCAL);

  n2 = low_localopt(n, usage, s_usage, c_usage, b_usage, catch_usage);

#ifdef PIKE_DEBUG
  if (l_flag > 0) {
    if ((n2 != n) || (l_flag > 4)) {
      fputs("\nBefore localopt: ", stderr);
      print_tree(n);

      fputs("After localopt:  ", stderr);
      print_tree(n2);
    }
  }
#endif /* PIKE_DEBUG */

  free_node(n);
  return n2;
}
#endif /* SHARED_NODES */

static void optimize(node *n)
{
  node *tmp1, *tmp2, *tmp3;
  struct compilation *c = THIS_COMPILATION;
  struct pike_string *save_file =
    dmalloc_touch(struct pike_string *, c->lex.current_file);
  INT32 save_line = c->lex.current_line;

  do
  {
    if(car_is_node(n) && !(CAR(n)->node_info & OPT_OPTIMIZED))
    {
      CAR(n)->parent = n;
      n = CAR(n);
      continue;
    }
    if(cdr_is_node(n) && !(CDR(n)->node_info & OPT_OPTIMIZED))
    {
      CDR(n)->parent = n;
      n = CDR(n);
      continue;
    }

    c->lex.current_line = n->line_number;
    c->lex.current_file = dmalloc_touch(struct pike_string *, n->current_file);

    n->tree_info = n->node_info;
    if(car_is_node(n)) n->tree_info |= CAR(n)->tree_info;
    if(cdr_is_node(n)) n->tree_info |= CDR(n)->tree_info;

    if(!n->parent) break;
    
    if(n->tree_info & (OPT_NOT_CONST|
		       OPT_SIDE_EFFECT|
		       OPT_EXTERNAL_DEPEND|
		       OPT_ASSIGNMENT|
		       OPT_RETURN|
		       OPT_FLAG_NODE))
    {
      if(car_is_node(n) &&
	 !(CAR(n)->tree_info & (OPT_NOT_CONST|
				OPT_SIDE_EFFECT|
				OPT_EXTERNAL_DEPEND|
				OPT_ASSIGNMENT|
				OPT_RETURN|
				OPT_FLAG_NODE)) &&
	 (CAR(n)->tree_info & OPT_TRY_OPTIMIZE) &&
	 CAR(n)->token != F_VAL_LVAL)
      {
	_CAR(n) = eval(CAR(n));
	if(CAR(n)) CAR(n)->parent = n;
	zapp_try_optimize(CAR(n)); /* avoid infinite loops */
	continue;
      }
      if(cdr_is_node(n) &&
	 !(CDR(n)->tree_info & (OPT_NOT_CONST|
				OPT_SIDE_EFFECT|
				OPT_EXTERNAL_DEPEND|
				OPT_ASSIGNMENT|
				OPT_RETURN|
				OPT_FLAG_NODE)) &&
	 (CDR(n)->tree_info & OPT_TRY_OPTIMIZE))
      {
	_CDR(n) = eval(CDR(n));
	if(CDR(n)) CDR(n)->parent = n;
	zapp_try_optimize(CDR(n)); /* avoid infinite loops */
	continue;
      }
    }
    if (!n->type || (n->node_info & OPT_TYPE_NOT_FIXED)) {
      fix_type_field(n);
    }
    debug_malloc_touch(n->type);

#ifdef PIKE_DEBUG
    if(l_flag > 3 && n)
    {
      fprintf(stderr,"Optimizing (tree info=%04x):",n->tree_info);
      print_tree(n);
    }
#endif    

    switch(n->token)
    {
#include "treeopt.h"
    use_car:
      ADD_NODE_REF2(CAR(n), tmp1 = CAR(n));
      goto use_tmp1;

    use_cdr:
      ADD_NODE_REF2(CDR(n), tmp1 = CDR(n));
      goto use_tmp1;

    zap_node:
      tmp1 = 0;
      goto use_tmp1;

    use_tmp1:
#ifdef PIKE_DEBUG
      if (l_flag > 4) {
	fputs("Optimized: ", stderr);
	print_tree(n);
	fputs("Result:    ", stderr);
	print_tree(tmp1);
      }
#endif /* PIKE_DEBUG */

      if(CAR(n->parent) == n)
	_CAR(n->parent) = tmp1;
      else
	_CDR(n->parent) = tmp1;

      if (!tmp1 || (tmp1->type != n->type)) {
	n->parent->node_info |= OPT_TYPE_NOT_FIXED;
      }

      if(tmp1)
	tmp1->parent = n->parent;
      else
	tmp1 = n->parent;

      free_node(n);
      n = tmp1;

#ifdef PIKE_DEBUG
      if(l_flag > 3)
      {
	fputs("Result:    ", stderr);
	print_tree(n);
      }
#endif    
      continue;

    }
    n->node_info |= OPT_OPTIMIZED;
    n=n->parent;
  }while(n);

  c->lex.current_line = save_line;
  c->lex.current_file = dmalloc_touch(struct pike_string *, save_file);
}

void optimize_node(node *n)
{
  if(n &&
     Pike_compiler->compiler_pass==2 &&
     (n->node_info & OPT_TRY_OPTIMIZE))
  {
    optimize(n);
    check_tree(n,0);
  }
}

struct timer_oflo
{
  INT32 counter;
  int yes;
};

static void check_evaluation_time(struct callback *cb,void *tmp,void *ignored)
{
  struct timer_oflo *foo=(struct timer_oflo *)tmp;
  if(foo->counter-- < 0)
  {
    foo->yes=1;
    pike_throw();
  }
}

ptrdiff_t eval_low(node *n,int print_error)
{
  unsigned INT16 num_strings, num_constants;
  unsigned INT32 num_program;
  size_t jump;
  struct svalue *save_sp = Pike_sp;
  ptrdiff_t ret;
  struct program *prog = Pike_compiler->new_program;
#ifdef PIKE_USE_MACHINE_CODE
  size_t num_relocations;
#endif /* PIKE_USE_MACHINE_CODE */

#ifdef PIKE_DEBUG
  if(l_flag > 3 && n)
  {
    fprintf(stderr,"Evaluating (tree info=%x):",n->tree_info);
    print_tree(n);
  }
#endif

  if(Pike_compiler->num_parse_error) {
    return -1;
  }

  num_strings = prog->num_strings;
  num_constants = prog->num_constants;
  num_program = prog->num_program;
#ifdef PIKE_USE_MACHINE_CODE
  num_relocations = prog->num_relocations;
#endif /* PIKE_USE_MACHINE_CODE */

  jump = docode(dmalloc_touch(node *, n));

  ret=-1;
  if(!Pike_compiler->num_parse_error)
  {
    struct callback *tmp_callback;
    struct timer_oflo foo;

    /* This is how long we try to optimize before giving up... */
    foo.counter=10000;
    foo.yes=0;

#ifdef PIKE_USE_MACHINE_CODE
    make_area_executable ((char *) (prog->program + num_program),
			  (prog->num_program - num_program) *
			  sizeof (prog->program[0]));
#endif

    tmp_callback=add_to_callback(&evaluator_callbacks,
				 check_evaluation_time,
				 (void *)&foo,0);
				 
    if(apply_low_safe_and_stupid(Pike_compiler->fake_object, jump))
    {
      /* Assume the node will throw errors at runtime too. */
      n->tree_info |= OPT_SIDE_EFFECT;
      n->node_info |= OPT_SIDE_EFFECT;
      if(print_error)
	/* Generate error message */
	if(!Pike_compiler->catch_level)
	  handle_compile_exception("Error evaluating constant.");
	else {
	  free_svalue(&throw_value);
	  mark_free_svalue (&throw_value);
	}
      else {
	free_svalue(&throw_value);
	mark_free_svalue (&throw_value);
      }
    }else{
      if(foo.yes)
	pop_n_elems(Pike_sp-save_sp);
      else
	ret=Pike_sp-save_sp;
      n->tree_info |= OPT_SAFE;
    }

    remove_callback(tmp_callback);
  }

  while(prog->num_strings > num_strings)
  {
    prog->num_strings--;
    free_string(prog->strings[prog->num_strings]);
  }

  while(prog->num_constants > num_constants)
  {
    struct program_constant *p_const;

    prog->num_constants--;

    p_const = prog->constants + prog->num_constants;

    free_svalue(&p_const->sval);
#if 0
    if (p_const->name) {
      free_string(p_const->name);
      p_const->name = NULL;
    }
#endif /* 0 */
  }

#ifdef PIKE_USE_MACHINE_CODE
  prog->num_relocations = num_relocations;

#ifdef VALGRIND_DISCARD_TRANSLATIONS
  /* We won't use this machine code any more... */
  VALGRIND_DISCARD_TRANSLATIONS(prog->program + num_program,
				(prog->num_program - num_program)*sizeof(PIKE_OPCODE_T));
#endif /* VALGRIND_DISCARD_TRANSLATIONS */
#endif /* PIKE_USE_MACHINE_CODE */

  prog->num_program = num_program;

  return ret;
}

static node *eval(node *n)
{
  node *new;
  ptrdiff_t args;

  if(!is_const(n) || n->node_info & OPT_FLAG_NODE)
    return n;
  
  args=eval_low(n,0);

  switch(args)
  {
  case -1:
    return n;
    break;

  case 0:
    if(Pike_compiler->catch_level) return n;
    free_node(n);
    n=0;
    break;

  case 1:
    if(Pike_compiler->catch_level && SAFE_IS_ZERO(Pike_sp-1))
    {
      pop_stack();
      return n;
    }
    if (n->token == F_SOFT_CAST) {
      new = mksoftcastnode(n->type, mksvaluenode(Pike_sp-1));
    } else {
      new = mksvaluenode(Pike_sp-1);
      if (n->type && (!new->type || ((n->type != new->type) &&
				     pike_types_le(n->type,new->type)))) {
	if (new->type)
	  free_type(new->type);
	copy_pike_type(new->type, n->type);
      }
    }
    free_node(n);
    n = new;
    pop_stack();
    break;

  default:
    if (n->token != F_SOFT_CAST) {
      free_node(n);
      n=NULL;
      while(args--)
      {
	n=mknode(F_ARG_LIST,mksvaluenode(Pike_sp-1),n);
	pop_stack();
      }
    } else {
      node *nn = n;
      n = NULL;
      while(args--)
      {
	n=mknode(F_ARG_LIST,mksvaluenode(Pike_sp-1),n);
	pop_stack();
      }
      n = mksoftcastnode(nn->type, n);
      free_node(nn);
    }
  }
  return dmalloc_touch(node *, n);
}

INT32 last_function_opt_info;

/* FIXME: Ought to use parent pointer to avoid recursion. */
static int stupid_args(node *n, int expected,int vargs)
{
  if(!n) return expected;

  fatal_check_c_stack(16384);

  switch(n->token)
  {
  case F_PUSH_ARRAY:
    if(!vargs) return -1;

    if(stupid_args(CAR(n), expected,vargs) == expected+1)
      return 65535;
    return -1;

  case F_ARG_LIST:
    expected=stupid_args(CAR(n), expected,vargs);
    if(expected==-1) return -1;
    return stupid_args(CDR(n), expected,vargs);
  case F_LOCAL:
    return (!n->u.integer.b && n->u.integer.a==expected) ? expected + 1 : -1;
  default:
    return -1;
  }
}

/* FIXME: Ought to use parent pointer to avoid recursion. */
static int is_null_branch(node *n)
{
  if(!n) return 1;

  fatal_check_c_stack(16384);

  if((n->token==F_CAST && n->type == void_type_string) ||
     n->token == F_POP_VALUE)
    return is_null_branch(CAR(n));
  if(n->token==F_ARG_LIST)
    return is_null_branch(CAR(n)) && is_null_branch(CDR(n));
  return 0;
}

static struct svalue *is_stupid_func(node *n,
				     int args,
				     int vargs,
				     struct pike_type *type)
{
  int tmp;
  while(1)
  {
    if(!n) return 0;

    if(n->token == F_ARG_LIST)
    {
      if(is_null_branch(CAR(n)))
	n=CDR(n);
      else
	n=CAR(n);
      continue;
    }

    if((n->token == F_CAST && n->type == void_type_string) ||
       n->token == F_POP_VALUE)
    {
      n=CAR(n);
      continue;
    }
    break;
  }

  if(!n || n->token != F_RETURN) return 0;
  n=CAR(n);

  if(!n || n->token != F_APPLY) return 0;

  tmp=stupid_args(CDR(n),0,vargs);
  if(!(vargs?tmp==65535:tmp==args)) return 0;

  n=CAR(n);
  if(!n || n->token != F_CONSTANT) return 0;

  if((count_arguments(n->type) < 0) == !vargs)
    return 0;
  
  if(minimum_arguments(type) < minimum_arguments(n->type))
    return 0;

  return &n->u.sval;
}

int dooptcode(struct pike_string *name,
	      node *n,
	      struct pike_type *type,
	      int modifiers)
{
  union idptr tmp;
  int args, vargs, ret;
  struct svalue *foo;

  CHECK_COMPILER();

  optimize_node(n);

  check_tree(n, 0);

#ifdef PIKE_DEBUG
  if(a_flag > 1)
    fprintf(stderr, "Doing function '%s' at %lx\n", name->str,
	    DO_NOT_WARN((unsigned long)PIKE_PC));
#endif

  args=count_arguments(type);
  if(args < 0) 
  {
    args=~args;
    vargs=IDENTIFIER_VARARGS;
  }else{
    vargs=0;
  }

  if(Pike_compiler->compiler_frame->lexical_scope & SCOPE_SCOPED)
    vargs|=IDENTIFIER_SCOPED;

  if(Pike_compiler->compiler_frame->lexical_scope & SCOPE_SCOPE_USED)
    vargs|=IDENTIFIER_SCOPE_USED;

#ifdef PIKE_DEBUG
  if(a_flag > 5)
    fprintf(stderr, "Extra identifier flags:0x%02x\n", vargs);
#endif

  if(Pike_compiler->compiler_pass==1)
  {
    tmp.offset=-1;
#ifdef PIKE_DEBUG
    if(a_flag > 4)
    {
      fputs("Making prototype (pass 1) for: ", stderr);
      print_tree(n);
    }
#endif
  }else{
#if defined(SHARED_NODES) && 0
    /* Try the local variable usage analyser. */
    n = localopt(n);
    /* Try optimizing some more. */
    optimize(n);
#endif /* SHARED_NODES && 0 */
    n = mknode(F_ARG_LIST, n, 0);
    
    if((foo=is_stupid_func(n, args, vargs, type)))
    {
      if(foo->type == T_FUNCTION && foo->subtype==FUNCTION_BUILTIN)
      {
	tmp.c_fun=foo->u.efun->function;
	if(tmp.c_fun != f_destruct &&
	   tmp.c_fun != f_this_object &&
	   tmp.c_fun != f_backtrace)
	{
#ifdef PIKE_DEBUG
	  struct compilation *c = THIS_COMPILATION;

	  if(a_flag > 1)
	    fprintf(stderr,"%s:%d: IDENTIFIER OPTIMIZATION %s == %s\n",
		    c->lex.current_file->str,
		    c->lex.current_line,
		    name->str,
		    foo->u.efun->name->str);
#endif
	  ret=define_function(name,
			      type,
			      (unsigned INT16)modifiers,
			      (unsigned INT8)(IDENTIFIER_C_FUNCTION |
					      IDENTIFIER_HAS_BODY |
					      vargs),
			      &tmp,
			      foo->u.efun->flags);
	  free_node(n);
	  return ret;
	}
      }
    }

    tmp.offset=PIKE_PC;
    Pike_compiler->compiler_frame->num_args=args;
  
#ifdef PIKE_DEBUG
    if(a_flag > 2)
    {
      fputs("Coding: ", stderr);
      print_tree(n);
    }
#endif
    if(!Pike_compiler->num_parse_error)
    {
      extern int remove_clear_locals;
      remove_clear_locals=args;
      if(vargs) remove_clear_locals++;
      tmp.offset=do_code_block(n);
      remove_clear_locals=0x7fffffff;
    }
  }
  
  ret=define_function(name,
		      type,
		      (unsigned INT16)modifiers,
		      (unsigned INT8)(IDENTIFIER_PIKE_FUNCTION |
				      IDENTIFIER_HAS_BODY |
				      vargs),
		      Pike_compiler->num_parse_error?NULL:&tmp,
		      (unsigned INT16)
		      (Pike_compiler->compiler_frame->opt_flags));


#ifdef PIKE_DEBUG
  if(a_flag > 1)
    fprintf(stderr,"Identifer = %d\n",ret);
#endif

  free_node(n);
  return ret;
}