/*
 * Copyright (c) 2002, The Tendra Project <http://www.ten15.org/>
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice unmodified, this list of conditions, and the following
 *    disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 *
 *    		 Crown Copyright (c) 1997
 *    
 *    This TenDRA(r) Computer Program is subject to Copyright
 *    owned by the United Kingdom Secretary of State for Defence
 *    acting through the Defence Evaluation and Research Agency
 *    (DERA).  It is made available to Recipients with a
 *    royalty-free licence for its use, reproduction, transfer
 *    to other parties and amendment for any purpose not excluding
 *    product development provided that any such use et cetera
 *    shall be deemed to be acceptance of the following conditions:-
 *    
 *        (1) Its Recipients shall ensure that this Notice is
 *        reproduced upon any copies or amended versions of it;
 *    
 *        (2) Any amended version of it shall be clearly marked to
 *        show both the nature of and the organisation responsible
 *        for the relevant amendment or amendments;
 *    
 *        (3) Its onward transfer from a recipient to another
 *        party shall be deemed to be that party's acceptance of
 *        these conditions;
 *    
 *        (4) DERA gives no warranty or assurance as to its
 *        quality or suitability for any purpose and DERA accepts
 *        no liability whatsoever in relation to any use to which
 *        it may be put.
 *
 * $TenDRA: tendra/src/producers/common/construct/exception.c,v 1.9 2005/08/04 20:22:16 stefanf Exp $
 */


#include "config.h"
#include "producer.h"

#include "msgcat.h"

#include "c_types.h"
#include "exp_ops.h"
#include "hashid_ops.h"
#include "id_ops.h"
#include "tok_ops.h"
#include "type_ops.h"
#include "error.h"
#include "catalog.h"
#include "option.h"
#include "allocate.h"
#include "basetype.h"
#include "cast.h"
#include "chktype.h"
#include "class.h"
#include "construct.h"
#include "convert.h"
#include "declare.h"
#include "derive.h"
#include "destroy.h"
#include "exception.h"
#include "expression.h"
#include "file.h"
#include "function.h"
#include "hash.h"
#include "identifier.h"
#include "initialise.h"
#include "label.h"
#include "namespace.h"
#include "predict.h"
#include "redeclare.h"
#include "statement.h"
#include "syntax.h"
#include "template.h"
#include "tokdef.h"
#include "typeid.h"


/*
 *    THE SET OF ALL TYPES
 *
 *    The dummy list univ_type_set is used to represent the set of all
 *    types.  These sets of types are used to represent exception
 *    specifications for functions.  The list empty_type_set is used to
 *    give the exception specification for a function when none is given,
 *    by default it equals univ_type_set.
 */

LIST (TYPE) univ_type_set = NULL_list (TYPE);
LIST (TYPE) empty_type_set = NULL_list (TYPE);


/*
 *    INITIALISE THE SET OF ALL TYPES
 *
 *    This routine initialises the set of all types to a dummy unique list.
 */

void
init_exception()
{
    LIST (TYPE) p;
    CONS_type (type_any, NULL_list (TYPE), p);
    p = uniq_type_set (p);
    COPY_list (type_func_except (type_func_void), p);
    COPY_list (type_func_except (type_temp_func), p);
    empty_type_set = p;
    univ_type_set = p;
    return;
}


/*
 *    IS A TYPE IN A SET OF TYPES?
 *
 *    This routine checks whether the type t is an element of the set of
 *    types listed as p.
 */

int
in_type_set(LIST (TYPE) p, TYPE t)
{
    if (EQ_list (p, univ_type_set)) return (1);
    expand_tokdef++;
    while (!IS_NULL_list (p)) {
		TYPE s = DEREF_type (HEAD_list (p));
		if (EQ_type (t, s) || eq_type_unqual (t, s)) {
			expand_tokdef--;
			return (1);
		}
		p = TAIL_list (p);
    }
    expand_tokdef--;
    return (0);
}


/*
 *    IS A TYPE DERIVABLE FROM A SET OF TYPES?
 *
 *    This routine checks whether an exception of type t will be caught by
 *    an element of the set of types listed as p.  It returns the catching
 *    type, or the null type if no match is found.
 */

