WebSVN – tendra.SVN – Diff – /branches/tendra5/src/producers/common/construct/allocate.c

+/*
+ * 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.
 */
     This routine calculates the simple arithmetic operation 'a op b'.  Any
     conversion errors are suppressed.
 */
-static EXP make_dim_exp
+static EXP
-    PROTO_N ( ( op, a, b ) )
-    PROTO_T ( int op X EXP a X EXP b )
+make_dim_exp(int op, EXP a, EXP b)
+{
-    EXP e ;
+	EXP e;
-    int et ;
+	int et;
-    if ( IS_NULL_exp ( a ) ) return ( b ) ;
+	if (IS_NULL_exp(a)) {
+		return (b);
+	}
-    if ( IS_NULL_exp ( b ) ) return ( a ) ;
+	if (IS_NULL_exp(b)) {
+		return (a);
+	}
-    et = error_threshold ;
+	et = error_threshold;
-    error_threshold = ERROR_SERIOUS ;
+	error_threshold = ERROR_SERIOUS;
-    if ( op == lex_plus ) {
+	if (op == lex_plus) {
-	e = make_plus_exp ( a, b ) ;
+		e = make_plus_exp(a, b);
-    } else {
+	} else {
-	e = make_mult_exp ( op, a, b ) ;
+		e = make_mult_exp(op, a, b);
-    }
+	}
-    error_threshold = et ;
+	error_threshold = et;
-    return ( e ) ;
+	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 TYPE type_bad_alloc = NULL_type;
-static LIST ( TYPE ) alloc_types = NULL_list ( 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
+static void
-    PROTO_N ( ( t ) )
-    PROTO_T ( TYPE t )
+set_bad_alloc(TYPE t)
+{
-    if ( !IS_NULL_type ( t ) ) {
+	if (!IS_NULL_type(t)) {
-	LIST ( TYPE ) p = alloc_types ;
+		LIST(TYPE)p = alloc_types;
-	while ( !IS_NULL_list ( p ) ) {
+		while (!IS_NULL_list(p)) {
-	    TYPE s = DEREF_type ( HEAD_list ( p ) ) ;
+			TYPE s = DEREF_type(HEAD_list(p));
-	    LIST ( TYPE ) e = DEREF_list ( type_func_except ( s ) ) ;
+			LIST(TYPE)e = DEREF_list(type_func_except(s));
-	    if ( !IS_NULL_list ( e ) && !EQ_list ( e, univ_type_set ) ) {
+			if (!IS_NULL_list(e) && !EQ_list(e, univ_type_set)) {
+				/* Change 'throw ( X )' to
-		/* Change 'throw ( X )' to 'throw ( std::bad_alloc )' */
+				 * 'throw ( std::bad_alloc )' */
-		e = TAIL_list ( e ) ;
+				e = TAIL_list(e);
-		CONS_type ( t, e, e ) ;
+				CONS_type(t, e, e);
-		COPY_list ( type_func_except ( s ), e ) ;
+				COPY_list(type_func_except(s), e);
-	    }
+			}
-	    p = TAIL_list ( p ) ;
+			p = TAIL_list(p);
+		}
+		type_bad_alloc = t;
+	}
-	type_bad_alloc = t ;
-    }
-    return ;
+	return;
+}
 /*
     CHECK AN ALLOCATION FUNCTION
     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
-    PROTO_N ( ( t, id, mem, templ ) )
-    PROTO_T ( TYPE t X IDENTIFIER id X int mem X int templ )
+check_allocator(TYPE t, IDENTIFIER id, int mem, int templ)
+{
-    if ( IS_type_templ ( t ) ) {
+	if (IS_type_templ(t)) {
-	/* Allow for template types */
+		/* Allow for template types */
-	TYPE s = DEREF_type ( type_templ_defn ( t ) ) ;
+		TYPE s = DEREF_type(type_templ_defn(t));
-	s = check_allocator ( s, id, mem, templ + 1 ) ;
+		s = check_allocator(s, id, mem, templ + 1);
-	COPY_type ( type_templ_defn ( t ), s ) ;
+		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 {
+		/* 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 ;
+			s = type_void;
-	}
+		}
-	if ( op == lex_new || op == lex_new_Harray ) {
+		if (op == lex_new || op == lex_new_Harray) {
-	    /* Allocator should return 'void *' */
+			/* Allocator should return 'void *' */
-	    TYPE u = type_void_star ;
+			TYPE u = type_void_star;
-	    if ( !eq_type ( r, u ) ) {
+			if (!eq_type(r, u)) {
-		report ( crt_loc, ERR_basic_stc_alloc_ret ( nm, u ) ) ;
+				report(crt_loc, ERR_basic_stc_alloc_ret(nm, u));
-	    }
+			}
-	    /* First parameter should be 'size_t' */
+			/* First parameter should be 'size_t' */
-	    u = type_size_t ;
+			u = type_size_t;
-	    if ( !eq_type ( s, u ) ) {
+			if (!eq_type(s, u)) {
-		report ( crt_loc, ERR_basic_stc_alloc_p1 ( nm, u ) ) ;
+				report(crt_loc, ERR_basic_stc_alloc_p1(nm, u));
-	    }
+			}
-	    /* First parameter can't have a default argument */
+			/* First parameter can't have a default argument */
-	    if ( !IS_NULL_list ( q ) ) {
+			if (!IS_NULL_list(q)) {
-		IDENTIFIER pid = DEREF_id ( HEAD_list ( q ) ) ;
+				IDENTIFIER pid = DEREF_id(HEAD_list(q));
-		EXP darg = DEREF_exp ( id_parameter_init ( pid ) ) ;
+				EXP darg = DEREF_exp(id_parameter_init(pid));
-		if ( !IS_NULL_exp ( darg ) ) {
+				if (!IS_NULL_exp(darg)) {
+					report(crt_loc,
-		    report ( crt_loc, ERR_basic_stc_alloc_d1 ( nm ) ) ;
+					       ERR_basic_stc_alloc_d1(nm));
-		}
+				}
-	    }
+			}
-	    /* Template functions should have another parameter */
+			/* Template functions should have another parameter */
-	    if ( templ && IS_NULL_list ( p ) ) {
+			if (templ && IS_NULL_list(p)) {
-		report ( crt_loc, ERR_basic_stc_alloc_templ ( nm ) ) ;
+				report(crt_loc, ERR_basic_stc_alloc_templ(nm));
-	    }
+			}
-	} else {
+		} else {
-	    /* Deallocator should return 'void' */
+			/* Deallocator should return 'void' */
-	    TYPE u = type_void ;
+			TYPE u = type_void;
-	    if ( !eq_type ( r, u ) ) {
+			if (!eq_type(r, u)) {
-		report ( crt_loc, ERR_basic_stc_alloc_ret ( nm, u ) ) ;
+				report(crt_loc, ERR_basic_stc_alloc_ret(nm, u));
-	    }
+			}
-	    /* First argument should be 'void *' */
+			/* First argument should be 'void *' */
-	    u = type_void_star ;
+			u = type_void_star;
-	    if ( !eq_type ( s, u ) ) {
+			if (!eq_type(s, u)) {
-		report ( crt_loc, ERR_basic_stc_alloc_p1 ( nm, u ) ) ;
+				report(crt_loc, ERR_basic_stc_alloc_p1(nm, u));
-	    }
+			}
-	    /* Template functions should have another parameter */
+			/* Template functions should have another parameter */
-	    if ( templ && IS_NULL_list ( p ) ) {
+			if (templ && IS_NULL_list(p)) {
-		report ( crt_loc, ERR_basic_stc_alloc_templ ( nm ) ) ;
+				report(crt_loc, ERR_basic_stc_alloc_templ(nm));
-	    }
+			}
-	    /* Second argument may be 'size_t' (old form) */
+			/* Second argument may be 'size_t' (old form) */
-	    if ( mem && !IS_NULL_list ( p ) ) {
+			if (mem && !IS_NULL_list(p)) {
-		u = type_size_t ;
+				u = type_size_t;
-		s = DEREF_type ( HEAD_list ( p ) ) ;
+				s = DEREF_type(HEAD_list(p));
-		if ( !eq_type ( s, u ) ) {
+				if (!eq_type(s, u)) {
+					report(crt_loc,
-		    report ( crt_loc, ERR_basic_stc_alloc_p2 ( nm, u ) ) ;
+					       ERR_basic_stc_alloc_p2(nm, u));
-		}
+				}
-		p = TAIL_list ( p ) ;
+				p = TAIL_list(p);
-	    }
+			}
-	    /* No further arguments allowed (old form) */
+			/* No further arguments allowed (old form) */
-	    if ( !IS_NULL_list ( p ) || ell ) {
+			if (!IS_NULL_list(p) || ell) {
-		report ( crt_loc, ERR_basic_stc_alloc_pn ( nm ) ) ;
+				report(crt_loc, ERR_basic_stc_alloc_pn(nm));
-	    }
+			}
-	}
+		}
-	/* Look up 'std::bad_alloc' */
+		/* Look up 'std::bad_alloc' */
-	s = type_bad_alloc ;
+		s = type_bad_alloc;
-	if ( IS_NULL_type ( s ) ) {
+		if (IS_NULL_type(s)) {
-	    s = find_std_type ( "bad_alloc", 1, 0 ) ;
+			s = find_std_type("bad_alloc", 1, 0);
-	    set_bad_alloc ( s ) ;
+			set_bad_alloc(s);
-	}
+		}
-    }
+	}
-    return ( t ) ;
+	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
+void
-    PROTO_N ( ( id, alloc ) )
-    PROTO_T ( IDENTIFIER id X int alloc )
+recheck_allocator(IDENTIFIER id, int alloc)
 {
-    NAMESPACE ns = DEREF_nspace ( id_parent ( id ) ) ;
+	NAMESPACE ns = DEREF_nspace(id_parent(id));
-    if ( alloc == 2 ) {
+	if (alloc == 2) {
-	IDENTIFIER over = DEREF_id ( id_function_etc_over ( id ) ) ;
+		IDENTIFIER over = DEREF_id(id_function_etc_over(id));
-	if ( !IS_NULL_id ( over ) ) {
+		if (!IS_NULL_id(over)) {
-	    /* Can't overload 'operator delete' (old form) */
+			/* Can't overload 'operator delete' (old form) */
-	    report ( crt_loc, ERR_basic_stc_dealloc_over ( over ) ) ;
+			report(crt_loc, ERR_basic_stc_dealloc_over(over));
-	}
+		}
-    }
+	}
-    if ( !IS_NULL_nspace ( ns ) ) {
+	if (!IS_NULL_nspace(ns)) {
-	switch ( TAG_nspace ( ns ) ) {
+		switch (TAG_nspace(ns)) {
-	    case nspace_global_tag : {
+		case nspace_global_tag: {
-		/* Declared in global namespace */
+			/* Declared in global namespace */
-		DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
+			DECL_SPEC ds = DEREF_dspec(id_storage(id));
-		if ( ds & dspec_static ) {
+			if (ds & dspec_static) {
-		    report ( crt_loc, ERR_basic_stc_alloc_link ( id ) ) ;
+				report(crt_loc, ERR_basic_stc_alloc_link(id));
-		}
+			}
-		if ( alloc == 1 && crt_file_type == 1 ) {
+			if (alloc == 1 && crt_file_type == 1) {
-		    /* Check for built-in allocation functions */
+				/* Check for built-in allocation functions */
-		    TYPE t = DEREF_type ( id_function_type ( id ) ) ;
+				TYPE t = DEREF_type(id_function_type(id));
-		    if ( IS_type_func ( t ) ) {
+				if (IS_type_func(t)) {
-			LIST ( TYPE ) p ;
+					LIST(TYPE)p;
-			p = DEREF_list ( type_func_ptypes ( t ) ) ;
+					p = DEREF_list(type_func_ptypes(t));
-			if ( LENGTH_list ( p ) == 1 ) {
+					if (LENGTH_list(p) == 1) {
-			    CONS_type ( t, alloc_types, alloc_types ) ;
+						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;
-		    }
+		}
+		}
-		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 ;
+	return;
+}
 /*
     FIND A DEALLOCATION FUNCTION
     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
+static IDENTIFIER
-    PROTO_N ( ( id, pid, mem ) )
-    PROTO_T ( IDENTIFIER id X IDENTIFIER pid X int mem )
+resolve_delete(IDENTIFIER id, IDENTIFIER pid, int mem)
+{
-    int eq = 0 ;
+	int eq = 0;
-    IDENTIFIER rid ;
+	IDENTIFIER rid;
-    LIST ( TYPE ) p ;
+	LIST(TYPE)p;
-    TYPE fn = type_temp_func ;
+	TYPE fn = type_temp_func;
-    LIST ( IDENTIFIER ) pids = NULL_list ( IDENTIFIER ) ;
+	LIST(IDENTIFIER)pids = NULL_list(IDENTIFIER);
-    COPY_type ( type_func_ret ( fn ), type_void ) ;
+	COPY_type(type_func_ret(fn), type_void);
-    COPY_cv ( type_func_mqual ( fn ), cv_none ) ;
+	COPY_cv(type_func_mqual(fn), cv_none);
-    /* Try placement delete */
+	/* Try placement delete */
-    if ( !IS_NULL_id ( pid ) ) {
+	if (!IS_NULL_id(pid)) {
-	TYPE t = DEREF_type ( id_function_etc_type ( pid ) ) ;
+		TYPE t = DEREF_type(id_function_etc_type(pid));
-	if ( IS_type_func ( t ) ) {
+		if (IS_type_func(t)) {
-	    p = DEREF_list ( type_func_ptypes ( t ) ) ;
+			p = DEREF_list(type_func_ptypes(t));
-	    if ( !IS_NULL_list ( p ) ) p = TAIL_list ( p ) ;
+			if (!IS_NULL_list(p)) {
+				p = TAIL_list(p);
+			}
-	    CONS_type ( type_void_star, p, p ) ;
+			CONS_type(type_void_star, p, p);
-	    COPY_list ( type_func_ptypes ( fn ), p ) ;
+			COPY_list(type_func_ptypes(fn), p);
-	    COPY_list ( type_func_mtypes ( fn ), p ) ;
+			COPY_list(type_func_mtypes(fn), p);
-	    rid = resolve_func ( id, fn, 1, 1, pids, &eq ) ;
+			rid = resolve_func(id, fn, 1, 1, pids, &eq);
-	    COPY_list ( type_func_ptypes ( fn ), NULL_list ( TYPE ) ) ;
+			COPY_list(type_func_ptypes(fn), NULL_list(TYPE));
-	    COPY_list ( type_func_mtypes ( fn ), NULL_list ( TYPE ) ) ;
+			COPY_list(type_func_mtypes(fn), NULL_list(TYPE));
-	    DESTROY_CONS_type ( destroy, t, p, p ) ;
+			DESTROY_CONS_type(destroy, t, p, p);
-	    UNUSED ( p ) ;
+			UNUSED(p);
-	    UNUSED ( t ) ;
+			UNUSED(t);
-	    if ( !IS_NULL_id ( rid ) ) return ( rid ) ;
+			if (!IS_NULL_id(rid)) {
+				return (rid);
+			}
-	}
+		}
-	return ( NULL_id ) ;
+		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 * )' */
+	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 )' */
+	/* Try 'void ( void *, size_t )' */
-    if ( mem ) {
+	if (mem) {
-	CONS_type ( type_size_t, NULL_list ( TYPE ), p ) ;
+		CONS_type(type_size_t, NULL_list(TYPE), p);
-	CONS_type ( type_void_star, p, p ) ;
+		CONS_type(type_void_star, p, p);
-	COPY_list ( type_func_ptypes ( fn ), p ) ;
+		COPY_list(type_func_ptypes(fn), p);
-	COPY_list ( type_func_mtypes ( fn ), p ) ;
+		COPY_list(type_func_mtypes(fn), p);
-	rid = resolve_func ( id, fn, 0, 1, pids, &eq ) ;
+		rid = resolve_func(id, fn, 0, 1, pids, &eq);
-	COPY_list ( type_func_ptypes ( fn ), NULL_list ( TYPE ) ) ;
+		COPY_list(type_func_ptypes(fn), NULL_list(TYPE));
-	COPY_list ( type_func_mtypes ( fn ), NULL_list ( TYPE ) ) ;
+		COPY_list(type_func_mtypes(fn), NULL_list(TYPE));
-	DESTROY_list ( p, SIZE_type ) ;
+		DESTROY_list(p, SIZE_type);
-	if ( !IS_NULL_id ( rid ) ) return ( rid ) ;
+		if (!IS_NULL_id(rid)) {
+			return (rid);
-    }
+		}
+	}
-    return ( NULL_id ) ;
+	return (NULL_id);
+}
 /*
     LOOK UP AN ALLOCATOR FUNCTION
     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
+IDENTIFIER
-    PROTO_N ( ( t, op, b, pid ) )
-    PROTO_T ( TYPE t X int op X int b X IDENTIFIER pid )
+find_allocator(TYPE t, int op, int b, IDENTIFIER pid)
+{
-    int dealloc = 0 ;
+	int dealloc = 0;
-    IDENTIFIER id = NULL_id ;
+	IDENTIFIER id = NULL_id;
-    HASHID nm = lookup_op ( op ) ;
+	HASHID nm = lookup_op(op);
-    HASHID nm_real = nm ;
+	HASHID nm_real = nm;
-    /* Allow for pre-ISO dialect */
+	/* Allow for pre-ISO dialect */
-    switch ( op ) {
+	switch (op) {
-	case lex_new : {
+	case lex_new: {
-	    break ;
+		break;
+	}
-	case lex_new_Harray : {
+	case lex_new_Harray: {
-	    if ( !option ( OPT_new_array ) ) {
+		if (!option(OPT_new_array)) {
-		nm = lookup_op ( lex_new ) ;
+			nm = lookup_op(lex_new);
-		t = type_error ;
+			t = type_error;
-	    }
+		}
-	    break ;
+		break;
 	}
-	case lex_delete : {
+	case lex_delete: {
-	    dealloc = 1 ;
+		dealloc = 1;
-	    break ;
+		break;
 	}
-	case lex_delete_Harray : {
+	case lex_delete_Harray: {
-	    if ( !option ( OPT_new_array ) ) {
+		if (!option(OPT_new_array)) {
-		nm = lookup_op ( lex_delete ) ;
+			nm = lookup_op(lex_delete);
-		t = type_error ;
+			t = type_error;
-	    }
+		}
-	    dealloc = 1 ;
+		dealloc = 1;
-	    break ;
+		break;
 	}
-    }
+	}
-    if ( b ) {
+	if (b) {
-	/* Try global scope ... */
+		/* Try global scope ... */
-	NAMESPACE ns = global_namespace ;
+		NAMESPACE ns = global_namespace;
-	MEMBER mem = search_member ( ns, nm, 0 ) ;
+		MEMBER mem = search_member(ns, nm, 0);
-	if ( !IS_NULL_member ( mem ) ) {
+		if (!IS_NULL_member(mem)) {
-	    id = DEREF_id ( member_id ( mem ) ) ;
+			id = DEREF_id(member_id(mem));
-	    if ( !IS_NULL_id ( id ) && dealloc ) {
+			if (!IS_NULL_id(id) && dealloc) {
-		id = resolve_delete ( id, pid, 0 ) ;
+				id = resolve_delete(id, pid, 0);
-	    }
+			}
-	}
+		}
-    } else {
+	} else {
-	/* Try class members ... */
+		/* Try class members ... */
-	if ( IS_type_compound ( t ) ) {
+		if (IS_type_compound(t)) {
-	    CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
+			CLASS_TYPE ct = DEREF_ctype(type_compound_defn(t));
-	    NAMESPACE ns = DEREF_nspace ( ctype_member ( ct ) ) ;
+			NAMESPACE ns = DEREF_nspace(ctype_member(ct));
-	    id = search_field ( ns, nm_real, 0, 0 ) ;
+			id = search_field(ns, nm_real, 0, 0);
-	    if ( IS_NULL_id ( id ) && !EQ_hashid ( nm, nm_real ) ) {
+			if (IS_NULL_id(id) && !EQ_hashid(nm, nm_real)) {
-		id = search_field ( ns, nm, 0, 0 ) ;
+				id = search_field(ns, nm, 0, 0);
-	    }
+			}
-	    if ( !IS_NULL_id ( id ) && IS_id_ambig ( id ) ) {
+			if (!IS_NULL_id(id) && IS_id_ambig(id)) {
-		id = report_ambiguous ( id, 0, 1, 1 ) ;
+				id = report_ambiguous(id, 0, 1, 1);
-	    }
+			}
-	    if ( !IS_NULL_id ( id ) && dealloc ) {
+			if (!IS_NULL_id(id) && dealloc) {
-		id = resolve_delete ( id, pid, 1 ) ;
+				id = resolve_delete(id, pid, 1);
-	    }
+			}
-	}
+		}
-	/* Try current scope ... */
+		/* Try current scope ... */
-	if ( IS_NULL_id ( id ) ) {
+		if (IS_NULL_id(id)) {
-	    id = find_op_id ( nm ) ;
+			id = find_op_id(nm);
-	    if ( !IS_NULL_id ( id ) && dealloc ) {
+			if (!IS_NULL_id(id) && dealloc) {
-		id = resolve_delete ( id, pid, 0 ) ;
+				id = resolve_delete(id, pid, 0);
-	    }
+			}
-	}
+		}
-    }
+	}
-    /* Return function */
+	/* Return function */
-    if ( !IS_NULL_id ( id ) ) {
+	if (!IS_NULL_id(id)) {
-	if ( IS_id_function_etc ( id ) ) {
+		if (IS_id_function_etc(id)) {
-	    /* Function found */
+			/* Function found */
-	    return ( id ) ;
+			return (id);
-	}
+		}
-	if ( is_ambiguous_func ( id ) ) {
+		if (is_ambiguous_func(id)) {
-	    if ( dealloc ) {
+			if (dealloc) {
-		/* Can't do overload resolution on delete */
+				/* Can't do overload resolution on delete */
-		id = report_ambiguous ( id, 0, 1, 1 ) ;
+				id = report_ambiguous(id, 0, 1, 1);
-		return ( id ) ;
+				return (id);
-	    }
+			}
-	    return ( id ) ;
+			return (id);
-	}
+		}
-	if ( !IS_id_dummy ( id ) ) {
+		if (!IS_id_dummy(id)) {
-	    /* Result is not a function */
+			/* Result is not a function */
-	    report ( crt_loc, ERR_over_oper_func ( id ) ) ;
+			report(crt_loc, ERR_over_oper_func(id));
-	}
+		}
-    }
+	}
-    if ( IS_NULL_id ( pid ) ) {
+	if (IS_NULL_id(pid)) {
-	/* Allocation functions not declared */
+		/* Allocation functions not declared */
-	report ( crt_loc, ERR_lib_builtin ( NULL_string, nm ) ) ;
+		report(crt_loc, ERR_lib_builtin(NULL_string, nm));
-    }
+	}
-    return ( NULL_id ) ;
+	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
+static EXP
-    PROTO_N ( ( op, b, a ) )
-    PROTO_T ( int op X int b X EXP a )
+make_templ_delete(int op, int b, EXP a)
 {
-    EXP e ;
+	EXP e;
-    if ( b ) {
+	if (b) {
-	/* Allow for '::delete' */
+		/* Allow for '::delete' */
-	if ( op == lex_delete ) {
+		if (op == lex_delete) {
-	    op = lex_delete_Hfull ;
+			op = lex_delete_Hfull;
-	} else {
+		} else {
-	    op = lex_delete_Harray_Hfull ;
+			op = lex_delete_Harray_Hfull;
+		}
+	}
-    }
-    MAKE_exp_op ( type_void, op, a, NULL_exp, e ) ;
+	MAKE_exp_op(type_void, op, a, NULL_exp, e);
-    return ( 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.
+	}
+	/* 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 {
+	} else {
-	e = NULL_exp ;
+		e = NULL_exp;
-    }
+	}
-    /* Construct result */
+	/* Construct result */
-    MAKE_exp_dealloc ( type_void, d, e, a, c, e ) ;
+	MAKE_exp_dealloc(type_void, d, e, a, c, e);
-    return ( 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
+EXP
-    PROTO_N ( ( op, b, a ) )
-    PROTO_T ( int op X int b X EXP a )
+make_delete_exp(int op, int b, EXP a)
 {
-    EXP e = placement_delete ( op, b, a, NULL_id, NULL_list ( EXP ) ) ;
+	EXP e = placement_delete(op, b, a, NULL_id, NULL_list(EXP));
-    return ( e ) ;
+	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
+void
-    PROTO_N ( ( e ) )
-    PROTO_T ( EXP e )
+old_delete_array(EXP e)
 {
-    /* Check that e is a suitable array bound */
+	/* Check that e is a suitable array bound */
-    int op = lex_delete_Harray ;
+	int op = lex_delete_Harray;
-    IGNORE make_new_array_dim ( e ) ;
+	IGNORE make_new_array_dim(e);
-    /* But complain just the same */
+	/* But complain just the same */
-    report ( crt_loc, ERR_expr_delete_array ( op ) ) ;
+	report(crt_loc, ERR_expr_delete_array(op));
-    return ;
+	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
-NAT make_new_array_dim
+make_new_array_dim(EXP e)
-    PROTO_N ( ( e ) )
-    PROTO_T ( EXP e )
+{
-    NAT n ;
+	NAT n;
-    if ( IS_exp_int_lit ( e ) ) {
+	if (IS_exp_int_lit(e)) {
-	/* Get the value if e is constant */
+		/* Get the value if e is constant */
-	n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
+		n = DEREF_nat(exp_int_lit_nat(e));
-    } else {
+	} else {
-	/* Make dummy literal */
+		/* Make dummy literal */
-	MAKE_nat_calc ( e, n ) ;
+		MAKE_nat_calc(e, n);
-    }
+	}
-    return ( 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
+static EXP
-    PROTO_N ( ( t, d, p, b, place, init ) )
-    PROTO_T ( TYPE t X EXP d X TYPE p X int b X LIST ( EXP ) place X EXP init )
+make_templ_new(TYPE t, EXP d, TYPE p, int b, LIST(EXP)place, EXP init)
 {
-    EXP e ;
+	EXP e;
-    int op = ( b ? lex_new_Hfull : lex_new ) ;
+	int op = (b ? lex_new_Hfull : lex_new);
-    CONS_exp ( init, place, place ) ;
+	CONS_exp(init, place, place);
-    CONS_exp ( d, place, place ) ;
+	CONS_exp(d, place, place);
-    MAKE_exp_value ( t, e ) ;
+	MAKE_exp_value(t, e);
-    CONS_exp ( e, place, place ) ;
+	CONS_exp(e, place, place);
-    MAKE_exp_opn ( p, op, place, e ) ;
+	MAKE_exp_opn(p, op, place, e);
-    return ( 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'.
-    /* Return the result */
+	/* Return the result */
-    MAKE_exp_alloc ( ret, e, init, gc, arr, e ) ;
+	MAKE_exp_alloc(ret, e, init, gc, arr, e);
-    return ( 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
+EXP
-    PROTO_N ( ( t, p, init ) )
-    PROTO_T ( TYPE t X LIST ( EXP ) p X int init )
+make_new_init(TYPE t, LIST(EXP)p, int init)
+{
-    EXP e ;
+	EXP e;
-    int op = lex_new ;
+	int op = lex_new;
-    ERROR err = check_complete ( t ) ;
+	ERROR err = check_complete(t);
-    if ( !IS_NULL_err ( err ) ) {
+	if (!IS_NULL_err(err)) {
-	/* Type should be complete */
+		/* Type should be complete */
-	err = concat_error ( err, ERR_expr_new_incompl () ) ;
+		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 ) ;
+		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 ) ;
+	err = check_abstract(t);
-    if ( is_templ_type ( t ) ) {
+	if (!IS_NULL_err(err)) {
-	if ( op == lex_new_Harray ) {
+		/* Type can't be abstract */
-	    /* Create dummy array type */
+		err = concat_error(err, ERR_expr_new_abstract());
-	    NAT n = small_nat [1] ;
+		report(crt_loc, err);
-	    MAKE_type_array ( cv_none, t, n, t ) ;
+		err = NULL_err;
+	}
+	while (IS_type_array(t)) {
+		/* Step over array components */
+		op = lex_new_Harray;
-	if ( init ) {
+		if (init) {
-	    MAKE_exp_opn ( t, lex_compute, p, e ) ;
+			report(crt_loc, ERR_expr_new_array_init(op));
-	} else {
+			init = 0;
+		}
-	    MAKE_exp_op ( t, lex_compute, NULL_exp, NULL_exp, e ) ;
+		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 {
+		} else {
+			MAKE_exp_op(t, lex_compute, NULL_exp, NULL_exp, e);
+		}
+	} else {
-	if ( init ) {
+		if (init) {
-	    e = init_constr ( t, p, &err ) ;
+			e = init_constr(t, p, &err);
-	} else {
+		} else {
-	    e = init_empty ( t, cv_none, 0, &err ) ;
+			e = init_empty(t, cv_none, 0, &err);
-	}
+		}
-	if ( !IS_NULL_err ( err ) ) {
+		if (!IS_NULL_err(err)) {
-	    /* Report conversion errors */
+			/* Report conversion errors */
-	    err = concat_error ( ERR_expr_new_init ( op ), err ) ;
+			err = concat_error(ERR_expr_new_init(op), err);
-	    report ( crt_loc, err ) ;
+			report(crt_loc, err);
-	}
+		}
-	if ( !IS_NULL_exp ( e ) ) {
+		if (!IS_NULL_exp(e)) {
-	    /* Assign value to dummy expression */
+			/* Assign value to dummy expression */
-	    EXP a ;
+			EXP a;
-	    MAKE_exp_dummy ( t, NULL_exp, LINK_NONE, NULL_off, 1, a ) ;
+			MAKE_exp_dummy(t, NULL_exp, LINK_NONE, NULL_off, 1, a);
-	    MAKE_exp_assign ( t, a, e, e ) ;
+			MAKE_exp_assign(t, a, e, e);
+		}
+	}
-    }
-    return ( 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
+EXP
-    PROTO_Z ()
+begin_new_try(void)
+{
-    EXP a = begin_try_stmt ( 0 ) ;
+	EXP a = begin_try_stmt(0);
-    EXP b = begin_compound_stmt ( 2 ) ;
+	EXP b = begin_compound_stmt(2);
-    COPY_exp ( exp_try_block_body ( a ), b ) ;
+	COPY_exp(exp_try_block_body(a), b);
-    return ( a ) ;
+	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
-    PROTO_N ( ( a, b ) )
-    PROTO_T ( EXP a X EXP b )
+end_new_try(EXP a, EXP b)
+{
-    EXP c = DEREF_exp ( exp_try_block_body ( a ) ) ;
+	EXP c = DEREF_exp(exp_try_block_body(a));
-    c = add_compound_stmt ( c, b ) ;
+	c = add_compound_stmt(c, b);
-    c = end_compound_stmt ( c ) ;
+	c = end_compound_stmt(c);
-    a = cont_try_stmt ( a, c ) ;
+	a = cont_try_stmt(a, c);
-    a = end_try_stmt ( a, 1 ) ;
+	a = end_try_stmt(a, 1);
-    if ( IS_NULL_exp ( b ) ) {
+	if (IS_NULL_exp(b)) {
-	free_exp ( a, 1 ) ;
+		free_exp(a, 1);
-	a = NULL_exp ;
+		a = NULL_exp;
-    }
+	}
-    return ( a ) ;
+	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
-    PROTO_N ( ( a ) )
-    PROTO_T ( EXP a )
+new_try_body(EXP a)
 {
-    while ( !IS_NULL_exp ( a ) ) {
+	while (!IS_NULL_exp(a)) {
-	switch ( TAG_exp ( a ) ) {
+		switch (TAG_exp(a)) {
-	    case exp_try_block_tag : {
+		case exp_try_block_tag: {
-		a = DEREF_exp ( exp_try_block_body ( a ) ) ;
+			a = DEREF_exp(exp_try_block_body(a));
-		break ;
+			break;
-	    }
+		}
-	    case exp_decl_stmt_tag : {
+		case exp_decl_stmt_tag: {
-		a = DEREF_exp ( exp_decl_stmt_body ( a ) ) ;
+			a = DEREF_exp(exp_decl_stmt_body(a));
-		break ;
+			break;
-	    }
+		}
-	    case exp_sequence_tag : {
+		case exp_sequence_tag: {
-		LIST ( EXP ) p = DEREF_list ( exp_sequence_first ( a ) ) ;
+			LIST(EXP)p = DEREF_list(exp_sequence_first(a));
-		p = TAIL_list ( p ) ;
+			p = TAIL_list(p);
-		if ( IS_NULL_list ( p ) ) {
+			if (IS_NULL_list(p)) {
-		    a = NULL_exp ;
+				a = NULL_exp;
-		} else {
+			} else {
-		    a = DEREF_exp ( HEAD_list ( p ) ) ;
+				a = DEREF_exp(HEAD_list(p));
-		}
+			}
-		break ;
+			break;
-	    }
+		}
-	    case exp_location_tag : {
+		case exp_location_tag: {
-		a = DEREF_exp ( exp_location_arg ( a ) ) ;
+			a = DEREF_exp(exp_location_arg(a));
-		break ;
+			break;
-	    }
+		}
-	    default : {
+		default: {
-		return ( a ) ;
+			return (a);
-	    }
+		}
-	}
+		}
-    }
+	}
-    return ( NULL_exp ) ;
+	return (NULL_exp);
+}
 /*
     END OF ALLOCATION ROUTINES
     The remaining routines are common to both producers.
 */
 #endif /* LANGUAGE_CPP */
 /*
     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
+EXP
-    PROTO_N ( ( pt, s ) )
-    PROTO_T ( TYPE *pt X TYPE s )
+sizeof_array(TYPE *pt, TYPE s)
+{
-    TYPE t = *pt ;
+	TYPE t = *pt;
-    EXP a = NULL_exp ;
+	EXP a = NULL_exp;
-    while ( IS_type_array ( t ) ) {
+	while (IS_type_array(t)) {
-	EXP b ;
+		EXP b;
-	NAT n = DEREF_nat ( type_array_size ( t ) ) ;
+		NAT n = DEREF_nat(type_array_size(t));
-	if ( IS_NULL_nat ( n ) ) n = small_nat [0] ;
+		if (IS_NULL_nat(n)) {
+			n = small_nat[0];
+		}
-	b = calc_nat_value ( n, s ) ;
+		b = calc_nat_value(n, s);
-	a = make_dim_exp ( lex_star, a, b ) ;
+		a = make_dim_exp(lex_star, a, b);
-	t = DEREF_type ( type_array_sub ( t ) ) ;
+		t = DEREF_type(type_array_sub(t));
-    }
+	}
-    *pt = t ;
+	*pt = t;
-    return ( a ) ;
+	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
+static NAT
-    PROTO_N ( ( t ) )
-    PROTO_T ( TYPE t )
+sizeof_type(TYPE t)
 {
-    switch ( TAG_type ( t ) ) {
+	switch (TAG_type(t)) {
-	case type_integer_tag : {
+	case type_integer_tag: {
-	    /* Allow for integral types */
+		/* Allow for integral types */
-	    INT_TYPE it = DEREF_itype ( type_integer_rep ( t ) ) ;
+		INT_TYPE it = DEREF_itype(type_integer_rep(t));
-	    if ( IS_itype_basic ( it ) ) {
+		if (IS_itype_basic(it)) {
-		BASE_TYPE bt = DEREF_btype ( itype_basic_rep ( it ) ) ;
+			BASE_TYPE bt = DEREF_btype(itype_basic_rep(it));
-		if ( bt & btype_char ) {
+			if (bt & btype_char) {
-		    /* char has size one */
+				/* char has size one */
-		    NAT n = small_nat [1] ;
+				NAT n = small_nat[1];
-		    return ( n ) ;
+				return (n);
-		}
+			}
-	    }
+		}
-	    break ;
+		break;
 	}
-	case type_top_tag :
+	case type_top_tag:
-	case type_bottom_tag : {
+	case type_bottom_tag: {
-	    /* void has size one */
+		/* void has size one */
-	    NAT n = small_nat [1] ;
+		NAT n = small_nat[1];
-	    return ( n ) ;
+		return (n);
 	}
-	case type_array_tag : {
+	case type_array_tag: {
-	    /* Allow for array types */
+		/* Allow for array types */
-	    TYPE s = type_size_t ;
+		TYPE s = type_size_t;
-	    EXP a = sizeof_array ( &t, s ) ;
+		EXP a = sizeof_array(&t, s);
-	    NAT n = sizeof_type ( t ) ;
+		NAT n = sizeof_type(t);
-	    if ( !IS_NULL_nat ( n ) ) {
+		if (!IS_NULL_nat(n)) {
-		EXP b = calc_nat_value ( n, s ) ;
+			EXP b = calc_nat_value(n, s);
-		a = make_dim_exp ( lex_star, a, b ) ;
+			a = make_dim_exp(lex_star, a, b);
-		if ( IS_exp_int_lit ( a ) ) {
+			if (IS_exp_int_lit(a)) {
-		    n = DEREF_nat ( exp_int_lit_nat ( a ) ) ;
+				n = DEREF_nat(exp_int_lit_nat(a));
-		    return ( n ) ;
+				return (n);
-		}
+			}
-	    }
+		}
-	    break ;
+		break;
 	}
-	case type_enumerate_tag : {
+	case type_enumerate_tag: {
-	    /* An enumeration maps to its underlying type */
+		/* An enumeration maps to its underlying type */
-	    ENUM_TYPE et = DEREF_etype ( type_enumerate_defn ( t ) ) ;
+		ENUM_TYPE et = DEREF_etype(type_enumerate_defn(t));
-	    TYPE s = DEREF_type ( etype_rep ( et ) ) ;
+		TYPE s = DEREF_type(etype_rep(et));
-	    return ( sizeof_type ( s ) ) ;
+		return (sizeof_type(s));
 	}
-    }
+	}
-    return ( NULL_nat ) ;
+	return (NULL_nat);
 }
 /*
     CREATE A SIZEOF EXPRESSION
     This routine constructs the expression 'sizeof ( t )' without applying
     any checks to t.
 */
-EXP sizeof_exp
+EXP
-    PROTO_N ( ( t ) )
-    PROTO_T ( TYPE t )
+sizeof_exp(TYPE t)
+{
-    EXP e ;
+	EXP e;
-    NAT sz = sizeof_type ( t ) ;
+	NAT sz = sizeof_type(t);
-    if ( IS_NULL_nat ( sz ) ) {
+	if (IS_NULL_nat(sz)) {
-	/* Calculate size if it is not obvious */
+		/* Calculate size if it is not obvious */
-	OFFSET off ;
+		OFFSET off;
-	MAKE_off_type ( t, off ) ;
+		MAKE_off_type(t, off);
-	MAKE_exp_offset_size ( type_size_t, off, type_char, 1, e ) ;
+		MAKE_exp_offset_size(type_size_t, off, type_char, 1, e);
-	MAKE_nat_calc ( e, sz ) ;
+		MAKE_nat_calc(e, sz);
-    }
+	}
-    MAKE_exp_int_lit ( type_size_t, sz, exp_offset_size_tag, e ) ;
+	MAKE_exp_int_lit(type_size_t, sz, exp_offset_size_tag, e);
-    return ( e ) ;
+	return (e);
+}
 /*
     CONSTRUCT A SIZEOF EXPRESSION
     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
+EXP
-    PROTO_N ( ( t, a, n, op ) )
-    PROTO_T ( TYPE t X EXP a X int n X int op )
+make_sizeof_exp(TYPE t, EXP a, int n, int op)
+{
-    /* Deal with argument dependent case */
+	/* Deal with argument dependent case */
 #if LANGUAGE_CPP
-    if ( !IS_NULL_exp ( a ) ) {
+	if (!IS_NULL_exp(a)) {
-	EXP e ;
+		EXP e;
-	NAT sz ;
+		NAT sz;
-	TYPE s = type_size_t ;
+		TYPE s = type_size_t;
-	MAKE_exp_op ( s, op, a, NULL_exp, e ) ;
+		MAKE_exp_op(s, op, a, NULL_exp, e);
-	MAKE_nat_calc ( e, sz ) ;
+		MAKE_nat_calc(e, sz);
-	MAKE_exp_int_lit ( s, sz, exp_op_tag, e ) ;
+		MAKE_exp_int_lit(s, sz, exp_op_tag, e);
-	return ( e ) ;
+		return (e);
-    }
+	}
 #else
-    UNUSED ( a ) ;
+	UNUSED(a);
 #endif
-    /* Check on type */
+	/* Check on type */
-    switch ( TAG_type ( t ) ) {
+	switch (TAG_type(t)) {
-	case type_func_tag : {
+	case type_func_tag: {
-	    /* Can't have sizeof ( function ) */
+		/* Can't have sizeof (function) */
-	    report ( crt_loc, ERR_expr_sizeof_func ( op ) ) ;
+		report(crt_loc, ERR_expr_sizeof_func(op));
-	    MAKE_type_ptr ( cv_none, t, t ) ;
+		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 ;
+		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 : {
+	case type_ref_tag: {
-	    /* sizeof ( T & ) equals sizeof ( T ) */
+		/* sizeof (T &) equals sizeof (T) */
-	    t = DEREF_type ( type_ref_sub ( t ) ) ;
+		t = DEREF_type(type_ref_sub(t));
-	    break ;
+		break;
+	}
 	default : {
-	    /* Can't have sizeof ( incomplete ) */
+		/* Can't have sizeof (incomplete) */
-	    ERROR err = check_incomplete ( t ) ;
+		ERROR err = check_incomplete(t);
-	    if ( !IS_NULL_err ( err ) ) {
+		if (!IS_NULL_err(err)) {
-		err = concat_error ( err, ERR_expr_sizeof_incompl ( op ) ) ;
+			err = concat_error(err, ERR_expr_sizeof_incompl(op));
-		report ( crt_loc, err ) ;
+			report(crt_loc, err);
-	    }
+		}
-	    break ;
+		break;
 	}
-    }
+	}
-    /* Report on type definitions */
+	/* Report on type definitions */
+	if (n) {
-    if ( n ) report ( crt_loc, ERR_expr_sizeof_typedef ( op ) ) ;
+		report(crt_loc, ERR_expr_sizeof_typedef(op));
+	}
-    /* Calculate result */
+	/* Calculate result */
-    return ( sizeof_exp ( t ) ) ;
+	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
+TYPE
-    PROTO_N ( ( pa, n, op ) )
-    PROTO_T ( EXP *pa X int n X int op )
+typeof_exp(EXP *pa, int n, int op)
 {
-    TYPE t ;
+	TYPE t;
-    EXP a = *pa ;
+	EXP a = *pa;
+	if (n) {
-    if ( n ) report ( crt_loc, ERR_expr_sizeof_side ( op ) ) ;
+		report(crt_loc, ERR_expr_sizeof_side(op));
+	}
-    a = convert_reference ( a, REF_NORMAL ) ;
+	a = convert_reference(a, REF_NORMAL);
-    a = convert_none ( a ) ;
+	a = convert_none(a);
-    t = DEREF_type ( exp_type ( a ) ) ;
+	t = DEREF_type(exp_type(a));
-    if ( !is_templ_type ( t ) ) {
+	if (!is_templ_type(t)) {
-	/* Free operand in simple case */
+		/* Free operand in simple case */
-	free_exp ( a, 2 ) ;
+		free_exp(a, 2);
-	a = NULL_exp ;
+		a = NULL_exp;
-    }
+	}
-    *pa = a ;
+	*pa = a;
-    return ( t ) ;
+	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
-    PROTO_N ( ( e, s ) )
-    PROTO_T ( EXP e X TYPE s )
+sizeof_init(EXP e, TYPE s)
+{
-    EXP a = NULL_exp ;
+	EXP a = NULL_exp;
-    unsigned long v = 0 ;
+	unsigned long v = 0;
-    if ( !IS_NULL_exp ( e ) ) {
+	if (!IS_NULL_exp(e)) {
-	LIST ( EXP ) p, q ;
+		LIST(EXP)p, q;
-	if ( IS_exp_comma ( e ) ) {
+		if (IS_exp_comma(e)) {
-	    p = DEREF_list ( exp_comma_args ( e ) ) ;
+			p = DEREF_list(exp_comma_args(e));
-	    p = END_list ( p ) ;
+			p = END_list(p);
-	    e = DEREF_exp ( HEAD_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_exp_initialiser ( e ) ) {
+	if (IS_NULL_exp(a)) {
-	    p = DEREF_list ( exp_initialiser_args ( e ) ) ;
+		NAT n = make_nat_value(v);
-	    q = NULL_list ( EXP ) ;
+		a = calc_nat_value(n, s);
 	} else {
-	    CONS_exp ( e, NULL_list ( EXP ), p ) ;
-	    q = p ;
+		if (v) {
-	}
-	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 ) ) {
+			NAT n = make_nat_value(v);
-		    /* Multiply up array bounds */
-		    EXP c = sizeof_array ( &t, s ) ;
+			EXP c = calc_nat_value(n, s);
-		    a = make_dim_exp ( lex_plus, a, c ) ;
+			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 ) ;
+	return (a);
+}

Subversion Repositories tendra.SVN

(root)/branches/tendra5/src/producers/common/construct/allocate.c – Rev 5 → 6