%include "comp_warning"
%include "lpc_compiler/pre"
%include "token_defs"

/* This is to make emacs edit this in C mode: -*-C-*- */
all: program;

program: program def possible_semi_colon
       |	 /* empty */ ;

possible_semi_colon: /* empty */
                   | ';'
	{
#line 9 "lpc_compiler/grammar"
	 yyerror("Extra ';'. Ignored."); 
	};

inheritance: type_modifier_list L_INHERIT string_con1 ';'
		{
		    struct object *ob;
		    struct inherit inherit;
		    int init_func;
		 
		    ob = find_object2($3);
		    if (ob == 0) {
			inherit_file = $3;
			/* Return back to load_object() */
			YYACCEPT;
		    }
		    FREE($3);
		    inherit.prog = ob->prog;
		    inherit.function_index_offset =
			mem_block[A_FUNCTIONS].current_size /
			    sizeof (struct function);
		    inherit.variable_index_offset =
			mem_block[A_VARIABLES].current_size /
			    sizeof (struct variable);
		    add_to_mem_block(A_INHERITS, (char *)&inherit, sizeof inherit);
		    copy_variables(ob->prog, $1);
		    init_func = copy_functions(ob->prog, $1);
		    if (init_func > 0) {
			struct function *funp;
			int f;

			f = define_new_function("::__INIT", 0, 0, 0, 0, 0);
			funp = FUNCTION(f);
			funp->offset = mem_block[A_INHERITS].current_size /
			    sizeof (struct inherit) - 1;
			funp->flags = NAME_STRICT_TYPES |
			    NAME_INHERITED | NAME_HIDDEN;
			funp->type = TYPE_VOID;
			funp->function_index_offset = init_func;
			start_initializer();
			/* Actual number of arguments is zero */
			ins_ext_cfun("C_CALL",0,0);
			BACKSPACE(1);
			ins_string_with_num(",%i)",f);
			insert_pop_value();
			ins_string(";\n");
			end_initializer();
		    }
		}

real: L_REAL
    {
      $$.type = TYPE_REAL;
      $$.iscon = 1;
      $$.addr = (long) stack_sp;
      stack_push_real($1);
    }
    ;

number: L_NUMBER
	{
	  if ($1 == 0)
	    $$.type = TYPE_ANY;
	  else
	    $$.type = TYPE_NUMBER;
	  $$.iscon = 1;
	  $$.addr = (long) stack_sp;
	  stack_push_number($1);
	} ;

optional_star: /* empty */ { $$ = 0; } | '*' { $$ = TYPE_MOD_POINTER; } ;

block_or_semi: block { $$ = 0; } | ';' { $$ = ';'; } ;

not_efun_ident: 
        L_DEFINED_NAME
            {
	      $$ = get_defined_name(&($1));
	    }
     |  L_IDENTIFIER
     |  L_ASM
            {
	      $$ = string_copy("asm");
	    }
     ;

identifier: not_efun_ident
	  | L_EFUN { $$ = string_copy("efun"); }

def: type optional_star identifier
        {
	  ins_string("\nstatic int _lpc_");
	  ins_string($3);
	  ins_string("(svalue *ret,");

	    if ($1 & TYPE_MOD_MASK) {
		exact_types = $1 | $2;
	    } else {
		if (pragmas & PRAGMA_STRICT_TYPES)
		    yyerror("\"#pragma strict_types\" requires type of function");
		/* force strict types - no more compat mode */
#ifdef STRICT_TYPE_CHECKING
		exact_types = TYPE_ANY; /* default to return type of mixed */
#else
		exact_types = 0;
#endif
	    }
	}
	'(' argument ')'
	{
	  current_num_arg = $6;
	  /* Arguments end in commas.  Snarf the last one. */
	  BACKSPACE(1);
	  ins_char(')');
	  dirty_register = -1;
	  /* Save where we are, the +2 is for the {\n added at the start
             of the block */
	  $<number>$ = CURRENT_PROGRAM_SIZE + 2;
	    /*
	     * Define a prototype. If it is a real function, then the
	     * prototype will be replaced below.
	     */
	  define_new_function($3, $6, 0, 0,
			      NAME_UNDEFINED|NAME_PROTOTYPE, $1 | $2);
	  }
        block_or_semi
	{
	    /* Either a prototype or a block */
	    if ($9 == ';') {
	      ins_string(";\n");
	    } else {
	      /* insert the local definitions */
	      insert_locals($<number>8,
			    current_number_of_locals-$6, dirty_register+1);
	      define_new_function($3, $6, 0, 0, 0, $1 | $2);
		/* Snarf the closing brace created by the block, so we can
		   insert the return */
		BACKSPACE(2);
		ins_string("c_return(ret,&const0);\n}\n");
		needs_comma = 0;
	    }
	    free_all_local_names();
	    FREE($3);		/* Value was copied above */
	}
   | type name_list ';' { if ($1 == 0) yyerror("Missing type"); }
   | inheritance ;

new_arg_name: type optional_star L_IDENTIFIER
	{
	    if (exact_types && $1 == 0) {
		yyerror("Missing type for argument");
		add_local_name($3, TYPE_ANY);/* Supress more errors */
	    } else {
		add_local_name($3, $1 | $2);
	    }
	}
   | type optional_star L_EFUN
	{
	    if (exact_types && $1 == 0) {
		yyerror("Missing type for argument");
		add_local_name(string_copy("efun"), TYPE_ANY);/* Supress more errors */
	    } else {
		add_local_name(string_copy("efun"), $1 | $2);
	    }
	}
   | type optional_star L_ASM
	{
	    if (exact_types && $1 == 0) {
		yyerror("Missing type for argument");
		add_local_name(string_copy("asm"), TYPE_ANY);/* Supress more errors */
	    } else {
		add_local_name(string_copy("asm"), $1 | $2);
	    }
	}
	  | type optional_star L_DEFINED_NAME
		{
		  if ($3.local_num != -1)
		    yyerror("Illegal to redeclare local name");
		  else {
		    add_local_name(get_defined_name(&($3)), $1 | $2);
		  }
		}
          ;


argument: /* empty */ { $$ = 0; }
	  | argument_list ;

argument_list: new_arg_name { $$ = 1; }
	     | argument_list ',' new_arg_name { $$ = $1 + 1; } ;

type_modifier: L_NO_MASK { $$ = TYPE_MOD_NO_MASK; }
	     | L_STATIC { $$ = TYPE_MOD_STATIC; }
	     | L_PRIVATE { $$ = TYPE_MOD_PRIVATE; }
	     | L_PUBLIC { $$ = TYPE_MOD_PUBLIC; }
	     | L_VARARGS { $$ = TYPE_MOD_VARARGS; }
	     | L_PROTECTED { $$ = TYPE_MOD_PROTECTED; } ;

type_modifier_list: /* empty */ { $$ = 0; }
		  | type_modifier type_modifier_list { $$ = $1 | $2; } ;

type: type_modifier_list opt_basic_type { 
  $$ = $1 | $2;
  current_type = $$;
} ;

cast: '(' basic_type optional_star ')'
	{
	    $$ = $2 | $3;
	} ;

opt_basic_type: basic_type | /* empty */ { $$ = TYPE_UNKNOWN; } ;

basic_type: L_STATUS { $$ = TYPE_NUMBER; current_type = $$; }
	| L_INT { $$ = TYPE_NUMBER; current_type = $$; }
	| L_FLOAT { $$ = TYPE_REAL; current_type = $$; }
	| L_STRING_DECL { $$ = TYPE_STRING; current_type = $$; }
	| L_BUFFER_DECL { $$ = TYPE_BUFFER; current_type = $$; }
	| L_OBJECT { $$ = TYPE_OBJECT; current_type = $$; }
	| L_MAPPING { $$ = TYPE_MAPPING; current_type = $$; }
	| L_FUNCTION { $$ = TYPE_FUNCTION; current_type = $$; }
	| L_VOID {$$ = TYPE_VOID; current_type = $$; }
	| L_MIXED { $$ = TYPE_ANY; current_type = $$; } ;

name_list: new_name
	 | new_name ',' name_list;