static TYPE
from_type_set(LIST (TYPE) p, TYPE t)
{
    if (EQ_list (p, univ_type_set)) {
		/* The universal set catches everything */
		return (t);
    }
    expand_tokdef++;
    if (IS_type_ref (t)) t = DEREF_type (type_ref_sub (t));
    while (!IS_NULL_list (p)) {
		TYPE r = DEREF_type (HEAD_list (p));
		if (!IS_NULL_type (r)) {
			TYPE s = r;
			unsigned rank;
			CONVERSION conv;
			if (IS_type_ref (s)) s = DEREF_type (type_ref_sub (s));
			if (eq_type_unqual (t, s)) {
				/* Exact match is allowed */
				expand_tokdef--;
				return (r);
			}
			conv.from = t;
			conv.to = s;
			rank = std_convert_seq (&conv, NULL_exp, 0, 0);
			switch (rank) {
			case CONV_EXACT :
			case CONV_QUAL :
			case CONV_BASE :
			case CONV_PTR_BASE :
			case CONV_PTR_VOID :
			case CONV_PTR_BOTTOM : {
				/* These conversions are allowed */
				expand_tokdef--;
				return (r);
			}
			}
		}
		p = TAIL_list (p);
    }
    expand_tokdef--;
    return (NULL_type);
}


/*
 *    ARE TWO TYPE SETS EQUAL?
 *
 *    This routine checks whether the sets of types listed as p and q are
 *    equal.  It returns 2 if they are equal, 1 if p is a subset of q, and
 *    0 otherwise.  Because p and q will have been constructed not to contain
 *    duplicate elements a fair amount can be deduced from the cardinalities
 *    of the sets, also the search is optimised if the types are given in
 *    the same order in each set.  If eq is true then only equality is
 *    checked for.
 */

int
eq_type_set(LIST (TYPE) p, LIST (TYPE) q, int eq)
{
    unsigned n, m;
    LIST (TYPE) r;
	
    /* Deal with the set of all types */
    if (EQ_list (p, q)) return (2);
    if (EQ_list (q, univ_type_set) && !eq) return (1);
    if (EQ_list (p, univ_type_set)) return (0);
	
    /* Check whether p is larger than q */
    n = LENGTH_list (p);
    m = LENGTH_list (q);
    if (n > m) return (0);
    if (n < m && eq) return (0);
	
    /* Check whether p is a subset of q */
    r = q;
    while (!IS_NULL_list (p)) {
		TYPE t = DEREF_type (HEAD_list (p));
		TYPE s = DEREF_type (HEAD_list (r));
		if (!EQ_type (t, s) && !eq_type_unqual (t, s)) {
			if (!in_type_set (q, t)) return (0);
		}
		r = TAIL_list (r);
		p = TAIL_list (p);
    }
	
    /* Check for equality using set sizes */
    if (n < m) return (1);
    return (2);
}


/*
 *    ADD AN ELEMENT TO A TYPE SET
 *
 *    This routine adds the type t to the type set p if it is not already
 *    a member.
 */

LIST (TYPE)
cons_type_set(LIST (TYPE) p, TYPE t)
{
    if (!IS_NULL_type (t) && !in_type_set (p, t)) {
		CONS_type (t, p, p);
    }
    return (p);
}


/*
 *    FIND THE UNION OF TWO TYPE SETS
 *
 *    This routine adds the elements of the type set q to the type set p.
 */

LIST (TYPE)
union_type_set(LIST (TYPE) p, LIST (TYPE) q)
{
    if (!EQ_list (p, univ_type_set)) {
		if (EQ_list (q, univ_type_set)) {
			DESTROY_list (p, SIZE_type);
			p = q;
		} else {
			while (!IS_NULL_list (q)) {
				TYPE t = DEREF_type (HEAD_list (q));
				if (!IS_NULL_type (t)) {
					if (!in_type_set (p, t)) CONS_type (t, p, p);
				}
				q = TAIL_list (q);
			}
		}
    }
    return (p);
}


/*
 *    MAKE A UNIQUE COPY OF A TYPE SET
 *
 *    This routine maintains a list of type sets.  If p equals an element of
 *    this list then the copy is returned and p is destroyed.  Otherwise p
 *    is added to the list.
 */

LIST (TYPE)
uniq_type_set(LIST (TYPE) p)
{
    static LIST (LIST (TYPE)) sets = NULL_list (LIST (TYPE));
    LIST (LIST (TYPE)) s = sets;
    while (!IS_NULL_list (s)) {
		LIST (TYPE) q = DEREF_list (HEAD_list (s));
		if (eq_type_set (p, q, 1) == 2) {
			DESTROY_list (p, SIZE_type);
			return (q);
		}
		s = TAIL_list (s);
    }
    CONS_list (p, sets, sets);
    return (p);
}


