Subversion Repositories tendra.SVN

/*

 * Copyright (c) 2002-2006 The TenDRA Project <http://www.tendra.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,

 *    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.

 * 3. Neither the name of The TenDRA Project nor the names of its contributors

 *    may be used to endorse or promote products derived from this software

 *    without specific, prior written permission.

 *

 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``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 COPYRIGHT HOLDERS OR

 * CONTRIBUTORS 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.

 *

 * $Id$

 */

/*

    		 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.

*/

#include "config.h"

#include "c_types.h"

#include "ctype_ops.h"

#include "etype_ops.h"

#include "exp_ops.h"

#include "hashid_ops.h"

#include "id_ops.h"

#include "itype_ops.h"

#include "member_ops.h"

#include "nat_ops.h"

#include "nspace_ops.h"

#include "off_ops.h"

#include "type_ops.h"

#include "error.h"

#include "catalog.h"

#include "option.h"

#include "access.h"

#include "allocate.h"

#include "basetype.h"

#include "cast.h"

#include "check.h"

#include "chktype.h"

#include "constant.h"

#include "construct.h"

#include "convert.h"

#include "copy.h"

#include "declare.h"

#include "derive.h"

#include "destroy.h"

#include "dump.h"

#include "exception.h"

#include "expression.h"

#include "file.h"

#include "function.h"

#include "hash.h"

#include "identifier.h"

#include "initialise.h"

#include "lex.h"

#include "namespace.h"

#include "overload.h"

#include "predict.h"

#include "statement.h"

#include "syntax.h"

#include "template.h"

#include "typeid.h"

/*

    PERFORM AN ARITHMETIC OPERATION ON AN ARRAY DIMENSION

    This routine calculates the simple arithmetic operation 'a op b'.  Any

    conversion errors are suppressed.

*/

static EXP

make_dim_exp(int op, EXP a, EXP b)

{

	EXP e;

	int et;

	if (IS_NULL_exp(a)) {

		return (b);

	}

	if (IS_NULL_exp(b)) {

		return (a);

	}

	et = error_threshold;

	error_threshold = ERROR_SERIOUS;

	if (op == lex_plus) {

		e = make_plus_exp(a, b);

	} else {

		e = make_mult_exp(op, a, b);

	}

	error_threshold = et;

	return (e);

}

/*

    ALLOCATION ROUTINES

    The memory allocation and deallocation routines are only contained in

    the C++ producer.

*/

#if LANGUAGE_CPP

/*

    BAD ALLOCATION EXCEPTION TYPE

    The variable type_bad_alloc is used to represent the standard exception

    type 'std::bad_alloc' thrown when an allocation function fails.  The

    list alloc_types is used to record all the function types for simple

    allocation functions.

*/

static TYPE type_bad_alloc = NULL_type;

static LIST(TYPE) alloc_types = NULL_list(TYPE);

/*

    SET THE BAD ALLOCATION EXCEPTION TYPE

    This routine sets type_bad_alloc to be t, updating the exception

    specifiers of any simple allocation functions previously declared.

*/

static void

set_bad_alloc(TYPE t)

{

	if (!IS_NULL_type(t)) {

		LIST(TYPE)p = alloc_types;

		while (!IS_NULL_list(p)) {

			TYPE s = DEREF_type(HEAD_list(p));

			LIST(TYPE)e = DEREF_list(type_func_except(s));

			if (!IS_NULL_list(e) && !EQ_list(e, univ_type_set)) {

				/* Change 'throw ( X )' to

				 * 'throw ( std::bad_alloc )' */

				e = TAIL_list(e);

				CONS_type(t, e, e);

				COPY_list(type_func_except(s), e);

			}

			p = TAIL_list(p);

		}

		type_bad_alloc = t;

	}

	return;

}

/*

    CHECK AN ALLOCATION FUNCTION

    This routine checks whether the function type t is a suitable

    declaration for the allocation or deallocation function given by id.

    mem is true for member functions.  The basic forms allowed are:

	void *operator new ( size_t, [further parameters] ) ;

	void *operator new[] ( size_t, [further parameters] ) ;

	void operator delete ( void *, [further parameters] ) ;

	void operator delete[] ( void *, [further parameters] ) ;

    Before the introduction of placement delete the only further parameters

    allowed in a deallocation function was a single 'size_t' for member

    functions.  Note that template functions are allowed (indicated by

    templ), but they must have the form above and at least one further

    parameter.

*/