new_name: optional_star identifier
	{
	    define_variable($2, current_type | $1, 0);
	    FREE($2);
	}
	| optional_star identifier
	{
	    define_variable($2, current_type | $1, 0);
	    $<number>$ = verify_declared($2);
	    start_initializer();
	    stack_push_identifier($<number>$);
	}
	'=' expr0
	{
	    if (!compatible_types((current_type | $1) & TYPE_MOD_MASK, $5.type)){
		char buff[100];
		sprintf(buff, "Type mismatch %s when initializing %s",
			get_two_types(current_type | $1, $5.type), $2);
		yyerror(buff);
	    }
	    /* can't do by name b/c of backpatching */
	    ins_cfun_call(F_VOID_ASSIGN,2);
	    stack_pop();
	    generate_frees();
	    end_initializer();
	    FREE($2);
	} ;

block: '{' 
    { 
      ins_string("{\n");
    }
local_declarations statements '}'
    {
      ins_string("}\n");
#ifdef DEBUG
      check_for_garbage();
#endif
    }
  ;

local_declarations: /* empty */
		  | local_declarations basic_type local_name_list ';' ;

new_local_name: optional_star identifier
	{
	  int i;
	  i = add_local_name($2, current_type | $1);
	}
	| optional_star identifier {
	  int i;
	  i = add_local_name($2, current_type | $1);
	  stack_push_local(i);
        } '=' expr0
	{
	    if (!compatible_types((current_type | $1) & TYPE_MOD_MASK, $5.type)) {
		char buff[100];
		sprintf(buff, "Type mismatch %s when initializing %s",
			get_two_types(current_type | $1, $5.type), $2);
		yyerror(buff);
	      }
	    /* can't be done by name b/c of backpatching */
	    ins_cfun_call(F_VOID_ASSIGN,2);
	    stack_pop();
	    generate_frees();
	}
	;

local_name_list: new_local_name
	| new_local_name ',' local_name_list ;

statements: /* empty */
	  | statement statements
	  | error ';' ;

statement: comma_expr ';'
	{
	  insert_pop_value();
	  ins_string(";\n");
	}
	 | cond | while | do | for | switch | case | default | return ';' {
	   ins_string(";\n");
#ifdef DEBUG
	   check_for_garbage();
#endif
	 }
	 | block
         | asm_directive
  	 | /* empty */ ';'
	 | L_BREAK ';'
        {
	  ins_string("break;\n");
#ifdef DEBUG
	  check_for_garbage();
#endif
	}
	 | L_CONTINUE ';'
	{
	  ins_string("continue;\n");
#ifdef DEBUG
	  check_for_garbage();
#endif
	}
         ;

while:  L_WHILE {
           ins_string("while (\n");
        } '(' comma_expr ')'
	{
	  generate_truth_test();
	  ins_string("\n)\n");
	  needs_comma = 0;
	}
       statement

do: {
        ins_string("do\n");
    } L_DO statement {
      ins_string("while (\n");
    } L_WHILE '(' comma_expr ')' ';' {
      generate_truth_test();
      ins_string("\n);\n");
      needs_comma = 0;
    }

for: L_FOR '(' {
      ins_string("for (\n");
    } for_expr ';' {
      insert_pop_value();
      ins_string(";\n");
    } for_expr ';' {
      generate_truth_test();
      ins_string(";\n");
      needs_comma = 0;
    } for_expr ')' {
      insert_pop_value();
      ins_string("\n)\n");
      needs_comma = 0;
    } statement	

for_expr: /* EMPTY */
	{
	  stack_push_number(1);
	}
	| comma_expr;

switch: L_SWITCH {
      ins_string("switch (\n");
    } '(' comma_expr ')'
    {
      push_explicit(switch_kind);
      switch_kind = 0;
      do_comma();
      create_intermediates(1);
      push_explicit(CURRENT_PROGRAM_SIZE);
      ins_string("C_EVAL_NUMBER(");
      ins_arguments(1,0,0);
      last_expression = 0;
      ins_string(")\n)\n");
      needs_comma = 0;
    }
      statement
{
  if (switch_kind==T_STRING) {
    memcpy(mem_block[current_block].block + pop_address(), "C_EVAL_STRING", 13);
  } else pop_address();
  switch_kind = pop_address();
};

case: L_CASE case_label ':'
    {
      ins_string_with_num("case %i:\n",$2.key);
    }
    | L_CASE case_label L_RANGE case_label ':'
    {
      if ( $2.block != A_CASE_NUMBERS || $4.block != A_CASE_NUMBERS )
	yyerror("String case labels not allowed as range bounds");
      if ($2.key>$4.key) break;
      ins_string_with_num("case %i..",$2.key);
      ins_string_with_num("%i:\n",$4.key);
    } ;
	
case_label: constant {
  if ($1 && (switch_kind == T_STRING))
    yyerror("Mixed case label list not allowed");
  if ($$.key = $1) switch_kind = T_NUMBER;
  $$.block = A_CASE_NUMBERS;
}
| string_constant {
  if (switch_kind == T_NUMBER)
    yyerror("Mixed case label list not allowed");
  switch_kind = T_STRING;
  store_prog_string($1);
  $$.key = (int) $1;
  $$.block = A_CASE_STRINGS;
};

constant:
        constant '|' constant { $$ = $1 | $3; }
      | constant '^' constant { $$ = $1 ^ $3; }
      | constant '&' constant { $$ = $1 & $3; }
      | constant L_EQ constant { $$ = $1 == $3; }
      | constant L_NE constant { $$ = $1 != $3; }
      | constant '>'  constant { $$ = $1 >  $3; }
      | constant L_GE constant { $$ = $1 >= $3; }
      | constant '<'  constant { $$ = $1 <  $3; }
      | constant L_LE constant { $$ = $1 <= $3; } 
      | constant L_LSH constant { $$ = $1 << $3; }
      | constant L_RSH constant { $$ = $1 >> $3; }
      | constant '+' constant { $$ = $1 + $3; }
      | constant '-' constant { $$ = $1 - $3; }
      | constant '*' constant { $$ = $1 * $3; }
      | constant '%' constant
            { if ($3) $$ = $1 % $3; else yyerror("Modulo by zero"); }
      | constant '/' constant
            { if ($3) $$ = $1 / $3; else yyerror("Division by zero"); }
      | '(' constant ')' { $$ = $2; }
      | L_NUMBER
      | '-'   L_NUMBER { $$ = -$2; }
      | L_NOT L_NUMBER { $$ = !$2; }
      | '~'   L_NUMBER { $$ = ~$2; }
      ;

default: L_DEFAULT ':'
    {
      ins_string("default: ");
    } ;

comma_expr: expr0 { $$ = $1.type; }
          | comma_expr { insert_pop_value(); ins_string(",\n"); }
	',' expr0
	{ $$ = $4.type; } ;

comma_expr1: expr0 { $$ = $1; }
          | comma_expr1 { insert_pop_value(); ins_string(",\n"); }
	',' expr0
	{ $$ = $4; $$.iscon = 0; } ;