/*
 *    COMPARE THE EXCEPTION SPECIFIERS OF TWO TYPES
 *
 *    This routine compares the exception specifiers of the similar types
 *    s and t.  It returns 2 if they are equal, 1 if s is more constrained
 *    than t, and 0 otherwise.
 */

int
eq_except(TYPE s, TYPE t)
{
    unsigned ns, nt;
    if (EQ_type (s, t)) return (2);
    if (IS_NULL_type (s)) return (0);
    if (IS_NULL_type (t)) return (0);
    ns = TAG_type (s);
    nt = TAG_type (t);
    if (ns != nt) return (2);
    ASSERT (ORDER_type == 18);
    switch (ns) {
		
	case type_func_tag : {
	    /* Function types */
	    LIST (TYPE) es = DEREF_list (type_func_except (s));
	    LIST (TYPE) et = DEREF_list (type_func_except (t));
	    int eq = eq_type_set (es, et, 0);
	    if (eq) {
			TYPE rs, rt;
			LIST (TYPE) ps = DEREF_list (type_func_ptypes (s));
			LIST (TYPE) pt = DEREF_list (type_func_ptypes (t));
			while (!IS_NULL_list (ps) && !IS_NULL_list (pt)) {
				rs = DEREF_type (HEAD_list (ps));
				rt = DEREF_type (HEAD_list (pt));
				if (eq_except (rs, rt) != 2) return (0);
				pt = TAIL_list (pt);
				ps = TAIL_list (ps);
			}
			rs = DEREF_type (type_func_ret (s));
			rt = DEREF_type (type_func_ret (t));
			if (eq_except (rs, rt) != 2) return (0);
	    }
	    return (eq);
	}
		
	case type_ptr_tag :
	case type_ref_tag : {
	    /* Pointer and reference types */
	    TYPE ps = DEREF_type (type_ptr_etc_sub (s));
	    TYPE pt = DEREF_type (type_ptr_etc_sub (t));
	    return (eq_except (ps, pt));
	}
		
	case type_ptr_mem_tag : {
	    /* Pointer to member types */
	    TYPE ps = DEREF_type (type_ptr_mem_sub (s));
	    TYPE pt = DEREF_type (type_ptr_mem_sub (t));
	    return (eq_except (ps, pt));
	}
		
	case type_array_tag : {
	    /* Array types */
	    TYPE ps = DEREF_type (type_array_sub (s));
	    TYPE pt = DEREF_type (type_array_sub (t));
	    return (eq_except (ps, pt));
	}
		
	case type_templ_tag : {
	    /* Template types */
	    TOKEN as = DEREF_tok (type_templ_sort (s));
	    TOKEN at = DEREF_tok (type_templ_sort (t));
	    LIST (IDENTIFIER) qs = DEREF_list (tok_templ_pids (as));
	    LIST (IDENTIFIER) qt = DEREF_list (tok_templ_pids (at));
	    int eq = eq_templ_params (qs, qt);
	    if (eq) {
			TYPE ps = DEREF_type (type_templ_defn (s));
			TYPE pt = DEREF_type (type_templ_defn (t));
			eq = eq_except (ps, pt);
	    }
	    restore_templ_params (qs);
	    return (eq);
	}
    }
    return (2);
}


/*
 *    CREATE AN EXCEPTION TYPE
 *
 *    This routine converts the exception type t to its primary form.
 *    Reference types are replaced by the referenced type and any top level
 *    type qualifiers are removed.  chk gives the context for the conversion,
 *    1 for a throw expression, 2 for a catch statement, 3 for an exception
 *    specifier and 0 otherwise.
 */