TYPE

check_allocator(TYPE t, IDENTIFIER id, int mem, int templ)

{

	if (IS_type_templ(t)) {

		/* Allow for template types */

		TYPE s = DEREF_type(type_templ_defn(t));

		s = check_allocator(s, id, mem, templ + 1);

		COPY_type(type_templ_defn(t), s);

	} else {

		/* Find the operator */

		HASHID nm = DEREF_hashid(id_name(id));

		int op = DEREF_int(hashid_op_lex(nm));

		/* Decompose function type */

		TYPE s;

		TYPE r = DEREF_type(type_func_ret(t));

		LIST(TYPE)p = DEREF_list(type_func_ptypes(t));

		LIST(IDENTIFIER)q = DEREF_list(type_func_pids(t));

		int ell = DEREF_int(type_func_ellipsis(t));

		if (!IS_NULL_list(p)) {

			s = DEREF_type(HEAD_list(p));

			p = TAIL_list(p);

		} else {

			s = type_void;

		}

		if (op == lex_new || op == lex_new_Harray) {

			/* Allocator should return 'void *' */

			TYPE u = type_void_star;

			if (!eq_type(r, u)) {

				report(crt_loc, ERR_basic_stc_alloc_ret(nm, u));

			}

			/* First parameter should be 'size_t' */

			u = type_size_t;

			if (!eq_type(s, u)) {

				report(crt_loc, ERR_basic_stc_alloc_p1(nm, u));

			}

			/* First parameter can't have a default argument */

			if (!IS_NULL_list(q)) {

				IDENTIFIER pid = DEREF_id(HEAD_list(q));

				EXP darg = DEREF_exp(id_parameter_init(pid));

				if (!IS_NULL_exp(darg)) {

					report(crt_loc,

					       ERR_basic_stc_alloc_d1(nm));

				}

			}

			/* Template functions should have another parameter */

			if (templ && IS_NULL_list(p)) {

				report(crt_loc, ERR_basic_stc_alloc_templ(nm));

			}

		} else {

			/* Deallocator should return 'void' */

			TYPE u = type_void;

			if (!eq_type(r, u)) {

				report(crt_loc, ERR_basic_stc_alloc_ret(nm, u));

			}

			/* First argument should be 'void *' */

			u = type_void_star;

			if (!eq_type(s, u)) {

				report(crt_loc, ERR_basic_stc_alloc_p1(nm, u));

			}

			/* Template functions should have another parameter */

			if (templ && IS_NULL_list(p)) {

				report(crt_loc, ERR_basic_stc_alloc_templ(nm));

			}

			/* Second argument may be 'size_t' (old form) */

			if (mem && !IS_NULL_list(p)) {

				u = type_size_t;

				s = DEREF_type(HEAD_list(p));

				if (!eq_type(s, u)) {

					report(crt_loc,

					       ERR_basic_stc_alloc_p2(nm, u));

				}

				p = TAIL_list(p);

			}

			/* No further arguments allowed (old form) */

			if (!IS_NULL_list(p) || ell) {

				report(crt_loc, ERR_basic_stc_alloc_pn(nm));

			}

		}

		/* Look up 'std::bad_alloc' */

		s = type_bad_alloc;

		if (IS_NULL_type(s)) {

			s = find_std_type("bad_alloc", 1, 0);

			set_bad_alloc(s);

		}

	}

	return (t);

}

/*

    CHECK AN ALLOCATOR DECLARATION

    This routine checks the allocator declaration id.  This should either

    be a class member or a member of the global namespace with external

    linkage.  alloc is 1 for allocator functions and 2 for deallocation

    functions.

*/

void

recheck_allocator(IDENTIFIER id, int alloc)