expr0:
       lvalue assign expr0  %prec '='
	{
	  /* set this up here so we can change it later */
	  $$.type = $3.type;
	  $$.addr = 0; $$.iscon = 0;
	  
	  if (exact_types && !compatible_types($1.type, $3.type) &&
	      !($1.type == TYPE_STRING && $3.type == TYPE_NUMBER &&
		$2 == F_ADD_EQ))
	    {
		char buf[1000];
		sprintf(buf, "Bad assignment %s.", get_two_types($1.type, $3.type));
		yyerror(buf);
	    }
	  if (($1.type == TYPE_REAL) && ($3.type == TYPE_NUMBER)) {
	    ins_cfun_call_by_name("c_to_float",1,0);
	    $$.type = $1.type;
	  } else if (($1.type == TYPE_NUMBER) && ($3.type == TYPE_REAL)) {
	    ins_cfun_call_by_name("c_to_int",1,0);
	    $$.type = $1.type;
	  }
	  /* can't be done by name b/c of back patching */
	  ins_cfun_call($2,2);
	}
     | error assign expr0  %prec '='
        { yyerror("Illegal LHS");  $$.type = TYPE_ANY; }

     | expr0 '?'
	{
	  generate_truth_test();
	  ins_string("\n? (\n");
	  needs_comma = 0;
	}
      expr0
	{
	  must_have_register();
	  /* save what register we're returning so we can use the same one
	     below */
	  $<number>$ = TOP->u.num;
	  if (TOP_NEEDS_FREE) {
	    /* remember we need to free this */
	    $<number>$ += 256;
	    MARK_NEEDS_NO_FREE(TOP->u.num);
	  }
	  generate_frees();
	  stack_pop();
	  ins_string("\n) : (\n");
	  needs_comma = 0;
	}
      ':' expr0  %prec '?'
        {
	  int dest_reg = $<number>5 & 255;
	  must_have_register();
	  generate_frees();
	  if (TOP->u.num != dest_reg) {
	    /* move the value into the correct register */
	    char buf[100];
	    int needs_free = ($<number>5 & 256) || TOP_NEEDS_FREE;
	    do_comma();
	    sprintf(buf, "r%i=r%i", dest_reg, TOP->u.num);
	    ins_string(buf);
	    stack_pop();
	    stack_push_register(dest_reg, needs_free);
	  } else if ($<number>5 & 256) {
	    /* The previous case needed freeing.  Make sure this is marked
	       for freeing too */
	    MARK_NEEDS_FREE(dest_reg);
	  }
	  ins_string("\n)\n");
	  if (exact_types && !compatible_types($4.type, $7.type)) {
	      char buf[1000];
	      sprintf(buf, "Types in ?: do not match %s.", 
		      get_two_types($4.type, $7.type));
	      yyerror(buf);
	  }
	  if ($4.type == TYPE_ANY)
	    $$.type = $7.type;
	  else if (TYPE($4.type, TYPE_MOD_POINTER|TYPE_ANY))
	    $$.type = $7.type;
	  else
	    $$.type = $4.type;
	  $$.addr = $1.addr; $$.iscon = 0;
	}
     | expr0 L_LOR {
	 must_have_register();
	 generate_frees();
	 do_comma();
	 ins_string("\n(");
	 needs_comma=0;
         ins_cfun("C_IS_FALSE",1);
	 needs_comma=0;
	 ins_string(" ?\n");
       }
       expr0
	 {
	  must_have_register();
	  generate_frees();
	  ins_string(": 0) /* F_LOR */\n");
	  last_expression = 0;
	  if ($1.type == $4.type)
	    $$.type = $1.type;
	  else
	    $$.type = TYPE_ANY;	/* Return type can't be known */
	  $$.addr = $1.addr; $$.iscon = 0;
	}
     | expr0 L_LAND {
	 must_have_register();
	 generate_frees();
	 do_comma();
	 ins_string("\n(");
	 needs_comma=0;
	 ins_cfun("C_IS_TRUE",1);
	 needs_comma=0;
	 ins_string(" ?\n");
       }
       expr0
	{
	  must_have_register();
	  generate_frees();
	  ins_string(": 0) /* F_LAND */\n");
	  last_expression = 0;
	  if ($1.type == $4.type)
	    $$.type = $1.type;
	  else
	    $$.type = TYPE_ANY;	/* Return type can't be known */
	  $$.addr = $1.addr; $$.iscon = 0;
	}
     | expr0 '|' expr0
          {
	      if (exact_types && !TYPE($1.type,TYPE_NUMBER))
		  type_error("Bad argument 1 to |", $1.type);
	      if (exact_types && !TYPE($3.type,TYPE_NUMBER))
		  type_error("Bad argument 2 to |", $3.type);
	      $$.type = TYPE_NUMBER;
	      $$.addr = $1.addr; $$.iscon = 0;
#ifdef LPC_OPTIMIZE
	      /* constant expressions */
	      if ($1.iscon && BASIC_TYPE($1.type, TYPE_NUMBER) &&
		  $3.iscon && BASIC_TYPE($3.type, TYPE_NUMBER))
	      {
		NEXT->u.num |= TOP->u.num;
		stack_pop();
		$$.iscon = 1;
		break;
	      }
#endif
	      ins_cfun_call_by_name("c_or",2,0);
	      generate_frees();
	  }
       | expr0 '^' expr0
	  {
	      if (exact_types && !TYPE($1.type,TYPE_NUMBER))
		  type_error("Bad argument 1 to ^", $1.type);
	      if (exact_types && !TYPE($3.type,TYPE_NUMBER))
		  type_error("Bad argument 2 to ^", $3.type);
	      $$.type = TYPE_NUMBER;
	      $$.addr = $1.addr; $$.iscon = 0;
#ifdef LPC_OPTIMIZE
	      /* constant expressions */
	      if ($1.iscon && BASIC_TYPE($1.type, TYPE_NUMBER) &&
		  $3.iscon && BASIC_TYPE($3.type, TYPE_NUMBER))
	      {
		NEXT->u.num ^= TOP->u.num;
		stack_pop();
		$$.iscon = 1;
		break;
	      }
#endif
	      ins_cfun_call_by_name("c_xor",2,0);
	      generate_frees();
	  }
       | expr0 '&' expr0
	  {
	      if ( !($1.type & TYPE_MOD_POINTER) || !($3.type & TYPE_MOD_POINTER) ) {
	          if (exact_types && !TYPE($1.type,TYPE_NUMBER))
		      type_error("Bad argument 1 to &", $1.type);
	          if (exact_types && !TYPE($3.type,TYPE_NUMBER))
		      type_error("Bad argument 2 to &", $3.type);
	      }
	      $$.type = TYPE_NUMBER;
	      $$.addr = $1.addr; $$.iscon = 0;
#ifdef LPC_OPTIMIZE
	      /* constant expressions */
	      if ($1.iscon && BASIC_TYPE($1.type, TYPE_NUMBER) &&
		  $3.iscon && BASIC_TYPE($3.type, TYPE_NUMBER))
	      {
		NEXT->u.num &= TOP->u.num;
		stack_pop();
		$$.iscon = 1;
		break;
	      }
#endif
	      ins_cfun_call_by_name("c_and",2,-1);
	      generate_frees();
	  }

      | expr0 L_EQ expr0
	{
	    int t1 = $1.type & TYPE_MOD_MASK, t2 = $3.type & TYPE_MOD_MASK;
	    if (exact_types &&
		(t1 != t2) &&
!((t1 & (TYPE_NUMBER | TYPE_REAL)) && (t2 & (TYPE_NUMBER | TYPE_REAL))) &&
		(t1 != TYPE_ANY && t2 != TYPE_ANY)) {
		char buf[1000];
		sprintf(buf, "== always false because of incompatible types %s.",get_two_types($1.type, $3.type));
		yyerror(buf);
	    }
	    ins_cfun_call_by_name("c_eq",2,0);
	    generate_frees();
	    $$.type = TYPE_NUMBER;
	    $$.addr = $1.addr; $$.iscon = 0;
	}
      | expr0 L_NE expr0
	{
	    int t1 = $1.type & TYPE_MOD_MASK, t2 = $3.type & TYPE_MOD_MASK;
	    if (exact_types &&
		(t1 != t2) &&
!((t1 & (TYPE_NUMBER | TYPE_REAL)) && (t2 & (TYPE_NUMBER | TYPE_REAL))) &&
		(t1 != TYPE_ANY && t2 != TYPE_ANY)) {
		char buf[1000];
		sprintf(buf, "!= always false because of incompatible types %s.",get_two_types($1.type, $3.type));
		yyerror(buf);
	    }
	    ins_cfun_call_by_name("c_ne",2,0);
	    generate_frees();
	    $$.type = TYPE_NUMBER;
	    $$.addr = $1.addr; $$.iscon = 0;
	}

      | expr0 '>' expr0
	{
	    $$.addr = $1.addr; $$.iscon = 0;
	    $$.type = TYPE_NUMBER;
	    ins_cfun_call_by_name("c_gt",2,0);
	    generate_frees();
	};
      | expr0 L_GE expr0
	{
	    $$.addr = $1.addr; $$.iscon = 0;
	    $$.type = TYPE_NUMBER;
	    ins_cfun_call_by_name("c_ge",2,0);
	    generate_frees();
	};
      | expr0 '<' expr0
	{
	    $$.addr = $1.addr; $$.iscon = 0;
	    $$.type = TYPE_NUMBER;
	    ins_cfun_call_by_name("c_lt",2,0);
	    generate_frees();
	};
      | expr0 L_LE expr0
	{
	    $$.addr = $1.addr; $$.iscon = 0;
	    $$.type = TYPE_NUMBER;
	    ins_cfun_call_by_name("c_le",2,0);
	    generate_frees();
	};

      | expr0 L_LSH expr0
	{
	    ins_cfun_call_by_name("c_lsh",2,0);
	    generate_frees();
	    $$.type = TYPE_NUMBER;
	    $$.addr = $1.addr; $$.iscon = 0;
	    if (exact_types && !TYPE($1.type, TYPE_NUMBER))
		type_error("Bad argument number 1 to '<<'", $1.type);
	    if (exact_types && !TYPE($3.type, TYPE_NUMBER))
		type_error("Bad argument number 2 to '<<'", $3.type);
	}
      | expr0 L_RSH expr0
	{
	  ins_cfun_call_by_name("c_rsh",2,0);
	    generate_frees();
	    $$.type = TYPE_NUMBER;
	    $$.addr = $1.addr; $$.iscon = 0;
	    if (exact_types && !TYPE($1.type, TYPE_NUMBER))
		type_error("Bad argument number 1 to '>>'", $1.type);
	    if (exact_types && !TYPE($3.type, TYPE_NUMBER))
		type_error("Bad argument number 2 to '>>'", $3.type);
	}

      | expr0 '+' expr0	/* Type checks of this case are incomplete */
	{
	  if($1.type == $3.type)
	    $$.type = $1.type;
	  else if(($1.type & TYPE_ANY) || ($3.type & TYPE_ANY))
	    $$.type = TYPE_ANY;
	  else if((TYPE($1.type, TYPE_NUMBER) && TYPE($3.type, TYPE_REAL)) ||
		  (TYPE($1.type, TYPE_REAL) && TYPE($3.type, TYPE_NUMBER)))
	    $$.type = TYPE_REAL;
	  else
	    $$.type = TYPE_ANY;

	  $$.addr = $1.addr;
	  $$.iscon = 0;

#ifdef LPC_OPTIMIZE
	  /* optimize 0's */
	  if ($1.iscon && $1.type == TYPE_ANY &&
	      ($3.type == TYPE_NUMBER || $3.type == TYPE_REAL))
	  {
	      /* 0 + X */
	    *NEXT = *TOP;
	    stack_pop();
	    $$ = $3;
	    $$.addr = $1.addr;
	    last_expression = 0;  /* could be smarter */
	    break;
	  } else if ($3.iscon && $3.type == TYPE_ANY &&
		     ($1.type == TYPE_NUMBER || $1.type == TYPE_REAL))
	  {
	      /* X + 0 */
	    stack_pop();
	    $$ = $1;
	    last_expression = 0; /* ? */
	    break;
	  }
	  
	  /* constant expressions */
	  if ($1.iscon && $3.iscon) {
	      if (BASIC_TYPE($1.type, TYPE_NUMBER) &&
		  BASIC_TYPE($3.type, TYPE_NUMBER))
	      {
		NEXT->u.num += TOP->u.num;
		stack_pop();
		$$.iscon = 1;
		break;
	      } else if ($$.type == TYPE_REAL) {
		NEXT->type = SS_REAL;
		
		if ($1.type == TYPE_NUMBER)
		  NEXT->u.f = NEXT->u.num + TOP->u.f;
		else if ($3.type == TYPE_NUMBER)
		  NEXT->u.f = NEXT->u.f + TOP->u.num;
		else
		  NEXT->u.f = NEXT->u.f + TOP->u.f;
		stack_pop();
		$$.iscon = 1;
		break;
	      } else if ($$.type == TYPE_STRING) {
		/* Combine strings */
		short n1, n2;
		char *new, *s1, *s2;
		int l;

		n1 = NEXT->u.num;
		s1 = ((char **)mem_block[A_STRINGS].block)[n1];
		n2 = TOP->u.num;
		s2 = ((char **)mem_block[A_STRINGS].block)[n2];
		new = DXALLOC( (l = strlen(s1))+strlen(s2)+1, 53, "string add" );
		strcpy(new, s1);
		strcpy(new + l, s2);
		/* free old strings (ordering may help shrink table) */
		if (n1 > n2) {
		  free_prog_string(n1); free_prog_string(n2);
		} else {
		  free_prog_string(n2); free_prog_string(n1);
		}
		/* store new string */
		stack_pop();
		TOP->u.num = store_prog_string(new);
		FREE(new);
		$$.iscon = 1;
		break;
	      }
	  }
#endif /* OPTIMIZE */
	  /* wasn't optimized away */
	  ins_cfun_call_by_name("c_add",2,-1);
	    generate_frees();
	};
      | expr0 '-' expr0
	{
	  int bad_arg = 0;

	  if(exact_types){
	    if(!TYPE($1.type, TYPE_NUMBER) &&
		!TYPE($1.type, TYPE_REAL) &&
		!($1.type & TYPE_MOD_POINTER)){
	      type_error("Bad argument number 1 to '-'", $1.type);
	      bad_arg++;
	    }
	    if(!TYPE($3.type, TYPE_NUMBER) &&
	       !TYPE($3.type, TYPE_REAL) &&
	       !($3.type & TYPE_MOD_POINTER)){
	      type_error("Bad argument number 2 to '-'", $3.type);
	      bad_arg++;
	    }
	  }
	  $$.type = TYPE_ANY;
	  $$.addr = $1.addr;
	  $$.iscon = 0;
	  if (($1.type & TYPE_MOD_POINTER) || ($3.type & TYPE_MOD_POINTER))
	    $$.type = TYPE_MOD_POINTER | TYPE_ANY;
	  if (!($1.type & TYPE_MOD_POINTER) || !($3.type & TYPE_MOD_POINTER)) {
	    if (exact_types && $$.type != TYPE_ANY && !bad_arg)
	      yyerror("Arguments to '-' don't match");
	    if(($1.type & TYPE_ANY) || ($3.type & TYPE_ANY))
	      $$.type = TYPE_ANY;
	    else if((TYPE($1.type, TYPE_NUMBER) && TYPE($3.type, TYPE_NUMBER)))
	      $$.type = TYPE_NUMBER;
	    else
	      $$.type = TYPE_REAL;
	  }
	  
#ifdef LPC_OPTIMIZE
	  if ($3.iscon && $3.type == TYPE_ANY) {  /* optimize X-0 */
	    stack_pop();
	    last_expression = 0; /* ? */
	    break;
	  }

	  /* constant expressions */
	  if ($1.iscon && $3.iscon) {
	      if (BASIC_TYPE($1.type, TYPE_NUMBER) &&
		  BASIC_TYPE($3.type, TYPE_NUMBER))
	      {
		NEXT->u.num -= TOP->u.num;
		stack_pop();
		$$.iscon = 1;
		break;
	      } else if ($$.type == TYPE_REAL) {
		NEXT->type = SS_REAL;
		if ($1.type == TYPE_NUMBER)
		  NEXT->u.f = NEXT->u.num - TOP->u.f;
		else if ($3.type == TYPE_NUMBER)
		  NEXT->u.f = NEXT->u.f - TOP->u.num;
		else
		  NEXT->u.f = NEXT->u.f - TOP->u.f;
		stack_pop();
		$$.iscon = 1;
		break;
	      }
	  }
#endif
	  ins_cfun_call_by_name("c_subtract",2, -1);
	  generate_frees();
	}
      | expr0 '*' expr0
	{
	  if (($1.type != TYPE_MAPPING) || ($3.type != TYPE_MAPPING)) {
	    if (exact_types && !TYPE($1.type, TYPE_NUMBER) && !TYPE($1.type, TYPE_REAL))
	      type_error("Bad argument number 1 to '*'", $1.type);
	    if (exact_types && !TYPE($3.type, TYPE_NUMBER) && !TYPE($3.type, TYPE_REAL))
	      type_error("Bad argument number 2 to '*'", $3.type);
	    if (TYPE($1.type, TYPE_NUMBER) && TYPE($3.type, TYPE_NUMBER))
	      $$.type = TYPE_NUMBER;
	    else
              $$.type = TYPE_REAL;
	  }
	  else
	    $$.type = TYPE_MAPPING;
	  $$.addr = $1.addr; $$.iscon = 0;
	  
#ifdef LPC_OPTIMIZE
	  /* constant expressions */
	  if ($1.iscon && $3.iscon) {
	      if (BASIC_TYPE($1.type, TYPE_NUMBER) &&
		  BASIC_TYPE($3.type, TYPE_NUMBER))
	      {
		NEXT->u.num *= TOP->u.num;
		stack_pop();
		$$.iscon = 1;
		break;
	      } else if ($$.type == TYPE_REAL) {
		NEXT->type = SS_REAL;
		if ($1.type == TYPE_NUMBER)
		  NEXT->u.f = NEXT->u.num * TOP->u.f;
		else if ($3.type == TYPE_NUMBER)
		  NEXT->u.f = NEXT->u.f * TOP->u.num;
		else
		  NEXT->u.f = NEXT->u.f * TOP->u.f;
		pop_stack();
		$$.iscon = 1;
		break;
	      }
	  }
#endif
	  ins_cfun_call_by_name("c_multiply",2,-1);
	    generate_frees();
	};
      | expr0 '%' expr0
	{
	    if (exact_types && !TYPE($1.type, TYPE_NUMBER))
		type_error("Bad argument number 1 to '%'", $1.type);
	    if (exact_types && !TYPE($3.type, TYPE_NUMBER))
		type_error("Bad argument number 2 to '%'", $3.type);
	    $$.type = TYPE_NUMBER;
	    $$.addr = $1.addr; $$.iscon = 0;
#ifdef LPC_OPTIMIZE
	      /* constant expressions */
	      if ($1.iscon && BASIC_TYPE($1.type, TYPE_NUMBER) &&
		  $3.iscon && BASIC_TYPE($3.type, TYPE_NUMBER))
	      {
		if (TOP->u.num == 0) {
		  yyerror("Modulo by zero in constant");
		  break;
		}
		NEXT->u.num %= TOP->u.num;
		stack_pop();
		$$.iscon = 1;
		break;
	      }
#endif
	    ins_cfun_call_by_name("c_mod",2,0);
	    generate_frees();
	};
      | expr0 '/' expr0
	{
	    if (exact_types && !TYPE($1.type, TYPE_NUMBER) && !TYPE($1.type, TYPE_REAL))
		type_error("Bad argument number 1 to '/'", $1.type);
	    if (exact_types && !TYPE($3.type, TYPE_NUMBER) && !TYPE($3.type, TYPE_REAL))
		type_error("Bad argument number 2 to '/'", $3.type);
	    if (TYPE($1.type, TYPE_NUMBER) && TYPE($3.type, TYPE_NUMBER))
		$$.type = TYPE_NUMBER;
	    else
		$$.type = TYPE_REAL;
	    $$.addr = $1.addr; $$.iscon = 0;
#ifdef LPC_OPTIMIZE
	    /* constant expressions */
	    if ($1.iscon && $3.iscon) {
		if (BASIC_TYPE($1.type, TYPE_NUMBER) &&
		    BASIC_TYPE($3.type, TYPE_NUMBER))
		{
		    if (TOP->u.num == 0) {
			yyerror("Divide by zero in constant");
			break;
		    }
		    NEXT->u.num /= TOP->u.num;
		    stack_pop();
		    $$.iscon = 1;
		    break;
		} else if ($$.type == TYPE_REAL) {
		  static float val;

		  NEXT->type = SS_REAL;
		  /* a bit complicated with divide-by-zero checking */
		  if ($3.type == TYPE_REAL) {
		    if ((val = TOP->u.f) == 0.0) {
		      yyerror("Divide by zero in constant");
		      break;
		    }
		    if ($1.type == TYPE_NUMBER)
		      NEXT->u.f = NEXT->u.num / val;
		    else
		      NEXT->u.f = NEXT->u.f / val;
		  } else {
		    int iv;
		    if ((iv = TOP->u.num) == 0) {
		      yyerror("Divide by zero in constant");
		      break;
		    }
		    NEXT->u.f = NEXT->u.f / iv;
		  }
		  stack_pop();
		  $$.iscon = 1;
		  break;
		}
	      }
#endif
	    ins_cfun_call_by_name("c_divide",2,0);
	    generate_frees();
	}
      | cast expr0  %prec L_NOT
        {
	  $$.type = $1;
	  $$.addr = $2.addr; $$.iscon = 0;
	  if (exact_types && $2.type != TYPE_ANY && $2.type != TYPE_UNKNOWN &&
	      $1 != TYPE_VOID) {
		    char tname[100];
		    char buf[1000];
		    strcpy(tname, get_type_name($2.type));
		    sprintf(buf, "Cannot cast %s to %s.", tname, get_type_name($1));
		}
	}

      | L_INC lvalue  %prec L_NOT  /* note lower precedence here */
        {
	    /* can't be done by name b/c of backpatching */
	    ins_cfun_call(F_PRE_INC,1);
	    if (exact_types && !TYPE($2.type, TYPE_NUMBER) && !TYPE($2.type, TYPE_REAL))
		type_error("Bad argument to ++", $2.type);
            if (TYPE($2.type, TYPE_NUMBER))
		$$.type = TYPE_NUMBER;
            else
		$$.type = TYPE_REAL;
	    $$.addr = $$.iscon = 0;
	};
      | L_DEC lvalue  %prec L_NOT  /* note lower precedence here */
        {
	    /* can't be done by name b/c of backpatching */
	    ins_cfun_call(F_PRE_DEC,1);
	    if (exact_types && !TYPE($2.type, TYPE_NUMBER) && !TYPE($2.type, TYPE_REAL))
		type_error("Bad argument to --", $2.type);
            if (TYPE($2.type, TYPE_NUMBER))
		$$.type = TYPE_NUMBER;
            else
		$$.type = TYPE_REAL;
	    $$.addr = $$.iscon = 0;
	};
      | L_NOT expr0
	{
	    $$.type = TYPE_NUMBER;
	    $$.addr = $2.addr; $$.iscon = 0;
#ifdef LPC_OPTIMIZE
	    /* constant expressions */
	    if ($2.iscon && BASIC_TYPE($2.type, TYPE_NUMBER))
	    {
	      TOP->u.num = ! TOP->u.num;
	      $$.iscon = 1;
	      break;
	    }
#endif
	    /* it's important that there are no dangling frees left here;
	       optimization assumes any dangling frees are due to F_NOT */
	    generate_frees();
	    /* can't be done by name b/c of backpatching */
	    ins_cfun_call(F_NOT,1);	/* Any type is valid here. */
	};
      | '~' expr0
	{
	    if (exact_types && !TYPE($2.type, TYPE_NUMBER))
		type_error("Bad argument to ~", $2.type);
	    $$.type = TYPE_NUMBER;
	    $$.addr = $2.addr; $$.iscon = 0;
#ifdef LPC_OPTIMIZE
	    /* constant expressions */
	    if ($2.iscon && BASIC_TYPE($2.type, TYPE_NUMBER))
	    {
	      TOP->u.num = ~ TOP->u.num;
	      $$.iscon = 1;
	      break;
	    }
#endif
	    ins_cfun_call_by_name("c_compl",1,0);
	    generate_frees();
	};
      | '-' expr0  %prec L_NOT
	{
	    if (exact_types && !TYPE($2.type, TYPE_NUMBER) && !TYPE($2.type, TYPE_REAL))
		type_error("Bad argument to unary '-'", $2.type);
            if (TYPE($2.type, TYPE_NUMBER))
	      $$.type = TYPE_NUMBER;
	    else
	      $$.type = TYPE_REAL;
	    $$.addr = $2.addr; $$.iscon = 0;
#ifdef LPC_OPTIMIZE
	    /* constant expressions */
	    if ($2.iscon) {
		if ($$.type == TYPE_NUMBER) {
		  TOP->u.num = - (TOP->u.num);
		  $$.iscon = 1;
		  break;
		} else if ($$.type == TYPE_REAL) {
		  TOP->u.f = - (TOP->u.f);
		  $$.iscon = 1;
		  break;
		}
	    }
#endif
	    ins_cfun_call_by_name("c_negate",1,0);
	    generate_frees();
	}

      | lvalue L_INC   /* normal precedence here */
         {
	   /* can't be done by name b/c of backpatching */
	   ins_cfun_call(F_POST_INC,1);
	   if (exact_types && !TYPE($1.type, TYPE_NUMBER) && !TYPE($1.type, TYPE_REAL))
	     type_error("Bad argument to ++", $1.type);
	   if (TYPE($1.type, TYPE_NUMBER))
	     $$.type = TYPE_NUMBER;
	   else
	     $$.type = TYPE_REAL;
	   $$.addr = $$.iscon = 0;
	 };
      | lvalue L_DEC
         {
	   /* can't be done by name b/c of backpatching */
	   ins_cfun_call(F_POST_DEC,1);
	   if (exact_types && !TYPE($1.type, TYPE_NUMBER) && !TYPE($1.type, TYPE_REAL))
	     type_error("Bad argument to --", $1.type);
	   if (TYPE($1.type, TYPE_NUMBER))
	     $$.type = TYPE_NUMBER;
            else
	      $$.type = TYPE_REAL;
	   $$.addr = $$.iscon = 0;
	 }

       | expr4
      ;