TYPE
exception_type(TYPE t, int chk)
{
    if (!IS_NULL_type (t)) {
		unsigned tag = TAG_type (t);
		if (tag == type_ref_tag) {
			t = DEREF_type (type_ref_sub (t));
			tag = TAG_type (t);
		}
		t = qualify_type (t, cv_none, 0);
		if (chk) {
			/* Check exception type */
			TYPE s = t;
			if (tag == type_ptr_tag) {
				s = DEREF_type (type_ptr_sub (s));
				tag = TAG_type (s);
			}
			if (tag == type_compound_tag) {
				ERROR err = check_incomplete (s);
				if (!IS_NULL_err (err)) {
					/* Can't have an incomplete class */
					ERROR err2 = NULL_err;
					switch (chk) {
					case 1 : err2 = ERR_except_throw_incompl () ; break;
					case 2 : err2 = ERR_except_handle_incompl () ; break;
					case 3 : err2 = ERR_except_spec_incompl () ; break;
					}
					err = concat_error (err, err2);
					report (crt_loc, err);
				}
				if (chk == 1) {
					/* Can't throw a type with an ambiguous base */
					CLASS_TYPE cs = DEREF_ctype (type_compound_defn (s));
					err = class_info (cs, cinfo_ambiguous, 1);
					if (!IS_NULL_err (err)) {
						ERROR err2 = ERR_except_throw_ambig ();
						err = concat_error (err, err2);
						report (crt_loc, err);
					}
				}
			}
		}
    }
    return (t);
}


/*
 *    CHECK AN EXCEPTION SPECIFIER TYPE
 *
 *    This routine checks the type t, which forms part of an exception
 *    specification for a function.  The argument n gives the number of types
 *    defined in t.
 */

TYPE
check_except_type(TYPE t, int n)
{
    if (n) report (crt_loc, ERR_except_spec_typedef ());
    IGNORE exception_type (t, 3);
    return (t);
}


/*
 *    STACK OF CURRENTLY ACTIVE TRY BLOCKS
 *
 *    The stack crt_try_block is used to hold all the currently active try
 *    blocks and exception handlers.  The flag in_func_handler is set to
 *    1 (or 2 for constructors and destructors) in the handler of a function
 *    try block.
 */

STACK (EXP) crt_try_blocks = NULL_stack (EXP);
static STACK (STACK (EXP)) past_try_blocks = NULL_stack (STACK (EXP));
int in_func_handler = 0;


/*
 *    CHECK A THROWN TYPE
 *
 *    This routine checks the type t thrown from an explicit throw expression
 *    (if expl is true) or a function call.  The null type is used to
 *    indicate an unknown type.  The routine returns true if the exception
 *    is caught by an enclosing handler.
 */

int
check_throw(TYPE t, int expl)
{
    IDENTIFIER fn;
    LIST (EXP) p = LIST_stack (crt_try_blocks);
    while (!IS_NULL_list (p)) {
		EXP e = DEREF_exp (HEAD_list (p));
		if (IS_exp_try_block (e)) {
			/* Add to list of thrown types */
			LIST (TYPE) q;
			q = DEREF_list (exp_try_block_ttypes (e));
			if (!EQ_list (q, univ_type_set)) {
				LIST (LOCATION) ql;
				ql = DEREF_list (exp_try_block_tlocs (e));
				if (IS_NULL_type (t)) {
					DESTROY_list (q, SIZE_type);
					DESTROY_list (ql, SIZE_loc);
					q = univ_type_set;
					ql = NULL_list (LOCATION);
					CONS_loc (crt_loc, ql, ql);
				} else {
					if (!in_type_set (q, t)) {
						CONS_type (t, q, q);
						CONS_loc (crt_loc, ql, ql);
					}
				}
				COPY_list (exp_try_block_ttypes (e), q);
				COPY_list (exp_try_block_tlocs (e), ql);
			}
			return (1);
		}
		if (IS_NULL_type (t) && expl && IS_exp_handler (e)) {
			/* Can deduce type of 'throw' inside a handler */
			IDENTIFIER ex = DEREF_id (exp_handler_except (e));
			if (!IS_NULL_id (ex)) {
				t = DEREF_type (id_variable_etc_type (ex));
				t = exception_type (t, 0);
			}
		}
		p = TAIL_list (p);
    }
	
    /* Exception not caught by any try block */
    fn = crt_func_id;
    if (IS_NULL_type (t)) t = type_any;
    if (IS_NULL_id (fn)) {
		report (crt_loc, ERR_except_spec_throw (t));
    } else {
		report (crt_loc, ERR_except_spec_call (fn, t));
    }
    return (0);
}


/*
 *    CHECK THE EXCEPTIONS THROWN IN A TRY BLOCK
 *
 *    This routine checks the exceptions thrown in the try block e.  Any
 *    which are not caught by the handlers of e are passed to the enclosing
 *    block or reported if this is the outermost block.  The routine
 *    returns true if all the exceptions are handled by an enclosing block.
 */