{

	NAMESPACE ns = DEREF_nspace(id_parent(id));

	if (alloc == 2) {

		IDENTIFIER over = DEREF_id(id_function_etc_over(id));

		if (!IS_NULL_id(over)) {

			/* Can't overload 'operator delete' (old form) */

			report(crt_loc, ERR_basic_stc_dealloc_over(over));

		}

	}

	if (!IS_NULL_nspace(ns)) {

		switch (TAG_nspace(ns)) {

		case nspace_global_tag: {

			/* Declared in global namespace */

			DECL_SPEC ds = DEREF_dspec(id_storage(id));

			if (ds & dspec_static) {

				report(crt_loc, ERR_basic_stc_alloc_link(id));

			}

			if (alloc == 1 && crt_file_type == 1) {

				/* Check for built-in allocation functions */

				TYPE t = DEREF_type(id_function_type(id));

				if (IS_type_func(t)) {

					LIST(TYPE)p;

					p = DEREF_list(type_func_ptypes(t));

					if (LENGTH_list(p) == 1) {

						CONS_type(t, alloc_types,

							  alloc_types);

					}

				}

			}

			break;

		}

		case nspace_ctype_tag: {

			/* Declared in class namespace */

			break;

		}

		default: {

			/* Declared in other namespace */

			report(crt_loc, ERR_basic_stc_alloc_nspace(id));

			break;

		}

		}

	}

	return;

}

/*

    FIND A DEALLOCATION FUNCTION

    This routine selects a deallocation function from the set of overloaded

    functions id.  If pid is not the null identifier then it is an

    allocation function for which a matching placement delete is required.

    mem is true for member functions.

*/

static IDENTIFIER

resolve_delete(IDENTIFIER id, IDENTIFIER pid, int mem)

{

	int eq = 0;

	IDENTIFIER rid;

	LIST(TYPE)p;

	TYPE fn = type_temp_func;

	LIST(IDENTIFIER)pids = NULL_list(IDENTIFIER);

	COPY_type(type_func_ret(fn), type_void);

	COPY_cv(type_func_mqual(fn), cv_none);

	/* Try placement delete */

	if (!IS_NULL_id(pid)) {

		TYPE t = DEREF_type(id_function_etc_type(pid));

		if (IS_type_func(t)) {

			p = DEREF_list(type_func_ptypes(t));

			if (!IS_NULL_list(p)) {

				p = TAIL_list(p);

			}

			CONS_type(type_void_star, p, p);

			COPY_list(type_func_ptypes(fn), p);

			COPY_list(type_func_mtypes(fn), p);

			rid = resolve_func(id, fn, 1, 1, pids, &eq);

			COPY_list(type_func_ptypes(fn), NULL_list(TYPE));

			COPY_list(type_func_mtypes(fn), NULL_list(TYPE));

			DESTROY_CONS_type(destroy, t, p, p);

			UNUSED(p);

			UNUSED(t);

			if (!IS_NULL_id(rid)) {

				return (rid);

			}

		}

		return (NULL_id);

	}

	/* Try 'void ( void * )' */

	CONS_type(type_void_star, NULL_list(TYPE), p);

	COPY_list(type_func_ptypes(fn), p);

	COPY_list(type_func_mtypes(fn), p);

	rid = resolve_func(id, fn, 0, 1, pids, &eq);

	COPY_list(type_func_ptypes(fn), NULL_list(TYPE));

	COPY_list(type_func_mtypes(fn), NULL_list(TYPE));

	DESTROY_list(p, SIZE_type);

	if (!IS_NULL_id(rid)) {

		return (rid);

	}

	/* Try 'void ( void *, size_t )' */

	if (mem) {

		CONS_type(type_size_t, NULL_list(TYPE), p);

		CONS_type(type_void_star, p, p);

		COPY_list(type_func_ptypes(fn), p);

		COPY_list(type_func_mtypes(fn), p);

		rid = resolve_func(id, fn, 0, 1, pids, &eq);

		COPY_list(type_func_ptypes(fn), NULL_list(TYPE));

		COPY_list(type_func_mtypes(fn), NULL_list(TYPE));

		DESTROY_list(p, SIZE_type);

		if (!IS_NULL_id(rid)) {

			return (rid);

		}

	}

	return (NULL_id);

}