assign: '=' { $$ = F_ASSIGN; }
      | L_AND_EQ { $$ = F_AND_EQ; }
      | L_OR_EQ { $$ = F_OR_EQ; }
      | L_XOR_EQ { $$ = F_XOR_EQ; }
      | L_LSH_EQ { $$ = F_LSH_EQ; }
      | L_RSH_EQ { $$ = F_RSH_EQ; }
      | L_ADD_EQ { $$ = F_ADD_EQ; }
      | L_SUB_EQ { $$ = F_SUB_EQ; }
      | L_MULT_EQ { $$ = F_MULT_EQ; }
      | L_MOD_EQ { $$ = F_MOD_EQ; }
      | L_DIV_EQ { $$ = F_DIV_EQ; };

return: L_RETURN
	{
	    if (exact_types && !TYPE(exact_types, TYPE_VOID))
		yyerror("Non-void functions must return a value.");
	    do_comma();
	    ins_string("return c_return(ret,&const0)");
	    needs_comma = 0;
	    last_expression = 0;
	}
      | L_RETURN {
	ins_string("return ");
      }
        comma_expr
        {
	  if (exact_types && !compatible_types($3, exact_types | TYPE_MOD_MASK)) {
	      char buf[1000];
	      sprintf(buff, "Type of returned value doesn't match function return type %s.", get_two_types($2, exact_types & TYPE_MOD_MASK));
	      yyerror(buf);
	  }
	  do_comma();
	  create_intermediates(1);
	  ins_string("c_return(ret,");
	  ins_arguments(1,0,0);
	  ins_char(')');
	  needs_comma = 1;
	  generate_frees();
	  ins_string(",1");
	  needs_comma=0;
	  last_expression = 0;
	};