int
check_try_block(EXP e)
{
    int res = 1;
    if (IS_exp_try_block (e)) {
		LOCATION loc;
		LIST (LOCATION) ql;
		LIST (TYPE) p = DEREF_list (exp_try_block_htypes (e));
		LIST (TYPE) q = DEREF_list (exp_try_block_ttypes (e));
		EXP a = DEREF_exp (exp_try_block_ellipsis (e));
		if (EQ_list (p, univ_type_set)) {
			/* Have handlers for any type */
			return (1);
		}
		if (!IS_NULL_exp (a) && IS_exp_handler (a)) {
			/* Have a ... handler */
			return (1);
		}
		bad_crt_loc++;
		loc = crt_loc;
		ql = DEREF_list (exp_try_block_tlocs (e));
		if (EQ_list (q, univ_type_set)) {
			/* Can throw any type */
			DEREF_loc (HEAD_list (ql), crt_loc);
			res = check_throw (NULL_type, 0);
		} else {
			/* Can throw a finite set of types */
			q = REVERSE_list (q);
			ql = REVERSE_list (ql);
			COPY_list (exp_try_block_ttypes (e), q);
			COPY_list (exp_try_block_tlocs (e), ql);
			while (!IS_NULL_list (q)) {
				TYPE t = DEREF_type (HEAD_list (q));
				TYPE u = from_type_set (p, t);
				if (IS_NULL_type (u)) {
					/* Throw uncaught type to enclosing block */
					DEREF_loc (HEAD_list (ql), crt_loc);
					if (!check_throw (t, 0)) res = 0;
				}
				ql = TAIL_list (ql);
				q = TAIL_list (q);
			}
		}
		crt_loc = loc;
		bad_crt_loc--;
    }
    return (res);
}


/*
 *    CHECK THE EXCEPTIONS THROWN BY A FUNCTION CALL
 *
 *    This routine checks the possible exceptions thrown by a call to a
 *    function of type fn.  When known the function name is given by fid.
 *    The routine returns true if the exception is handled by an enclosing
 *    try-block.
 */

int
check_func_throw(TYPE fn, IDENTIFIER fid)
{
    int res = 1;
    if (IS_type_func (fn)) {
		LIST (TYPE) p = DEREF_list (type_func_except (fn));
		if (IS_NULL_list (p)) return (1);
		if (EQ_list (p, univ_type_set)) {
			/* Can throw any type */
			res = check_throw (NULL_type, 0);
		} else {
			/* Can throw a finite set of types */
			while (!IS_NULL_list (p)) {
				TYPE t = DEREF_type (HEAD_list (p));
				if (!IS_NULL_type (t)) {
					if (!check_throw (t, 0)) res = 0;
				}
				p = TAIL_list (p);
			}
		}
    } else {
		res = check_throw (NULL_type, 0);
    }
    UNUSED (fid);
    return (res);
}


/*
 *    START THE EXCEPTION CHECKS FOR A FUNCTION DEFINITION
 *
 *    This routine starts the exception specification checks for a function
 *    which throws the types p.
 */

void
start_try_check(LIST (TYPE) p)
{
    EXP e;
    MAKE_exp_try_block (type_void, NULL_exp, 0, e);
    COPY_list (exp_try_block_htypes (e), p);
    PUSH_stack (crt_try_blocks, past_try_blocks);
    crt_try_blocks = NULL_stack (EXP);
    PUSH_exp (e, crt_try_blocks);
    return;
}


/*
 *    END THE EXCEPTION CHECKS FOR A FUNCTION DEFINITION
 *
 *    This routine ends the exception specification checks for the function
 *    id with definition a.
 */

EXP
end_try_check(IDENTIFIER id, EXP a)
{
    EXP e;
    POP_exp (e, crt_try_blocks);
    POP_stack (crt_try_blocks, past_try_blocks);
    if (!IS_NULL_exp (e) && IS_exp_try_block (e)) {
		IDENTIFIER fid = crt_func_id;
		crt_func_id = id;
		IGNORE check_try_block (e);
		if (EQ_id (fid, id)) {
			LIST (TYPE) p = DEREF_list (exp_try_block_ttypes (e));
			if (IS_NULL_list (p) && !in_template_decl) {
				/* Function can't throw an exception */
				DECL_SPEC ds = DEREF_dspec (id_storage (id));
				ds |= dspec_friend;
				COPY_dspec (id_storage (id), ds);
			}
		}
		COPY_list (exp_try_block_htypes (e), NULL_list (TYPE));
		free_exp (e, 1);
		crt_func_id = fid;
    }
    return (a);
}