/*

    LOOK UP AN ALLOCATOR FUNCTION

    This routine looks up the allocator function 'operator op'.  If b is

    true then the global namespace is checked first, otherwise if t is a

    class type then the members of t are checked, finally the allocator

    currently in scope is checked.  If option new_array is false and op

    is an array allocator, then the corresponding object allocator is

    returned, except if t is a class which has 'operator op' declared.

*/

IDENTIFIER

find_allocator(TYPE t, int op, int b, IDENTIFIER pid)

{

	int dealloc = 0;

	IDENTIFIER id = NULL_id;

	HASHID nm = lookup_op(op);

	HASHID nm_real = nm;

	/* Allow for pre-ISO dialect */

	switch (op) {

	case lex_new: {

		break;

	}

	case lex_new_Harray: {

		if (!option(OPT_new_array)) {

			nm = lookup_op(lex_new);

			t = type_error;

		}

		break;

	}

	case lex_delete: {

		dealloc = 1;

		break;

	}

	case lex_delete_Harray: {

		if (!option(OPT_new_array)) {

			nm = lookup_op(lex_delete);

			t = type_error;

		}

		dealloc = 1;

		break;

	}

	}

	if (b) {

		/* Try global scope ... */

		NAMESPACE ns = global_namespace;

		MEMBER mem = search_member(ns, nm, 0);

		if (!IS_NULL_member(mem)) {

			id = DEREF_id(member_id(mem));

			if (!IS_NULL_id(id) && dealloc) {

				id = resolve_delete(id, pid, 0);

			}

		}

	} else {

		/* Try class members ... */

		if (IS_type_compound(t)) {

			CLASS_TYPE ct = DEREF_ctype(type_compound_defn(t));

			NAMESPACE ns = DEREF_nspace(ctype_member(ct));

			id = search_field(ns, nm_real, 0, 0);

			if (IS_NULL_id(id) && !EQ_hashid(nm, nm_real)) {

				id = search_field(ns, nm, 0, 0);

			}

			if (!IS_NULL_id(id) && IS_id_ambig(id)) {

				id = report_ambiguous(id, 0, 1, 1);

			}

			if (!IS_NULL_id(id) && dealloc) {

				id = resolve_delete(id, pid, 1);

			}

		}

		/* Try current scope ... */

		if (IS_NULL_id(id)) {

			id = find_op_id(nm);

			if (!IS_NULL_id(id) && dealloc) {

				id = resolve_delete(id, pid, 0);

			}

		}

	}

	/* Return function */

	if (!IS_NULL_id(id)) {

		if (IS_id_function_etc(id)) {

			/* Function found */

			return (id);

		}

		if (is_ambiguous_func(id)) {

			if (dealloc) {

				/* Can't do overload resolution on delete */

				id = report_ambiguous(id, 0, 1, 1);

				return (id);

			}

			return (id);

		}

		if (!IS_id_dummy(id)) {

			/* Result is not a function */

			report(crt_loc, ERR_over_oper_func(id));

		}

	}

	if (IS_NULL_id(pid)) {

		/* Allocation functions not declared */

		report(crt_loc, ERR_lib_builtin(NULL_string, nm));

	}

	return (NULL_id);

}

/*

    CONSTRUCT A TEMPLATE DEPENDENT DELETE EXPRESSION

    This routine constructs a delete expression in the case where the

    expression type depends on a template parameter.

*/

static EXP

make_templ_delete(int op, int b, EXP a)

{

	EXP e;

	if (b) {

		/* Allow for '::delete' */

		if (op == lex_delete) {

			op = lex_delete_Hfull;

		} else {

			op = lex_delete_Harray_Hfull;

		}

	}

	MAKE_exp_op(type_void, op, a, NULL_exp, e);

	return (e);

}

/*

    CONSTRUCT A PLACEMENT DELETE EXPRESSION

    This routine constructs the expressions 'delete a' and 'delete [] a'

    (as indicated by op).  b indicates whether the expression was actually

    '::delete'.  pid is used in placement delete expressions to give the

    corresponding allocation function (place then gives the extra

    arguments), otherwise it is the null identifier.

*/

static EXP

placement_delete(int op, int b, EXP a, IDENTIFIER pid, LIST(EXP)place)