expr_list_on_stack:
        {
	  $<number>$ = keep_in_register;
	  keep_in_register = 0;
	}
     expr_list
        {
	  keep_in_register = $<number>1;
	  $$ = $2;
	}

expr_list: /* empty */		{ $$ = 0; }
	 | expr_list2		{ $$ = $1; }
	 | expr_list2 ','	{ $$ = $1; } ; /* Allow a terminating comma */

expr_list2: expr0	{ $$ = 1; 
			  if (!keep_in_register) {
			    change_destination_to_stack();
			    add_arg_type($1.type);
			  } else keep_in_register--;
			}
| expr_list2 ',' expr0	{ $$ = $1 + 1;
			  if (!keep_in_register) {
			    change_destination_to_stack();
			    add_arg_type($3.type);
			  } else keep_in_register--;
			}

expr_list3: /* empty */         { $$ = 0; }
           | expr_list4         { $$ = $1; }
           | expr_list4 ','     { $$ = $1; } ; /* Allow terminating comma */

expr_list4: assoc_pair          { $$ = $1; }
           | expr_list4 ',' assoc_pair  { $$ = $1 + 2; } ;

assoc_pair: expr0 { change_destination_to_stack(); } 
        ':' expr0 { change_destination_to_stack(); $$ = 2; } ;