/*
 *    EXCEPTION HANDLING ROUTINES
 *
 *    The exception handling routines are only included in the C++ producer.
 */

#if LANGUAGE_CPP


/*
 *    BEGIN THE CONSTRUCTION OF A TRY STATEMENT
 *
 *    This routine begins the construction of the statement 'try { body }
 *    handlers'.  It is called immediately after the 'try'.  func is true
 *    for a function-try-block.
 */

EXP
begin_try_stmt(int func)
{
    EXP e;
    if (func) {
		/* Check function try blocks */
		IDENTIFIER fn = crt_func_id;
		if (!IS_NULL_id (fn)) {
			HASHID nm = DEREF_hashid (id_name (fn));
			unsigned tag = TAG_hashid (nm);
			if (tag == hashid_constr_tag || tag == hashid_destr_tag) {
				/* Constructors and destructors are marked */
				func = 2;
			}
		} else {
			func = 0;
		}
    }
    MAKE_exp_try_block (type_void, NULL_exp, func, e);
    CONS_exp (e, all_try_blocks, all_try_blocks);
    PUSH_exp (e, crt_try_blocks);
    return (e);
}


/*
 *    INJECT FUNCTION PARAMETERS INTO A HANDLER
 *
 *    It is not allowed to redeclare a function parameter in the body or
 *    the handler of a function-try-block.  This routine ensures this by
 *    injecting the function parameters into the current scope when prev
 *    is a function-try-block.
 */

void
inject_try_stmt(EXP prev)
{
    int func = DEREF_int (exp_try_block_func (prev));
    if (func) {
		IDENTIFIER id = crt_func_id;
		if (!IS_NULL_id (id) && IS_id_function_etc (id)) {
			LIST (IDENTIFIER) pids;
			NAMESPACE ns = crt_namespace;
			TYPE t = DEREF_type (id_function_etc_type (id));
			while (IS_type_templ (t)) {
				t = DEREF_type (type_templ_defn (t));
			}
			pids = DEREF_list (type_func_pids (t));
			while (!IS_NULL_list (pids)) {
				IDENTIFIER pid = DEREF_id (HEAD_list (pids));
				IGNORE redeclare_id (ns, pid);
				pids = TAIL_list (pids);
			}
		}
    }
    return;
}


/*
 *    CONTINUE THE CONSTRUCTION OF A TRY STATEMENT
 *
 *    This routine continues the construction of the try statement prev by
 *    filling in the given body statement.
 */

EXP
cont_try_stmt(EXP prev, EXP body)
{
    EXP e;
    int func = DEREF_int (exp_try_block_func (prev));
    if (func) in_func_handler = func;
    COPY_exp (exp_try_block_body (prev), body);
    set_parent_stmt (body, prev);
    POP_exp (e, crt_try_blocks);
    UNUSED (e);
    return (prev);
}


/*
 *    COMPLETE THE CONSTRUCTION OF A TRY STATEMENT
 *
 *    This routine completes the construction of the try statement prev.  It
 *    checks whether it contains at least one handler and determines the
 *    reachability of the following statement.
 */