{

	int i;

	EXP e, c;

	TYPE t, p;

	IDENTIFIER id;

	unsigned npids;

	EXP d = NULL_exp;

	int need_cast = 1;

	int v = EXTRA_DESTR;

	ERROR err = NULL_err;

	LIST(EXP)args = NULL_list(EXP);

	/* Do operand conversion */

	a = convert_reference(a, REF_NORMAL);

	t = DEREF_type(exp_type(a));

	if (IS_type_compound(t)) {

		/* Conversion of class to pointer */

		c = convert_gen(CTYPE_PTR, a, &err);

		if (!IS_NULL_exp(c)) {

			if (!IS_NULL_err(err)) {

				err = concat_error(err,

						   ERR_expr_delete_conv(op));

				report(crt_loc, err);

			}

			a = c;

		}

	}

	/* Check operand type */

	a = convert_lvalue(a);

	t = DEREF_type(exp_type(a));

	if (IS_type_ptr(t)) {

		CV_SPEC cv;

		int arr = 0;

		p = DEREF_type(type_ptr_sub(t));

		if (is_templ_depend(p)) {

			e = make_templ_delete(op, b, a);

			return (e);

		}

		if (IS_type_top_etc(p)) {

			/* Check for 'void *' */

			report(crt_loc, ERR_expr_delete_void(op, t));

			need_cast = 0;

		} else {

			/* Check for incomplete types */

			err = check_object(p);

			if (!IS_NULL_err(err)) {

				err = concat_error(err,

						   ERR_expr_delete_obj(op));

				report(crt_loc, err);

			}

			err = check_incomplete(p);

			if (!IS_NULL_err(err)) {

				err = concat_error(err,

						   ERR_expr_delete_incompl(op));

				report(crt_loc, err);

				if (IS_type_compound(p)) {

					/* Mark incomplete class types */

					CLASS_TYPE ct =

					    DEREF_ctype(type_compound_defn(p));

					CLASS_USAGE cu =

					    DEREF_cusage(ctype_usage(ct));

					cu |= cusage_destr;

					if (b == 0) {

						if (op == lex_delete) {

							cu |= cusage_delete;

						} else {

							cu |= cusage_delete_array;

						}

					}

					COPY_cusage(ctype_usage(ct), cu);

				}

			}

		}

		while (IS_type_array(p)) {

			/* Allow for multi-dimensional arrays */

			arr = 1;

			p = DEREF_type(type_array_sub(p));

		}

		if (arr) {

			MAKE_type_ptr(cv_none, p, t);

		}

		cv = DEREF_cv(type_qual(p));

		if (cv & cv_const) {

			/* Check for deleting const objects */

			report(crt_loc, ERR_expr_delete_const(cv));

		}

	} else {

		/* Operand should be a pointer */

		if (is_templ_type(t)) {

			e = make_templ_delete(op, b, a);

			return (e);

		}

		if (!IS_type_error(t)) {

			report(crt_loc, ERR_expr_delete_ptr(op, t));

		}

		MAKE_exp_value(type_void, e);

		return (e);

	}

	/* Find destructors */

	err = NULL_err;

	i = (know_type(a) == 1 ? DEFAULT_DESTR : DEFAULT_DELETE);

	if (op == lex_delete && b == 0 && IS_NULL_id(pid)) {

		/* delete may be called via the destructor */

		v = (EXTRA_DESTR | EXTRA_DELETE);

	}

	d = init_default(p, &d, i, v, &err);

	if (!IS_NULL_err(err)) {

		report(crt_loc, err);

	}

	if (IS_NULL_exp(d)) {

		v = EXTRA_DESTR;

	}

	/* Find deallocation function */

	id = find_allocator(p, op, b, pid);

	if (!IS_NULL_id(id)) {

		LIST(IDENTIFIER)pids;

		TYPE fn = DEREF_type(id_function_etc_type(id));

		while (IS_type_templ(fn)) {

			fn = DEREF_type(type_templ_defn(fn));

		}

		pids = DEREF_list(type_func_pids(fn));

		npids = LENGTH_list(pids);

	} else {

		npids = 0;

	}

	/* Create dummy expression for first argument */

	MAKE_exp_dummy(t, a, LINK_NONE, NULL_off, 1, a);

	/* Create size variables if necessary */

	if (op == lex_delete || !IS_type_compound(p)) {

		c = NULL_exp;

		e = a;

	} else {

		OFFSET off;

		TYPE s = type_size_t;

		if (npids == 1 && IS_NULL_exp(d)) {

			MAKE_exp_null(s, c);

		} else {

			MAKE_exp_dummy(s, NULL_exp, LINK_NONE, NULL_off, 0, c);

		}

		MAKE_off_extra(p, -1, off);

		MAKE_exp_add_ptr(t, a, off, 0, e);

	}

	/* Create extra arguments */

	if (IS_NULL_id(pid)) {

		if (npids >= 2) {

			/* Pass size as extra argument */

			EXP sz = sizeof_exp(p);

			if (!IS_NULL_exp(c)) {

				EXP ex;

				OFFSET off;

				sz = make_dim_exp(lex_star, sz, c);

				MAKE_off_extra(p, 1, off);

				MAKE_exp_offset_size(type_size_t, off,

						     type_char, 1, ex);

				sz = make_dim_exp(lex_plus, sz, ex);

			}

			CONS_exp(sz, args, args);

		}

	} else {

		/* Copy placement arguments */

		/* NOT YET IMPLEMENTED */

		args = copy_exp_list(place, NULL_type, NULL_type);

	}

	/* Construct function call */

	if (!IS_NULL_id(id)) {

		if (need_cast) {

			MAKE_exp_cast(type_void_star, CONV_PTR_VOID, e, e);

		}

		CONS_exp(e, args, args);

		if (IS_id_stat_mem_func(id)) {

			/* Allow for static member functions */

			CONS_exp(NULL_exp, args, args);

		}

		use_func_id(id, 0, suppress_usage);

		e = apply_func_id(id, qual_none, NULL_graph, args);

		if (v == (EXTRA_DESTR | EXTRA_DELETE)) {

			/* 'operator delete' called via destructor */

			MAKE_exp_paren(type_void, e, e);

		}

	} else {

		e = NULL_exp;

	}

	/* Construct result */

	MAKE_exp_dealloc(type_void, d, e, a, c, e);

	return (e);

}