expr4: function_call { $$.type = $1; $$.addr = $$.iscon = 0; }
     | lvalue
	{
	    $$.type = $1.type;
	    $$.addr = $$.iscon = 0;
	}
     | string | number | real
     | '(' comma_expr1 ')' { $$ = $2; }
     | catch { $$.type = TYPE_ANY; $$.addr = $$.iscon = 0; }
     | sscanf { $$.type = TYPE_NUMBER; $$.addr = $$.iscon = 0; }
     | parse_command { $$.type = TYPE_NUMBER; $$.addr = $$.iscon = 0; }
     | time_expression { $$.type = TYPE_NUMBER; $$.addr = $$.iscon = 0; }
     | L_FUNCTION_OPEN L_DEFINED_NAME ':' ')' %prec NEW_FUNCTION_PTR
           {
	   $$.type = TYPE_FUNCTION;
	   $$.addr = CURRENT_PROGRAM_SIZE;
	   $$.iscon = 0;
	   if (($2.local_num != -1) || ($2.global_num != -1)) {
	     if ($2.local_num != -1) {
	       stack_push_local($2.local_num);
	     } else {
	       stack_push_identifier($2.global_num);
	     }
	     ins_cfun_call_by_name("c_this_function_constructor",1,1);
	     generate_frees();
	   } else
#ifdef NEW_FUNCTIONS
	     if ($2.simul_num != -1) {
		 yyerror("Simul_efun pointers not implemented yet.\n");
	     } else
	     if ($2.function_num != -1) {
	       yyerror("Lfun pointers not implemented yet.\n");
	     } else { /* must be an efun */
	       stack_push_number(0);
	       ins_ext_cfun("c_efun_function_constructor", 1, $2);
	     }
#else
	   yyerror("extended functions not enabled.\n");
#endif
	 }
     | L_FUNCTION_OPEN L_DEFINED_NAME ','  %prec NEW_FUNCTION_PTR
         {
	   $$.type = TYPE_FUNCTION;
	   $$.addr = CURRENT_PROGRAM_SIZE;
	   $$.iscon = 0;
	   /* this semantic value already used.  use the first '(' as
	      another temporary. */
	   $<number>1 = keep_in_register;
	   keep_in_register = 0;

	   /* the semantic value of this block is a flag */
	   if (($2.local_num != -1) || ($2.global_num != -1)) {
	     if ($2.local_num != -1) {
		 stack_push_local($2.local_num);
 	     } else {
		 stack_push_identifier($2.global_num);
	     }
	     $<number>1 = keep_in_register;
	     keep_in_register = 1;
	     $<number>$ = 1;
	   } else
#ifdef NEW_FUNCTIONS
	      if ($2.simul_num != -1) {
		yyerror("Simul_efun pointers not implemented yet.\n");
		$<number>$ = 2;
	      } else
	      if ($2.function_num != -1) {
		yyerror("Lfun pointers not implemented yet.\n");
		$<number>$ = 3;
	      } else { /* an efun */
		$<number>$ = 4;
	      }
#else
	      {
		yyerror("extended functions not enabled.\n");
		$<number>$ = 5;
	      }
#endif
	 }
       expr_list2 ':' ')'
         {
	   switch ($<number>4) {
	   case 1: /* the name was an expression */
	     if ($6 == 0) {
	       yyerror("missing expression\n");
	       stack_push_number(1);
	     }
	     if ($6 > 1) {
	       yyerror("Too many arguments to (: :)\n");
	       pop_arg_stack($6 - 1);
#ifdef DEBUG
	       on_stack -= $6 - 1;
#endif
	     }
	     ins_cfun_call_by_name("c_function_constructor",2,1);
	     generate_frees();
	     break;
#ifdef NEW_FUNCTIONS
	   case 2: /* unimplemented */
	   case 3:
	     pop_arg_stack($6);
#ifdef DEBUG
	     on_stack -= $6;
#endif
	     break;
	   case 4:
	     ins_ext_cfun("C_AGGREGATE", 0, $6);
	     pop_arg_stack($6);
#ifdef DEBUG
	     on_stack -= $6;
#endif
	     ins_ext_cfun("c_efun_function_constructor", 1, $2);
	     break;
#else
	   case 5:
	     pop_arg_stack($6);
	     break;
#endif
	   }
	   /* restore old value */
	   keep_in_register = $<number>1;
	 }
     | L_FUNCTION_OPEN expr0 ':' ')'    %prec OLD_FUNCTION_PTR
         {
	   ins_cfun_call_by_name("c_this_function_constructor",1,1);
	   generate_frees();
	   $$.type = TYPE_FUNCTION;
	   $$.addr = $2.addr; $$.iscon = 0;
	 }
     | L_FUNCTION_OPEN expr0 ',' expr0 ':' ')' %prec OLD_FUNCTION_PTR
         {
	   ins_cfun_call_by_name("c_function_constructor",2,1);
	   generate_frees();
           $$.type = TYPE_FUNCTION;
           $$.addr = $2.addr; $$.iscon = 0;
         }
     | L_MAPPING_OPEN 
         {
	     $<number>$ = keep_in_register; keep_in_register = 0;
	 }
       expr_list3 ']' ')'
         {
	   ins_ext_cfun("C_ASSOC",0,$3);
	   generate_frees();
#ifdef DEBUG
	   on_stack-=$3;
#endif
	   $$.type = TYPE_MAPPING;
	   $$.addr = $$.iscon = 0;
	   keep_in_register = $<number>2;
         }
     | L_ARRAY_OPEN expr_list_on_stack '}' ')'
       {
	   pop_arg_stack($2); /* we don't care about these */
	   ins_ext_cfun("C_AGGREGATE",0,$2);
	   generate_frees();
#ifdef DEBUG
	   on_stack-=$2;
#endif
	   $$.type = TYPE_MOD_POINTER | TYPE_ANY;
	   $$.addr = $$.iscon = 0;
       };