EXP
end_try_stmt(EXP prev, int empty)
{
    EXP e;
    TYPE t;
    int all_bottom = 1;
    int func = DEREF_int (exp_try_block_func (prev));
	
    /* Check handler list */
    EXP ell = DEREF_exp (exp_try_block_ellipsis (prev));
    LIST (EXP) hs = DEREF_list (exp_try_block_handlers (prev));
    LIST (TYPE) ps = DEREF_list (exp_try_block_ttypes (prev));
    unsigned nh = LENGTH_list (hs);
    if (IS_NULL_exp (ell)) {
		/* Create default handler if necessary */
		if (IS_NULL_list (hs) && !empty) {
			/* Check that there is at least one handler */
			report (crt_loc, ERR_except_handlers ());
		}
		MAKE_exp_exception (type_bottom, ell, NULL_exp, NULL_exp, 0, ell);
		COPY_exp (exp_try_block_ellipsis (prev), ell);
    } else {
		nh++;
    }
    IGNORE check_value (OPT_VAL_exception_handlers, (ulong) nh);
	
    /* Do unreached code analysis */
    e = DEREF_exp (exp_try_block_body (prev));
    t = DEREF_type (exp_type (e));
    if (IS_type_bottom (t)) {
		/* Don't reach end of try block */
		t = DEREF_type (exp_type (ell));
		if (!IS_type_bottom (t)) all_bottom = 0;
		while (!IS_NULL_list (hs) && all_bottom) {
			/* Check the other handlers */
			e = DEREF_exp (HEAD_list (hs));
			t = DEREF_type (exp_type (e));
			if (!IS_type_bottom (t)) all_bottom = 0;
			hs = TAIL_list (hs);
		}
    } else {
		/* Reach end of try block */
		all_bottom = 0;
    }
    if (all_bottom) {
		COPY_type (exp_type (prev), type_bottom);
		unreached_code = 1;
		unreached_last = 0;
    } else {
		unreached_code = unreached_prev;
    }
    if (IS_NULL_list (ps) && !empty && !in_template_decl) {
		report (crt_loc, ERR_except_not ());
    }
    if (func) in_func_handler = 0;
    IGNORE check_try_block (prev);
    return (prev);
}


/*
 *    MARK ALL VARIABLES ENCLOSING A TRY BLOCK
 *
 *    This routine marks all the local variables of the function id which
 *    contain a try block within their scope.
 */

void
end_try_blocks(IDENTIFIER id)
{
    LIST (EXP) p = all_try_blocks;
    if (!IS_NULL_list (p)) {
		if (!IS_NULL_id (id)) {
			/* Mark function */
			DECL_SPEC ds = DEREF_dspec (id_storage (id));
			ds |= dspec_mutable;
			COPY_dspec (id_storage (id), ds);
		}
		while (!IS_NULL_list (p)) {
			EXP a = DEREF_exp (HEAD_list (p));
			while (!IS_NULL_exp (a)) {
				if (IS_exp_decl_stmt (a)) {
					IDENTIFIER pid = DEREF_id (exp_decl_stmt_id (a));
					DECL_SPEC ds = DEREF_dspec (id_storage (pid));
					if (ds & dspec_auto) {
						/* Mark local variable */
						ds |= dspec_mutable;
						COPY_dspec (id_storage (pid), ds);
					}
				}
				a = get_parent_stmt (a);
			}
			p = TAIL_list (p);
		}
    }
    return;
}


/*
 *    DECLARE AN EXCEPTION HANDLER
 *
 *    This routine declares an exception handler named id with type t and
 *    declaration specifiers ds (which should always be empty).  n gives
 *    the number of types defined in t.
 */

IDENTIFIER
make_except_decl(DECL_SPEC ds, TYPE t, IDENTIFIER id, int n)
{
    /* Declare id as a local variable */
    EXP e;
    if (crt_id_qualifier == qual_nested || crt_templ_qualifier) {
		/* Other illegal identifiers are caught elsewhere */
		report (crt_loc, ERR_dcl_meaning_id (qual_nested, id));
    }
    if (n) report (crt_loc, ERR_except_handle_typedef ());
    t = make_param_type (t, CONTEXT_PARAMETER);
    id = make_object_decl (ds, t, id, 0);
	
    /* The initialising value is the current exception */
    if (IS_type_ref (t)) {
		t = DEREF_type (type_ref_sub (t));
    }
    t = lvalue_type (t);
    MAKE_exp_thrown (t, 0, e);
    IGNORE init_object (id, e);
    return (id);
}


/*
 *    BEGIN THE CONSTRUCTION OF A CATCH STATEMENT
 *
 *    This routine begins the construction of the handler 'catch (ex)
 *    { body }' associated with the try block block.  It is called after the
 *    declaration of ex.  Note that ex can be the null identifier, indicating
 *    that the handler is '...'.
 */