/*

    CREATE A SIMPLE DELETE EXPRESSION

    This routine is a special case of placement_delete which handles the

    explicit delete expressions.

*/

EXP

make_delete_exp(int op, int b, EXP a)

{

	EXP e = placement_delete(op, b, a, NULL_id, NULL_list(EXP));

	return (e);

}

/*

    DELETE ARRAY ANACHRONISM

    It used to be necessary to include the size of the array being deleted

    in 'delete []'.  This routine deals with this anachronism.

*/

void

old_delete_array(EXP e)

{

	/* Check that e is a suitable array bound */

	int op = lex_delete_Harray;

	IGNORE make_new_array_dim(e);

	/* But complain just the same */

	report(crt_loc, ERR_expr_delete_array(op));

	return;

}

/*

    CONSTRUCT A NEW ARRAY BOUND

    In a new-declarator the first array bound can be a variable expression,

    whereas all subsequent array bounds must be constant expressions as

    normal.  This routine is a version of make_array_dim designed exclusively

    to deal with this first bound.  Note that the result is not strictly

    a legal NAT and is only used to pass the bound information to

    make_new_exp, where it is prompty destroyed.

*/

NAT

make_new_array_dim(EXP e)

{

	NAT n;

	if (IS_exp_int_lit(e)) {

		/* Get the value if e is constant */

		n = DEREF_nat(exp_int_lit_nat(e));

	} else {

		/* Make dummy literal */

		MAKE_nat_calc(e, n);

	}

	return (n);

}

/*

    CONSTRUCT A TEMPLATE DEPENDENT NEW EXPRESSION

    This routine constructs a new expression in the case where the object

    type is a template parameter.  t gives the given type with array

    dimension d, while p is the pointer type.

*/

static EXP

make_templ_new(TYPE t, EXP d, TYPE p, int b, LIST(EXP)place, EXP init)

{

	EXP e;

	int op = (b ? lex_new_Hfull : lex_new);

	CONS_exp(init, place, place);