catch: 
	L_CATCH
{
  int reg;
  reg = get_register();
  stack_push_register(reg, 1);
  do_comma();
  ins_string("CATCH_START,\n(SETJMP(error_recovery_context) ?");
  ins_string_with_num("(CATCH_ERROR,\nr%i = catch_value,\n", reg);
  ins_string("catch_value = const1) :\n(");
}
       '(' comma_expr ')'
{
  insert_pop_value();
  /* always need a comma after a pop value */
  ins_string(",\n");
  /* top of the stack is the register we pushed before */
  ins_string_with_num("CATCH_END, r%i = const0))\n", TOP->u.num);
  needs_comma = 1;
};

sscanf: L_SSCANF '(' expr0 ',' expr0
        {
	  ins_ext_cfun("c_sscanf",2,0);
	  /* remember the location of num_args */
	  push_address();
	  generate_frees();
        }
   lvalue_list ')'
	{
	  char buf[5];
#ifdef DEBUG
	  /* correct the stack count */
	  on_stack += $7;
#endif
	  sprintf(buf,"%2d", $7);
	  memcpy(mem_block[current_block].block+pop_address()-3, buf, 2);
	}

parse_command: L_PARSE_COMMAND '(' expr0 ',' expr0 ',' expr0 
        {
	  ins_ext_cfun("c_parse_command",3,0);
	  generate_frees();
	  /* remember the location of num_args */
	  push_address();
	}
   lvalue_list ')'
	{
	  sprintf(mem_block[current_block].block+pop_address()-3, "%2d", $9);
	}

time_expression: L_TIME_EXPRESSION 
        {
	  ins_cfun("C_TIME_EXPRESSION",0);
#ifdef DEBUG
	  on_stack += 2;
#endif
	}
	'(' comma_expr ')'
        {
#ifdef DEBUG
	  on_stack -= 2;
#endif
	  ins_cfun_call_by_name("C_END_TIME_EXPRESSION",1,0);
	  generate_frees();
	}
	;

asm_directive: L_ASM '{' string_con2 '}' {
  struct svalue *res;
  
  push_malloced_string(the_file_name(current_file));
  res = safe_apply_master_ob(APPLY_VALID_ASM, 1);
  if (!MASTER_APPROVED(res)) {
      yyerror("Invalid asm directive");
      break;
  }
  ins_string($3);
}

lvalue_list: 
	/* empty */
	    {
		$$ = 0;
	    }
    |   ',' lvalue
	    {
		ins_cfun("C_ASSIGN_FROM_STACK", 1);
#ifdef DEBUG
		on_stack--;
#endif
	    }
	lvalue_list
	    {
		$$ = 1 + $4;
	    }
    ;

lvalue: L_DEFINED_NAME
	{
	  int i;
	  if ((i = $1.local_num) != -1) {
	    stack_push_local(i);
	    $$.type = type_of_locals[i];
	    $$.iscon = 0;
	    $$.addr = CURRENT_PROGRAM_SIZE;
	  } else
	  if ((i = $1.global_num) != -1) {
	    stack_push_identifier(i);
	    $$.type = VARIABLE(i)->type & TYPE_MOD_MASK;
	    $$.iscon = 0;
	    $$.addr = CURRENT_PROGRAM_SIZE;
	  } else {
	    char *s;
	    char buf[256];
	    s = get_defined_name(&($1));
	    strcpy(buf, "Undefined variable '");
	    strcat(buf, s);
	    FREE(s);
	    strcat(buf, "'\n");
	    yyerror(buf);
	  }
	}
	| expr4 '[' comma_expr L_RANGE comma_expr ']'
       {
         ins_cfun_call(F_RANGE,3);
	 generate_frees();
         if (exact_types) {
             if (($1.type & TYPE_MOD_POINTER) == 0
               && !TYPE($1.type, TYPE_STRING)
               && !TYPE($1.type, TYPE_BUFFER))
                 type_error("Bad type to indexed value", $1.type);
             if (!TYPE($3, TYPE_NUMBER))
                 type_error("Bad type of index", $3);
             if (!TYPE($5, TYPE_NUMBER))
                 type_error("Bad type of index", $5);
         }
            if ($1.type == TYPE_ANY)
                $$.type = TYPE_ANY;
            else if (TYPE($1.type, TYPE_STRING))
                $$.type = TYPE_STRING;
            else if (TYPE($1.type, TYPE_BUFFER))
                $$.type = TYPE_BUFFER;
            else if ($1.type & TYPE_MOD_POINTER)
                $$.type = $1.type;
            else if (exact_types)
                type_error("Bad type of argument used for range", $1.type);
       };
	| expr4 '[' comma_expr ']'
	{
	  char tmp[256];
	  short regs_saved;
	
	  if (needs_comma) {
#if defined(LPC_TRACE) || defined(LPC_DEBUG)
	  prefab_in_progress = 1;
#endif	 
	    do_comma();
	    create_intermediates(2);
	    BACKSPACE(2);
#if defined(LPC_TRACE) || defined(LPC_DEBUG)
	  prefab_in_progress = 0;
#endif	 
	  } else
	    create_intermediates(2);

	  /* save a register for use a temporary svalue for string[] and
	     buffer[] */
	  stack_push_register(get_register(), 0);
	  
	  regs_saved = registers_in_use;
	  strcpy(tmp,"c_index(");
	  /* prepare_arguments marks the registers as unused, but they are
	   * still used indirectly in the prefab
           */
	  prepare_arguments(tmp+8,3,0,0);
	  strcat(tmp,")");
	  stack_push_prefab(tmp, registers_in_use);
	  /* put back to state it was in before the prepare_arguments */
	  registers_in_use = regs_saved;
	  generate_frees();
	  if (TYPE($1.type, TYPE_MAPPING) || TYPE($1.type, TYPE_FUNCTION)){
	    $$.type = TYPE_ANY;
	  } else {
	    if (exact_types) {
	      if (!($1.type & TYPE_MOD_POINTER) &&
		  !TYPE($1.type, TYPE_STRING) &&
		  !TYPE($1.type, TYPE_BUFFER))
		type_error("Bad type to indexed value", $1.type);
	      if (!TYPE($3, TYPE_NUMBER))
		type_error("Bad type of index", $3);
	    }
	    if ($1.type == TYPE_ANY)
	      $$.type = TYPE_ANY;
	    else if (TYPE($1.type, TYPE_STRING))
	      $$.type = TYPE_NUMBER;
	    else if (TYPE($1.type, TYPE_BUFFER))
	      $$.type = TYPE_NUMBER;
	    else
	      $$.type = $1.type & TYPE_MOD_MASK & ~TYPE_MOD_POINTER;
	  }
	};

string: string_con2
	{
	    $$.type = TYPE_STRING;
	    $$.iscon = 1;
	    $$.addr = CURRENT_PROGRAM_SIZE;
	    stack_push_string(store_prog_string($1));
	    FREE($1);
	};

string_constant: string_con1
        {
            char *p = make_shared_string($1);
            FREE($1);
            $$ = p;
        };

string_con1: L_STRING
           | '(' string_con1 ')' {
	     $$ = $2;
	   }
	   | string_con1 '+' L_STRING
      {
          int l;

          $$ = DXALLOC( (l = strlen($1)) + strlen($3) + 1, 53, "string_con1" );
          strcpy($$, $1);
          strcpy($$ + l, $3);
          FREE($1);
          FREE($3);
      };

string_con2: L_STRING
         | string_con2 L_STRING
        {
          int l;

          $$ = DXALLOC( (l = strlen($1)) + strlen($2) + 1, 53, "string_con2" );
	  strcpy($$, $1);
          strcpy($$ + l, $2);
	  FREE($1);
          FREE($2);
        };

/* Beek -- normal function calls and efun calls are now seperate cases.
   made possible by a change in lex which now returns L_EFUN if the identifier
   is an efun */
function_call: efun_override {
      $<number>$ = keep_in_register;
      if ($1 > -1) {
	if (predefs[$1].max_args == -1) 
	  keep_in_register = predefs[$1].min_args;
	else
	  keep_in_register = predefs[$1].max_args;
      } else keep_in_register = 0;
    }