EXP
begin_catch_stmt(EXP block, IDENTIFIER ex)
{
    /* Construct the result */
    EXP e, d;
    MAKE_exp_handler (type_void, ex, NULL_exp, e);
    COPY_exp (exp_handler_parent (e), block);
    unreached_code = 0;
    unreached_last = 0;
	
    /* Check for '...' handlers */
    d = DEREF_exp (exp_try_block_ellipsis (block));
    if (!IS_NULL_exp (d)) {
		/* Already have a '...' handler */
		report (crt_loc, ERR_except_handle_ellipsis ());
		unreached_code = 1;
    } else if (IS_NULL_id (ex)) {
		/* Set the '...' handler if necessary */
		COPY_exp (exp_try_block_ellipsis (block), e);
    } else {
		/* Add to list of other handlers */
		TYPE t0;
		TYPE t, s;
		LIST (EXP) p, q;
		LIST (TYPE) u, v;
		
		/* Check list of handler types */
		u = DEREF_list (exp_try_block_htypes (block));
		t0 = DEREF_type (id_variable_etc_type (ex));
		t = exception_type (t0, 2);
		s = from_type_set (u, t);
		if (!IS_NULL_type (s)) {
			report (crt_loc, ERR_except_handle_unreach (t0, s));
			unreached_code = 1;
		}
		CONS_type (t, NULL_list (TYPE), v);
		u = APPEND_list (u, v);
		COPY_list (exp_try_block_htypes (block), u);
		
		/* Add ex to list of handler expressions */
		p = DEREF_list (exp_try_block_handlers (block));
		CONS_exp (e, NULL_list (EXP), q);
		p = APPEND_list (p, q);
		COPY_list (exp_try_block_handlers (block), p);
    }
    PUSH_exp (e, crt_try_blocks);
    return (e);
}


/*
 *    COMPLETE THE CONSTRUCTION OF A CATCH STATEMENT
 *
 *    This routine completes the construction of the catch statement prev by
 *    filling in the given body statement.
 */

EXP
end_catch_stmt(EXP prev, EXP body)
{
    EXP e;
    if (unreached_code) {
		/* Mark unreached statements */
		COPY_type (exp_type (prev), type_bottom);
    } else {
		/* Control reaches end of handler */
		int func;
		e = DEREF_exp (exp_handler_parent (prev));
		func = DEREF_int (exp_try_block_func (e));
		if (func == 2) {
			/* Re-throw current exception */
			e = make_throw_exp (NULL_exp, 0);
			body = add_compound_stmt (body, e);
			COPY_type (exp_type (prev), type_bottom);
		}
    }
    COPY_exp (exp_handler_body (prev), body);
    set_parent_stmt (body, prev);
    POP_exp (e, crt_try_blocks);
    UNUSED (e);
    return (prev);
}


/*
 *    CONSTRUCT A THROW ARGUMENT FROM A TYPE
 *
 *    The syntax 'throw t' for a type t is exactly equivalent to 'throw t ()'.
 *    This routine constructs the argument 't ()'.  n gives the number of types
 *    defined in t.
 */

EXP
make_throw_arg(TYPE t, int n)
{
    EXP e;
    report (crt_loc, ERR_except_throw_type ());
    if (n) report (crt_loc, ERR_except_throw_typedef ());
    e = make_func_cast_exp (t, NULL_list (EXP));
    return (e);
}


/*
 *    CONSTRUCT A THROW EXPRESSION
 *
 *    This routine constructs the expressions 'throw a' and 'throw' (if a is
 *    the null expression).  Note that a is assigned to a temporary variable
 *    of its own type.
 */

EXP
make_throw_exp(EXP a, int expl)
{
    EXP e;
    EXP b = NULL_exp;
    EXP d = NULL_exp;
    if (!IS_NULL_exp (a)) {
		/* Perform operand conversions on a */
		TYPE t;
		ERROR err;
		a = convert_reference (a, REF_NORMAL);
		t = DEREF_type (exp_type (a));
		if (!IS_type_compound (t)) {
			a = convert_lvalue (a);
			t = DEREF_type (exp_type (a));
		}
		t = exception_type (t, 1);
		IGNORE check_throw (t, 1);
		b = sizeof_exp (t);
		err = check_complete (t);
		if (IS_NULL_err (err)) {
			/* Exception is assigned to temporary variable */
			a = init_assign (t, cv_none, a, &err);
			d = init_default (t, &d, DEFAULT_DESTR, EXTRA_DESTR, &err);
			if (!IS_NULL_err (err)) err = init_error (err, 0);
		}
		if (!IS_NULL_err (err)) {
			/* Report type errors */
			err = concat_error (err, ERR_except_throw_copy ());
			report (crt_loc, err);
		}
		a = check_return_exp (a, lex_throw);
    } else {
		/* Check thrown type */
		IGNORE check_throw (NULL_type, 1);
    }
    MAKE_exp_exception (type_bottom, a, b, d, expl, e);
    return (e);
}


#endif