/*
* 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/allocate.c,v 1.10 2005/08/04 20:22:16 stefanf Exp $
*/
#include "config.h"
#include "producer.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 promptly 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);
CONS_exp (d, place, place);
MAKE_exp_value (t, e);
CONS_exp (e, place, place);
MAKE_exp_opn (p, op, place, e);
return (e);
}
/*
* CONSTRUCT A NEW EXPRESSION
*
* This routine constructs the expression 'new (place) (t) (init)',
* where place is a possibly empty list of expressions and init is
* a new-initialiser expression. n gives the number of types defined
* in t and b indicates whether the expression was actually '::new'.
*/
EXP
make_new_exp(TYPE t, int n, int b, LIST (EXP) place, EXP init)
{
EXP e;
EXP sz;
TYPE ret;
TYPE u = t;
IDENTIFIER id;
EXP v = NULL_exp;
NAT d = NULL_nat;
EXP gc = NULL_exp;
EXP arr = NULL_exp;
int need_cast = 1;
int op = lex_new;
int opd = lex_delete;
LIST (EXP) placement = NULL_list (EXP);
/* Check for type definitions */
if (n) report (crt_loc, ERR_expr_new_typedef ());
/* Find result type (a pointer to t) and size of t */
if (IS_type_array (t)) {
/* Array form */
EXP c1;
TYPE tsz = type_size_t;
TYPE s = DEREF_type (type_array_sub (t));
MAKE_type_ptr (cv_none, s, ret);
/* Check initial array bound */
d = DEREF_nat (type_array_size (t));
if (IS_nat_calc (d)) {
/* Variable sized array */
TYPE tc;
unsigned cc;
c1 = DEREF_exp (nat_calc_value (d));
tc = DEREF_type (exp_type (c1));
cc = type_category (&tc);
if (!IS_TYPE_INT (cc) && !IS_TYPE_TEMPL (cc)) {
/* Should have integral type */
if (!IS_TYPE_ERROR (cc)) {
report (crt_loc, ERR_expr_new_dim (tc));
}
}
if (!in_template_decl) {
/* Convert dimension to type 'size_t' */
c1 = cast_exp (tsz, c1, KILL_err, CAST_STATIC);
}
u = s;
v = c1;
} else {
c1 = calc_nat_value (d, tsz);
}
/* Find overall array size */
if (IS_type_array (s)) {
EXP c2 = sizeof_array (&s, tsz);
c1 = make_dim_exp (lex_star, c2, c1);
}
if (IS_exp_int_lit (c1)) {
/* Constant sized array */
if (IS_type_compound (s)) {
TYPE tc = DEREF_type (exp_type (c1));
MAKE_exp_dummy (tc, c1, LINK_NONE, NULL_off, 0, arr);
}
sz = sizeof_exp (t);
d = DEREF_nat (exp_int_lit_nat (c1));
} else {
/* Variable sized array */
TYPE tc = DEREF_type (exp_type (c1));
MAKE_exp_dummy (tc, c1, LINK_NONE, NULL_off, 0, arr);
sz = sizeof_exp (s);
sz = make_dim_exp (lex_star, sz, arr);
MAKE_nat_calc (c1, d);
if (!IS_type_compound (s)) arr = NULL_exp;
}
/* Add extra array space */
if (IS_type_compound (s)) {
OFFSET off;
MAKE_off_extra (s, 1, off);
MAKE_exp_offset_size (tsz, off, type_char, 1, c1);
sz = make_dim_exp (lex_plus, sz, c1);
}
op = lex_new_Harray;
opd = lex_delete_Harray;
t = s;
} else {
/* Normal form */
if (IS_type_top_etc (t)) need_cast = 0;
MAKE_type_ptr (cv_none, t, ret);
sz = sizeof_exp (t);
}
/* Do reference conversions */
if (!IS_NULL_list (place)) {
place = convert_args (place);
placement = place;
}
/* Check for template parameters */
if (is_templ_type (t)) {
e = make_templ_new (u, v, ret, b, place, init);
return (e);
}
/* Add 'sizeof (t)' to the start of placement */
CONS_exp (sz, place, place);
/* Call allocator function */
id = find_allocator (t, op, b, NULL_id);
if (IS_NULL_id (id)) {
e = make_error_exp (0);
return (e);
}
if (IS_id_stat_mem_func (id)) {
CONS_exp (NULL_exp, place, place);
}
id = resolve_call (id, place, qual_none, 0);
use_func_id (id, 0, suppress_usage);
e = apply_func_id (id, qual_none, NULL_graph, place);
if (need_cast) {
MAKE_exp_cast (ret, (CONV_PTR_VOID | CONV_REVERSE), e, e);
}
/* Deal with array initialisers */
if (!IS_NULL_exp (init)) {
EXP a0 = new_try_body (init);
if (IS_NULL_exp (a0)) {
/* Can happen with templates */
init = NULL_exp;
} else {
if (!IS_NULL_nat (d)) {
EXP a = DEREF_exp (exp_assign_arg (a0));
MAKE_type_array (cv_none, t, d, t);
MAKE_exp_nof (t, NULL_exp, d, a, NULL_exp, a);
COPY_exp (exp_assign_arg (a0), a);
a = DEREF_exp (exp_assign_ref (a0));
COPY_type (exp_type (a), t);
COPY_type (exp_type (a0), t);
/* NOT YET IMPLEMENTED - destructors of temporaries */
}
}
}
/* Deal with clean-up routine */
if (!IS_NULL_exp (init)) {
EXP a;
int du = do_dump;
int ac = do_access_checks;
do_dump = 0;
do_access_checks = 0;
MAKE_exp_value (ret, a);
if (IS_NULL_list (placement)) id = NULL_id;
gc = placement_delete (opd, b, a, id, placement);
do_access_checks = ac;
do_dump = du;
}
/* Return the result */
MAKE_exp_alloc (ret, e, init, gc, arr, e);
return (e);
}
/*
* CREATE A NEW-INITIALISER
*
* This routine creates a new-initialiser expression of type t from the
* expression list p.
*/
EXP
make_new_init(TYPE t, LIST (EXP) p, int init)
{
EXP e;
int op = lex_new;
ERROR err = check_complete (t);
if (!IS_NULL_err (err)) {
/* Type should be complete */
err = concat_error (err, ERR_expr_new_incompl ());
report (crt_loc, err);
}
err = check_abstract (t);
if (!IS_NULL_err (err)) {
/* Type can't be abstract */
err = concat_error (err, ERR_expr_new_abstract ());
report (crt_loc, err);
err = NULL_err;
}
while (IS_type_array (t)) {
/* Step over array components */
op = lex_new_Harray;
if (init) {
report (crt_loc, ERR_expr_new_array_init (op));
init = 0;
}
t = DEREF_type (type_array_sub (t));
}
p = convert_args (p);
if (is_templ_type (t)) {
if (op == lex_new_Harray) {
/* Create dummy array type */
NAT n = small_nat [1];
MAKE_type_array (cv_none, t, n, t);
}
if (init) {
MAKE_exp_opn (t, lex_compute, p, e);
} else {
MAKE_exp_op (t, lex_compute, NULL_exp, NULL_exp, e);
}
} else {
if (init) {
e = init_constr (t, p, &err);
} else {
e = init_empty (t, cv_none, 0, &err);
}
if (!IS_NULL_err (err)) {
/* Report conversion errors */
err = concat_error (ERR_expr_new_init (op), err);
report (crt_loc, err);
}
if (!IS_NULL_exp (e)) {
/* Assign value to dummy expression */
EXP a;
MAKE_exp_dummy (t, NULL_exp, LINK_NONE, NULL_off, 1, a);
MAKE_exp_assign (t, a, e, e);
}
}
return (e);
}
/*
* BEGIN A NEW-INITIALISER TRY BLOCK
*
* Each new-initialiser is enclosed in a dummy try block. This is because
* if the initialiser throws an exception it is necessary to catch it,
* delete the memory just allocated, and then re-throw the exception to
* the enclosing real handler.
*/
EXP
begin_new_try(void)
{
EXP a = begin_try_stmt (0);
EXP b = begin_compound_stmt (2);
COPY_exp (exp_try_block_body (a), b);
return (a);
}
/*
* END A NEW-INITIALISER TRY BLOCK
*
* This routine adds the new-initialiser expression b to the try block a.
*/
EXP
end_new_try(EXP a, EXP b)
{
EXP c = DEREF_exp (exp_try_block_body (a));
c = add_compound_stmt (c, b);
c = end_compound_stmt (c);
a = cont_try_stmt (a, c);
a = end_try_stmt (a, 1);
if (IS_NULL_exp (b)) {
free_exp (a, 1);
a = NULL_exp;
}
return (a);
}
/*
* FIND THE BODY OF A NEW-INITIALISER TRY BLOCK
*
* This routine returns the initialiser component of the new-initialiser
* try block a.
*/
EXP
new_try_body(EXP a)
{
while (!IS_NULL_exp (a)) {
switch (TAG_exp (a)) {
case exp_try_block_tag : {
a = DEREF_exp (exp_try_block_body (a));
break;
}
case exp_decl_stmt_tag : {
a = DEREF_exp (exp_decl_stmt_body (a));
break;
}
case exp_sequence_tag : {
LIST (EXP) p = DEREF_list (exp_sequence_first (a));
p = TAIL_list (p);
if (IS_NULL_list (p)) {
a = NULL_exp;
} else {
a = DEREF_exp (HEAD_list (p));
}
break;
}
case exp_location_tag : {
a = DEREF_exp (exp_location_arg (a));
break;
}
default : {
return (a);
}
}
}
return (NULL_exp);
}
/*
* END OF ALLOCATION ROUTINES
*
* The remaining routines are common to both producers.
*/
#endif /* LANGUAGE_CPP */
/*
* MULTIPLY ARRAY DIMENSIONS
*
* This routine multiplies the dimensions of any array components in the
* type pointed to by pt returning it as an expression of type s. It
* assigns the non-array components back to pt.
*/
EXP
sizeof_array(TYPE *pt, TYPE s)
{
TYPE t = *pt;
EXP a = NULL_exp;
while (IS_type_array (t)) {
EXP b;
NAT n = DEREF_nat (type_array_size (t));
if (IS_NULL_nat (n)) n = small_nat [0];
b = calc_nat_value (n, s);
a = make_dim_exp (lex_star, a, b);
t = DEREF_type (type_array_sub (t));
}
*pt = t;
return (a);
}
/*
* FIND THE SIZE OF A TYPE
*
* This routine calculates the size of the type t when this can be precisely
* evaluated, returning the null literal if this is not possible.
*/
static NAT
sizeof_type(TYPE t)
{
switch (TAG_type (t)) {
case type_integer_tag : {
/* Allow for integral types */
INT_TYPE it = DEREF_itype (type_integer_rep (t));
if (IS_itype_basic (it)) {
BASE_TYPE bt = DEREF_btype (itype_basic_rep (it));
if (bt & btype_char) {
/* char has size one */
NAT n = small_nat [1];
return (n);
}
}
break;
}
case type_top_tag :
case type_bottom_tag : {
/* void has size one */
NAT n = small_nat [1];
return (n);
}
case type_array_tag : {
/* Allow for array types */
TYPE s = type_size_t;
EXP a = sizeof_array (&t, s);
NAT n = sizeof_type (t);
if (!IS_NULL_nat (n)) {
EXP b = calc_nat_value (n, s);
a = make_dim_exp (lex_star, a, b);
if (IS_exp_int_lit (a)) {
n = DEREF_nat (exp_int_lit_nat (a));
return (n);
}
}
break;
}
case type_enumerate_tag : {
/* An enumeration maps to its underlying type */
ENUM_TYPE et = DEREF_etype (type_enumerate_defn (t));
TYPE s = DEREF_type (etype_rep (et));
return (sizeof_type (s));
}
}
return (NULL_nat);
}
/*
* CREATE A SIZEOF EXPRESSION
*
* This routine constructs the expression 'sizeof (t)' without applying
* any checks to t.
*/
EXP
sizeof_exp(TYPE t)
{
EXP e;
NAT sz = sizeof_type (t);
if (IS_NULL_nat (sz)) {
/* Calculate size if it is not obvious */
OFFSET off;
MAKE_off_type (t, off);
MAKE_exp_offset_size (type_size_t, off, type_char, 1, e);
MAKE_nat_calc (e, sz);
}
MAKE_exp_int_lit (type_size_t, sz, exp_offset_size_tag, e);
return (e);
}
/*
* CONSTRUCT A SIZEOF EXPRESSION
*
* This routine constructs the expression 'sizeof (t)'. Note that
* 'sizeof a' has already been reduced to 'sizeof (typeof (a))'
* except in the case where the result depends on a template parameter.
* The argument n gives the number of types defined in t. Note that the
* result is a constant integer expression.
*/
EXP
make_sizeof_exp(TYPE t, EXP a, int n, int op)
{
/* Deal with argument dependent case */
#if LANGUAGE_CPP
if (!IS_NULL_exp (a)) {
EXP e;
NAT sz;
TYPE s = type_size_t;
MAKE_exp_op (s, op, a, NULL_exp, e);
MAKE_nat_calc (e, sz);
MAKE_exp_int_lit (s, sz, exp_op_tag, e);
return (e);
}
#else
UNUSED (a);
#endif
/* Check on type */
switch (TAG_type (t)) {
case type_func_tag : {
/* Can't have sizeof (function) */
report (crt_loc, ERR_expr_sizeof_func (op));
MAKE_type_ptr (cv_none, t, t);
break;
}
case type_bitfield_tag : {
/* Can't have sizeof (bitfield) */
report (crt_loc, ERR_expr_sizeof_bitf (op));
t = find_bitfield_type (t);
break;
}
case type_ref_tag : {
/* sizeof (T &) equals sizeof (T) */
t = DEREF_type (type_ref_sub (t));
break;
}
default : {
/* Can't have sizeof (incomplete) */
ERROR err = check_incomplete (t);
if (!IS_NULL_err (err)) {
err = concat_error (err, ERR_expr_sizeof_incompl (op));
report (crt_loc, err);
}
break;
}
}
/* Report on type definitions */
if (n) report (crt_loc, ERR_expr_sizeof_typedef (op));
/* Calculate result */
return (sizeof_exp (t));
}
/*
* FIND THE TYPE OF AN EXPRESSION
*
* This routine returns the type of the expression pointed to by pa after
* apply reference conversions to it. It is used, for example, to
* transform 'sizeof (a)' into 'sizeof (t)'. n gives the number of
* side effects in pa.
*/
TYPE
typeof_exp(EXP *pa, int n, int op)
{
TYPE t;
EXP a = *pa;
if (n) report (crt_loc, ERR_expr_sizeof_side (op));
a = convert_reference (a, REF_NORMAL);
a = convert_none (a);
t = DEREF_type (exp_type (a));
if (!is_templ_type (t)) {
/* Free operand in simple case */
free_exp (a, 2);
a = NULL_exp;
}
*pa = a;
return (t);
}
/*
* FIND THE NUMBER OF ITEMS IN AN INITIALISER EXPRESSION
*
* This routine returns the number of initialisers in the expression e
* counting each array element separately.
*/
EXP
sizeof_init(EXP e, TYPE s)
{
EXP a = NULL_exp;
unsigned long v = 0;
if (!IS_NULL_exp (e)) {
LIST (EXP) p, q;
if (IS_exp_comma (e)) {
p = DEREF_list (exp_comma_args (e));
p = END_list (p);
e = DEREF_exp (HEAD_list (p));
}
if (IS_exp_initialiser (e)) {
p = DEREF_list (exp_initialiser_args (e));
q = NULL_list (EXP);
} else {
CONS_exp (e, NULL_list (EXP), p);
q = p;
}
while (!IS_NULL_list (p)) {
EXP b = DEREF_exp (HEAD_list (p));
if (!IS_NULL_exp (b)) {
TYPE t = DEREF_type (exp_type (b));
if (IS_type_array (t)) {
/* Multiply up array bounds */
EXP c = sizeof_array (&t, s);
a = make_dim_exp (lex_plus, a, c);
} else {
/* Other types count once */
v++;
}
}
p = TAIL_list (p);
}
if (!IS_NULL_list (q)) DESTROY_list (q, SIZE_exp);
}
if (IS_NULL_exp (a)) {
NAT n = make_nat_value (v);
a = calc_nat_value (n, s);
} else {
if (v) {
NAT n = make_nat_value (v);
EXP c = calc_nat_value (n, s);
a = make_dim_exp (lex_plus, a, c);
}
}
return (a);
}
syntax highlighted by Code2HTML, v. 0.9.1