'(' expr_list2 ')'
    {
      int f;
      int min_arg, max_arg, num, stack, needed, def, *argp;
      extern int efun_arg_types[];
      
      f = $1;
      if (f > -1) {
	min_arg = predefs[f].min_args;
	max_arg = predefs[f].max_args;
	def = predefs[f].Default;
	$$ = predefs[f].ret_type;
	num = $4;
	stack = num - max_arg;
	argp = &efun_arg_types[predefs[f].arg_index];
	needed = max_arg-num;
	if (max_arg==-1) {
	  needed = 0;
	  stack = num - min_arg;
	}
	if (def && $4 == min_arg-1) {
	  stack_push_default(def);
	  max_arg--;
	  min_arg--;
	  needed--;
	  num++;
	} else if ($4 < min_arg) {
	  int i;
	  char bff[100];
	  sprintf(bff, "Too few arguments to %s", predefs[f].word);
	  yyerror(bff);
	  i = $4;
	  while (i--) stack_pop();
	} else if ($4 > max_arg && max_arg != -1) {
	  int i;
	  char bff[100];
	  sprintf(bff, "Too many arguments to %s", predefs[f].word);
	  yyerror(bff);
	  i = $4;
	  while (i--) stack_pop();
	} else if (max_arg != -1 && exact_types) {
	  /*
	   * Now check all types of the arguments to efuns.
	   */
	  int i, argn;
	  char buff[100];
	  for (argn=0; argn < $4; argn++) {
	    int tmp = get_argument_type(argn, $4);
	    for(i=0; !compatible_types(argp[i], tmp) && argp[i] != 0; i++)
	      ;
	    if (argp[i] == 0) {
	      sprintf(buff, "Bad argument %d type to efun %s()",
		      argn+1, predefs[f].word);
	      yyerror(buff);
	    }
	    while(argp[i] != 0)
	      i++;
	    argp += i + 1;
	  }
	}
	while (needed--) {
	  stack_push_explicit_zero();
	  num++;
	}
	if (max_arg==-1) {
	  ins_ext_cfun_call(f,min_arg,stack);
#ifdef DEBUG
	  on_stack-=stack;
#endif
	} else {
	  ins_cfun_call(f,num);
	}
	pop_arg_stack(stack);
      } else pop_arg_stack($4);
      generate_frees();
      last_expression = 0;
    }
| L_DEFINED_NAME
      {
	int i;
	if ((i=$1.simul_num) != -1) 
	  stack_push_string(store_prog_string(SIMUL(i)->name));
      }
        '(' expr_list ')'
      { 
	int f;
	struct function *funp;
	
	if ((f = $1.function_num) != -1) {
	  ins_ext_cfun("C_CALL",0,$4);
	  /* Snarf the last ), so we can add another argument */
	  BACKSPACE(1);
	  ins_string_with_num(",%i)", f);
#ifdef DEBUG
	  on_stack-=$4;
#endif
	  funp = FUNCTION(f);

	  $$ = validate_function_call(funp, f, $4);

	  generate_frees();
	} else
        if ((f = $1.simul_num) != -1) {
	  ins_ext_cfun("c_simul_efun",1,$4);
#ifdef DEBUG
	  on_stack-=$4;
#endif
	  $$ = (SIMUL(f)->type) & TYPE_MOD_MASK;
	  generate_frees();
	} else
        if ((f = $1.efun_num) != -1) {
	  /*...*/
	} else {
	  /*...*/
	}
	pop_arg_stack($4);	/* Argument types not needed more */
	last_expression = 0;
      }
  | function_name '(' expr_list ')'
    {
      struct function *funp;
      int f;
      
      if ((f = defined_function($1))!=-1) {
	/* The only way this can happen is if function_name below
	 * below made the function name.  The lexer would return
	 * L_DEFINED_FUNCTION instead. 
	 */
	ins_ext_cfun("C_CALL",0,$3);
	/* Snarf the last ), so we can add another argument */
	BACKSPACE(1);
	ins_string_with_num(",%i)", f);
#ifdef DEBUG
        on_stack-=$3;
#endif
	funp = FUNCTION(f);

	$$ = validate_function_call(funp, f, $3);
      } else {
	f = define_new_function($1, 0, 0, 0, NAME_UNDEFINED, 0);
	ins_ext_cfun("C_CALL",0,$3);
	/* Snarf the last ) so we can add another argument */
	BACKSPACE(1);
	ins_string_with_num(",%i)",f);
#ifdef DEBUG
	on_stack-=$3;
#endif
	funp = FUNCTION(f);
	if (strchr($1, ':')) {
	  /*
	   * A function defined by inheritance. Find
	   * real definition immediately.
	   */
	  find_inherited(funp);
	}
	/*
	 * Check if this function has been defined.
	 * But, don't complain yet about functions defined
	 * by inheritance.
	 */
	if (exact_types && (funp->flags & NAME_UNDEFINED)) {
	  char buff[100];
	  sprintf(buff, "Undefined function %.50s", $1);
	  yyerror(buff);
	}
	if (!(funp->flags & NAME_UNDEFINED))
	  $$ = funp->type & TYPE_MOD_MASK;
	else
	  $$ = TYPE_ANY;	/* Just a guess */
      }
      FREE($1);
      generate_frees();
      pop_arg_stack($3);	/* Argument types not needed more */
      last_expression = 0;
    }
  | expr4 L_ARROW identifier
    {  
      stack_push_string(store_prog_string($3));
      FREE($3);
    }
  '(' expr_list_on_stack ')'
    {
      ins_ext_cfun("c_call_other",2,$6);
      generate_frees();
#ifdef DEBUG
      on_stack-=$6;
#endif
      $$ = TYPE_UNKNOWN;
      pop_arg_stack($6);	/* No good need of these arguments */
      last_expression = 0;
    }
| '(' '*' comma_expr ')'
    {
#ifndef NEW_FUNCTIONS
      ins_two_valued_cfun("c_evaluate",1);
      generate_frees();
#endif
    }
     '(' expr_list_on_stack ')'
    {
#ifdef NEW_FUNCTIONS
      ins_ext_cfun("c_evaluate",1,$7);
#else
      ins_ext_cfun("c_call_other",2,$7);
#endif
      generate_frees();
#ifdef DEBUG
      on_stack-=$7;
#endif
      $$ = TYPE_UNKNOWN;
      pop_arg_stack($7);	/* No good need of these arguments */
    };

efun_override: L_EFUN L_COLON_COLON identifier {
	struct svalue *res;

	$$ = lookup_predef($3);
	if ($$ == -1) {
	  char buf[100];
	  sprintf(buf, "Unknown efun: %s", $3);
	  yyerror(buf);
	  $$ == 0;
	} else {
	    push_malloced_string(the_file_name(current_file));
	    push_constant_string($3);
	    res = safe_apply_master_ob(APPLY_VALID_OVERRIDE, 2);
	    if (!MASTER_APPROVED(res)) {
		yyerror("Invalid simulated efunction override");
		$$ = 0;
	    }
	}
	FREE($3);
      }

function_name: L_IDENTIFIER
	     | L_COLON_COLON identifier
		{
		    char *p = DXALLOC(strlen($2) + 3, 54, "function_name: 1");
		    strcpy(p, "::"); strcpy(p + 2, $2); FREE($2);
		    $$ = p;
		}
	      | L_OBJECT L_COLON_COLON identifier
		{
		    char *p;

			p = DXALLOC(strlen($3) + 9, 55,
				"function_name: 2");
			strcpy(p, "object::"); strcpy(p + 8, $3);
			FREE($3);
			$$ = p;
		}
	      | not_efun_ident L_COLON_COLON identifier
		{
		    char *p;
		    int l;

		    p = DXALLOC((l = strlen($1)) + strlen($3) + 3, 55,
				"function_name: 2");
		    strcpy(p, $1); strcpy(p + l, "::"); strcpy(p + l + 2, $3);
		    FREE($1); FREE($3);
		    $$ = p;
		};

cond: condStart
      statement
      optional_else_part
	{
	};

condStart: L_IF {
	       ins_string("if (\n");
	    } 
      '(' comma_expr ')'
            {
	      generate_truth_test();
	      ins_string("\n)\n");
	      needs_comma = 0;
	    } ;

optional_else_part:
         /* empty */     %prec LOWER_THAN_ELSE
       | L_ELSE
        {
	  ins_string("else\n");
        }
         statement
       ;
%%

%include "lpc_compiler/post"
