Subversion Repositories tendra.SVN

Rev

Rev 2 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 2 Rev 7
Line -... Line 1...
- 
 
 1 
/*
- 
 
 2 
 * Copyright (c) 2002-2006 The TenDRA Project <http://www.tendra.org/>.
- 
 
 3 
 * All rights reserved.
- 
 
 4 
 *
- 
 
 5 
 * Redistribution and use in source and binary forms, with or without
- 
 
 6 
 * modification, are permitted provided that the following conditions are met:
- 
 
 7 
 *
- 
 
 8 
 * 1. Redistributions of source code must retain the above copyright notice,
- 
 
 9 
 *    this list of conditions and the following disclaimer.
- 
 
 10 
 * 2. Redistributions in binary form must reproduce the above copyright notice,
- 
 
 11 
 *    this list of conditions and the following disclaimer in the documentation
- 
 
 12 
 *    and/or other materials provided with the distribution.
- 
 
 13 
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
- 
 
 14 
 *    may be used to endorse or promote products derived from this software
- 
 
 15 
 *    without specific, prior written permission.
- 
 
 16 
 *
- 
 
 17 
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
- 
 
 18 
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
- 
 
 19 
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
- 
 
 20 
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
- 
 
 21 
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- 
 
 22 
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- 
 
 23 
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- 
 
 24 
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- 
 
 25 
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- 
 
 26 
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- 
 
 27 
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- 
 
 28 
 *
- 
 
 29 
 * $Id$
- 
 
 30 
 */
1 
/*
 31 
/*
2 
    		 Crown Copyright (c) 1997
 32 
    		 Crown Copyright (c) 1997
3
33 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
 34 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
 35 
    owned by the United Kingdom Secretary of State for Defence
6 
    acting through the Defence Evaluation and Research Agency
 36 
    acting through the Defence Evaluation and Research Agency
7 
    (DERA).  It is made available to Recipients with a
 37 
    (DERA).  It is made available to Recipients with a
8 
    royalty-free licence for its use, reproduction, transfer
 38 
    royalty-free licence for its use, reproduction, transfer
9 
    to other parties and amendment for any purpose not excluding
 39 
    to other parties and amendment for any purpose not excluding
10 
    product development provided that any such use et cetera
 40 
    product development provided that any such use et cetera
11 
    shall be deemed to be acceptance of the following conditions:-
 41 
    shall be deemed to be acceptance of the following conditions:-
12
42 
 
13 
        (1) Its Recipients shall ensure that this Notice is
 43 
        (1) Its Recipients shall ensure that this Notice is
14 
        reproduced upon any copies or amended versions of it;
 44 
        reproduced upon any copies or amended versions of it;
15
45 
 
16 
        (2) Any amended version of it shall be clearly marked to
 46 
        (2) Any amended version of it shall be clearly marked to
17 
        show both the nature of and the organisation responsible
 47 
        show both the nature of and the organisation responsible
18 
        for the relevant amendment or amendments;
 48 
        for the relevant amendment or amendments;
19
49 
 
20 
        (3) Its onward transfer from a recipient to another
 50 
        (3) Its onward transfer from a recipient to another
21 
        party shall be deemed to be that party's acceptance of
 51 
        party shall be deemed to be that party's acceptance of
22 
        these conditions;
 52 
        these conditions;
23
53 
 
24 
        (4) DERA gives no warranty or assurance as to its
 54 
        (4) DERA gives no warranty or assurance as to its
25 
        quality or suitability for any purpose and DERA accepts
 55 
        quality or suitability for any purpose and DERA accepts
26 
        no liability whatsoever in relation to any use to which
 56 
        no liability whatsoever in relation to any use to which
27 
        it may be put.
 57 
        it may be put.
28 
*/
 58 
*/
Line 74... Line 104...
74 
    specifications for functions.  The list empty_type_set is used to
 104 
    specifications for functions.  The list empty_type_set is used to
75 
    give the exception specification for a function when none is given,
 105 
    give the exception specification for a function when none is given,
76 
    by default it equals univ_type_set.
 106 
    by default it equals univ_type_set.
77 
*/
 107 
*/
78 
 
 108 
 
79 
LIST ( TYPE ) univ_type_set = NULL_list ( TYPE ) ;
 109 
LIST(TYPE) univ_type_set = NULL_list(TYPE);
80 
LIST ( TYPE ) empty_type_set = NULL_list ( TYPE ) ;
 110 
LIST(TYPE) empty_type_set = NULL_list(TYPE);
81 
 
 111 
 
82 
 
 112 
 
83 
/*
 113 
/*
84 
    INITIALISE THE SET OF ALL TYPES
 114 
    INITIALISE THE SET OF ALL TYPES
85 
 
 115 
 
86 
    This routine initialises the set of all types to a dummy unique list.
 116 
    This routine initialises the set of all types to a dummy unique list.
87 
*/
 117 
*/
88 
 
 118 
 
89 
void init_exception
 119 
void
90 
    PROTO_Z ()
 120 
init_exception(void)
91 
{
 121 
{
92 
    LIST ( TYPE ) p ;
 122 
	LIST(TYPE)p;
93 
    CONS_type ( type_any, NULL_list ( TYPE ), p ) ;
 123 
	CONS_type(type_any, NULL_list(TYPE), p);
94 
    p = uniq_type_set ( p ) ;
 124 
	p = uniq_type_set(p);
95 
    COPY_list ( type_func_except ( type_func_void ), p ) ;
 125 
	COPY_list(type_func_except(type_func_void), p);
96 
    COPY_list ( type_func_except ( type_temp_func ), p ) ;
 126 
	COPY_list(type_func_except(type_temp_func), p);
97 
    empty_type_set = p ;
 127 
	empty_type_set = p;
98 
    univ_type_set = p ;
 128 
	univ_type_set = p;
99 
    return ;
 129 
	return;
100 
}
 130 
}
101 
 
 131 
 
102 
 
 132 
 
103 
/*
 133 
/*
104 
    IS A TYPE IN A SET OF TYPES?
 134 
    IS A TYPE IN A SET OF TYPES?
105 
 
 135 
 
106 
    This routine checks whether the type t is an element of the set of
 136 
    This routine checks whether the type t is an element of the set of
107 
    types listed as p.
 137 
    types listed as p.
108 
*/
 138 
*/
109 
 
 139 
 
110 
int in_type_set
 140 
int
111 
    PROTO_N ( ( p, t ) )
 - 
 
112 
    PROTO_T ( LIST ( TYPE ) p X TYPE t )
 141 
in_type_set(LIST(TYPE)p, TYPE t)
113 
{
 142 
{
114 
    if ( EQ_list ( p, univ_type_set ) ) return ( 1 ) ;
 143 
	if (EQ_list(p, univ_type_set)) {
115 
    expand_tokdef++ ;
 - 
 
116 
    while ( !IS_NULL_list ( p ) ) {
 - 
 
117 
	TYPE s = DEREF_type ( HEAD_list ( p ) ) ;
 - 
 
118 
	if ( EQ_type ( t, s ) || eq_type_unqual ( t, s ) ) {
 - 
 
119 
	    expand_tokdef-- ;
 - 
 
120 
	    return ( 1 ) ;
 144 
		return (1);
121 
	}
 145 
	}
- 
 
 146 
	expand_tokdef++;
- 
 
 147 
	while (!IS_NULL_list(p)) {
- 
 
 148 
		TYPE s = DEREF_type(HEAD_list(p));
- 
 
 149 
		if (EQ_type(t, s) || eq_type_unqual(t, s)) {
- 
 
 150 
			expand_tokdef--;
- 
 
 151 
			return (1);
- 
 
 152 
		}
122 
	p = TAIL_list ( p ) ;
 153 
		p = TAIL_list(p);
123 
    }
 154 
	}
124 
    expand_tokdef-- ;
 155 
	expand_tokdef--;
125 
    return ( 0 ) ;
 156 
	return (0);
126 
}
 157 
}
127 
 
 158 
 
128 
 
 159 
 
129 
/*
 160 
/*
130 
    IS A TYPE DERIVABLE FROM A SET OF TYPES?
 161 
    IS A TYPE DERIVABLE FROM A SET OF TYPES?
131 
 
 162 
 
132 
    This routine checks whether an exception of type t will be caught by
 163 
    This routine checks whether an exception of type t will be caught by
133 
    an element of the set of types listed as p.  It returns the catching
 164 
    an element of the set of types listed as p.  It returns the catching
134 
    type, or the null type if no match is found.
 165 
    type, or the null type if no match is found.
135 
*/
 166 
*/
136 
 
 167 
 
137 
static TYPE from_type_set
 168 
static TYPE
138 
    PROTO_N ( ( p, t ) )
 - 
 
139 
    PROTO_T ( LIST ( TYPE ) p X TYPE t )
 169 
from_type_set(LIST(TYPE)p, TYPE t)
140 
{
 170 
{
141 
    if ( EQ_list ( p, univ_type_set ) ) {
 171 
	if (EQ_list(p, univ_type_set)) {
142 
	/* The universal set catches everything */
 172 
		/* The universal set catches everything */
143 
	return ( t ) ;
 173 
		return (t);
144 
    }
 174 
	}
145 
    expand_tokdef++ ;
 175 
	expand_tokdef++;
- 
 
 176 
	if (IS_type_ref(t)) {
146 
    if ( IS_type_ref ( t ) ) t = DEREF_type ( type_ref_sub ( t ) ) ;
 177 
		t = DEREF_type(type_ref_sub(t));
- 
 
 178 
	}
147 
    while ( !IS_NULL_list ( p ) ) {
 179 
	while (!IS_NULL_list(p)) {
148 
	TYPE r = DEREF_type ( HEAD_list ( p ) ) ;
 180 
		TYPE r = DEREF_type(HEAD_list(p));
149 
	if ( !IS_NULL_type ( r ) ) {
 181 
		if (!IS_NULL_type(r)) {
150 
	    TYPE s = r ;
 182 
			TYPE s = r;
151 
	    unsigned rank ;
 183 
			unsigned rank;
152 
	    CONVERSION conv ;
 184 
			CONVERSION conv;
- 
 
 185 
			if (IS_type_ref(s)) {
153 
	    if ( IS_type_ref ( s ) ) s = DEREF_type ( type_ref_sub ( s ) ) ;
 186 
				s = DEREF_type(type_ref_sub(s));
- 
 
 187 
			}
154 
	    if ( eq_type_unqual ( t, s ) ) {
 188 
			if (eq_type_unqual(t, s)) {
155 
		/* Exact match is allowed */
 189 
				/* Exact match is allowed */
156 
		expand_tokdef-- ;
 190 
				expand_tokdef--;
157 
		return ( r ) ;
 191 
				return (r);
158 
	    }
 192 
			}
159 
	    conv.from = t ;
 193 
			conv.from = t;
160 
	    conv.to = s ;
 194 
			conv.to = s;
161 
	    rank = std_convert_seq ( &conv, NULL_exp, 0, 0 ) ;
 195 
			rank = std_convert_seq(&conv, NULL_exp, 0, 0);
162 
	    switch ( rank ) {
 196 
			switch (rank) {
163 
		case CONV_EXACT :
 197 
			case CONV_EXACT:
164 
		case CONV_QUAL :
 198 
			case CONV_QUAL:
165 
		case CONV_BASE :
 199 
			case CONV_BASE:
166 
		case CONV_PTR_BASE :
 200 
			case CONV_PTR_BASE:
167 
		case CONV_PTR_VOID :
 201 
			case CONV_PTR_VOID:
168 
		case CONV_PTR_BOTTOM : {
 202 
			case CONV_PTR_BOTTOM:
169 
		    /* These conversions are allowed */
 203 
				/* These conversions are allowed */
170 
		    expand_tokdef-- ;
 204 
				expand_tokdef--;
171 
		    return ( r ) ;
 205 
				return (r);
- 
 
 206 
			}
172 
		}
 207 
		}
173 
	    }
 208 
		p = TAIL_list(p);
174 
	}
 209 
	}
175 
	p = TAIL_list ( p ) ;
 - 
 
176 
    }
 - 
 
177 
    expand_tokdef-- ;
 210 
	expand_tokdef--;
178 
    return ( NULL_type ) ;
 211 
	return (NULL_type);
179 
}
 212 
}
180 
 
 213 
 
181 
 
 214 
 
182 
/*
 215 
/*
183 
    ARE TWO TYPE SETS EQUAL?
 216 
    ARE TWO TYPE SETS EQUAL?
184 
 
 217 
 
185 
    This routine checks whether the sets of types listed as p and q are
 218 
    This routine checks whether the sets of types listed as p and q are
186 
    equal.  It returns 2 if they are equal, 1 if p is a subset of q, and
 219 
    equal.  It returns 2 if they are equal, 1 if p is a subset of q, and
187 
    0 otherwise.  Because p and q will have been constructed not to contain
 220 
    0 otherwise.  Because p and q will have been constructed not to contain
188 
    duplicate elements a fair amount can be deduced from the cardinalities
 221 
    duplicate elements a fair amount can be deduced from the cardinalities
189 
    of the sets, also the search is optimised if the types are given in
 222 
    of the sets, also the search is optimised if the types are given in
190 
    the same order in each set.  If eq is true then only equality is
 223 
    the same order in each set.  If eq is true then only equality is
191 
    checked for.
 224 
    checked for.
192 
*/
 225 
*/
193 
 
 226 
 
194 
int eq_type_set
 227 
int
195 
    PROTO_N ( ( p, q, eq ) )
 - 
 
196 
    PROTO_T ( LIST ( TYPE ) p X LIST ( TYPE ) q X int eq )
 228 
eq_type_set(LIST(TYPE) p, LIST(TYPE) q, int eq)
197 
{
 229 
{
198 
    unsigned n, m ;
 230 
	unsigned n, m;
199 
    LIST ( TYPE ) r ;
 231 
	LIST(TYPE)r;
200 
 
 232 
 
201 
    /* Deal with the set of all types */
 233 
	/* Deal with the set of all types */
202 
    if ( EQ_list ( p, q ) ) return ( 2 ) ;
 234 
	if (EQ_list(p, q)) {
- 
 
 235 
		return (2);
- 
 
 236 
	}
203 
    if ( EQ_list ( q, univ_type_set ) && !eq ) return ( 1 ) ;
 237 
	if (EQ_list(q, univ_type_set) && !eq) {
- 
 
 238 
		return (1);
- 
 
 239 
	}
204 
    if ( EQ_list ( p, univ_type_set ) ) return ( 0 ) ;
 240 
	if (EQ_list(p, univ_type_set)) {
- 
 
 241 
		return (0);
- 
 
 242 
	}
205 
 
 243 
 
206 
    /* Check whether p is larger than q */
 244 
	/* Check whether p is larger than q */
207 
    n = LENGTH_list ( p ) ;
 245 
	n = LENGTH_list(p);
208 
    m = LENGTH_list ( q ) ;
 246 
	m = LENGTH_list(q);
- 
 
 247 
	if (n > m) {
209 
    if ( n > m ) return ( 0 ) ;
 248 
		return (0);
- 
 
 249 
	}
210 
    if ( n < m && eq ) return ( 0 ) ;
 250 
	if (n < m && eq) {
- 
 
 251 
		return (0);
- 
 
 252 
	}
211 
 
 253 
 
212 
    /* Check whether p is a subset of q */
 254 
	/* Check whether p is a subset of q */
213 
    r = q ;
 255 
	r = q;
214 
    while ( !IS_NULL_list ( p ) ) {
 256 
	while (!IS_NULL_list(p)) {
215 
	TYPE t = DEREF_type ( HEAD_list ( p ) ) ;
 257 
		TYPE t = DEREF_type(HEAD_list(p));
216 
	TYPE s = DEREF_type ( HEAD_list ( r ) ) ;
 258 
		TYPE s = DEREF_type(HEAD_list(r));
217 
	if ( !EQ_type ( t, s ) && !eq_type_unqual ( t, s ) ) {
 259 
		if (!EQ_type(t, s) && !eq_type_unqual(t, s)) {
218 
	    if ( !in_type_set ( q, t ) ) return ( 0 ) ;
 260 
			if (!in_type_set(q, t)) {
- 
 
 261 
				return (0);
- 
 
 262 
			}
219 
	}
 263 
		}
220 
	r = TAIL_list ( r ) ;
 264 
		r = TAIL_list(r);
221 
	p = TAIL_list ( p ) ;
 265 
		p = TAIL_list(p);
222 
    }
 266 
	}
223 
 
 267 
 
224 
    /* Check for equality using set sizes */
 268 
	/* Check for equality using set sizes */
- 
 
 269 
	if (n < m) {
225 
    if ( n < m ) return ( 1 ) ;
 270 
		return (1);
- 
 
 271 
	}
226 
    return ( 2 ) ;
 272 
	return (2);
227 
}
 273 
}
228 
 
 274 
 
229 
 
 275 
 
230 
/*
 276 
/*
231 
    ADD AN ELEMENT TO A TYPE SET
 277 
    ADD AN ELEMENT TO A TYPE SET
232 
 
 278 
 
233 
    This routine adds the type t to the type set p if it is not already
 279 
    This routine adds the type t to the type set p if it is not already
234 
    a member.
 280 
    a member.
235 
*/
 281 
*/
236 
 
 282 
 
237 
LIST ( TYPE ) cons_type_set
 283 
LIST(TYPE)
238 
    PROTO_N ( ( p, t ) )
 - 
 
239 
    PROTO_T ( LIST ( TYPE ) p X TYPE t )
 284 
cons_type_set(LIST(TYPE) p, TYPE t)
240 
{
 285 
{
241 
    if ( !IS_NULL_type ( t ) && !in_type_set ( p, t ) ) {
 286 
	if (!IS_NULL_type(t) && !in_type_set(p, t)) {
242 
	CONS_type ( t, p, p ) ;
 287 
		CONS_type(t, p, p);
243 
    }
 288 
	}
244 
    return ( p ) ;
 289 
	return (p);
245 
}
 290 
}
246 
 
 291 
 
247 
 
 292 
 
248 
/*
 293 
/*
249 
    FIND THE UNION OF TWO TYPE SETS
 294 
    FIND THE UNION OF TWO TYPE SETS
250 
 
 295 
 
251 
    This routine adds the elements of the type set q to the type set p.
 296 
    This routine adds the elements of the type set q to the type set p.
252 
*/
 297 
*/
253 
 
 298 
 
254 
LIST ( TYPE ) union_type_set
 299 
LIST(TYPE)
255 
    PROTO_N ( ( p, q ) )
 - 
 
256 
    PROTO_T ( LIST ( TYPE ) p X LIST ( TYPE ) q )
 300 
union_type_set(LIST(TYPE)p, LIST(TYPE)q)
257 
{
 301 
{
258 
    if ( !EQ_list ( p, univ_type_set ) ) {
 302 
	if (!EQ_list(p, univ_type_set)) {
259 
	if ( EQ_list ( q, univ_type_set ) ) {
 303 
		if (EQ_list(q, univ_type_set)) {
260 
	    DESTROY_list ( p, SIZE_type ) ;
 304 
			DESTROY_list(p, SIZE_type);
261 
	    p = q ;
 305 
			p = q;
262 
	} else {
 306 
		} else {
263 
	    while ( !IS_NULL_list ( q ) ) {
 307 
			while (!IS_NULL_list(q)) {
264 
		TYPE t = DEREF_type ( HEAD_list ( q ) ) ;
 308 
				TYPE t = DEREF_type(HEAD_list(q));
265 
		if ( !IS_NULL_type ( t ) ) {
 309 
				if (!IS_NULL_type(t)) {
266 
		    if ( !in_type_set ( p, t ) ) CONS_type ( t, p, p ) ;
 310 
					if (!in_type_set(p, t)) {
- 
 
 311 
						CONS_type(t, p, p);
- 
 
 312 
					}
- 
 
 313 
				}
- 
 
 314 
				q = TAIL_list(q);
- 
 
 315 
			}
267 
		}
 316 
		}
268 
		q = TAIL_list ( q ) ;
 - 
 
269 
	    }
 - 
 
270 
	}
 317 
	}
271 
    }
 - 
 
272 
    return ( p ) ;
 318 
	return (p);
273 
}
 319 
}
274 
 
 320 
 
275 
 
 321 
 
276 
/*
 322 
/*
277 
    MAKE A UNIQUE COPY OF A TYPE SET
 323 
    MAKE A UNIQUE COPY OF A TYPE SET
278 
 
 324 
 
279 
    This routine maintains a list of type sets.  If p equals an element of
 325 
    This routine maintains a list of type sets.  If p equals an element of
280 
    this list then the copy is returned and p is destroyed.  Otherwise p
 326 
    this list then the copy is returned and p is destroyed.  Otherwise p
281 
    is added to the list.
 327 
    is added to the list.
282 
*/
 328 
*/
283 
 
 329 
 
284 
LIST ( TYPE ) uniq_type_set
 330 
LIST(TYPE)
285 
    PROTO_N ( ( p ) )
 - 
 
286 
    PROTO_T ( LIST ( TYPE ) p )
 331 
uniq_type_set(LIST(TYPE)p)
287 
{
 332 
{
288 
    static LIST ( LIST ( TYPE ) ) sets = NULL_list ( LIST ( TYPE ) ) ;
 333 
	static LIST(LIST(TYPE)) sets = NULL_list(LIST(TYPE));
289 
    LIST ( LIST ( TYPE ) ) s = sets ;
 334 
	LIST(LIST(TYPE))s = sets;
290 
    while ( !IS_NULL_list ( s ) ) {
 335 
	while (!IS_NULL_list(s)) {
291 
	LIST ( TYPE ) q = DEREF_list ( HEAD_list ( s ) ) ;
 336 
		LIST(TYPE)q = DEREF_list(HEAD_list(s));
292 
	if ( eq_type_set ( p, q, 1 ) == 2 ) {
 337 
		if (eq_type_set(p, q, 1) == 2) {
293 
	    DESTROY_list ( p, SIZE_type ) ;
 338 
			DESTROY_list(p, SIZE_type);
294 
	    return ( q ) ;
 339 
			return (q);
295 
	}
 340 
		}
296 
	s = TAIL_list ( s ) ;
 341 
		s = TAIL_list(s);
297 
    }
 342 
	}
298 
    CONS_list ( p, sets, sets ) ;
 343 
	CONS_list(p, sets, sets);
299 
    return ( p ) ;
 344 
	return (p);
300 
}
 345 
}
301 
 
 346 
 
302 
 
 347 
 
303 
/*
 348 
/*
304 
    COMPARE THE EXCEPTION SPECIFIERS OF TWO TYPES
 349 
    COMPARE THE EXCEPTION SPECIFIERS OF TWO TYPES
305 
 
 350 
 
306 
    This routine compares the exception specifiers of the similar types
 351 
    This routine compares the exception specifiers of the similar types
307 
    s and t.  It returns 2 if they are equal, 1 if s is more constrained
 352 
    s and t.  It returns 2 if they are equal, 1 if s is more constrained
308 
    than t, and 0 otherwise.
 353 
    than t, and 0 otherwise.
309 
*/
 354 
*/
310 
 
 - 
 
311 
int eq_except
 - 
 
312 
    PROTO_N ( ( s, t ) )
 - 
 
313 
    PROTO_T ( TYPE s X TYPE t )
 - 
 
314 
{
 - 
 
315 
    unsigned ns, nt ;
 - 
 
316 
    if ( EQ_type ( s, t ) ) return ( 2 ) ;
 - 
 
317 
    if ( IS_NULL_type ( s ) ) return ( 0 ) ;
 - 
 
318 
    if ( IS_NULL_type ( t ) ) return ( 0 ) ;
 - 
 
319 
    ns = TAG_type ( s ) ;
 - 
 
320 
    nt = TAG_type ( t ) ;
 - 
 
321 
    if ( ns != nt ) return ( 2 ) ;
 - 
 
322 
    ASSERT ( ORDER_type == 18 ) ;
 - 
 
323 
    switch ( ns ) {
 - 
 
324 
 
 - 
 
325 
	case type_func_tag : {
 - 
 
326 
	    /* Function types */
 - 
 
327 
	    LIST ( TYPE ) es = DEREF_list ( type_func_except ( s ) ) ;
 - 
 
328 
	    LIST ( TYPE ) et = DEREF_list ( type_func_except ( t ) ) ;
 - 
 
329 
	    int eq = eq_type_set ( es, et, 0 ) ;
 - 
 
330 
	    if ( eq ) {
 - 
 
331 
		TYPE rs, rt ;
 - 
 
332 
		LIST ( TYPE ) ps = DEREF_list ( type_func_ptypes ( s ) ) ;
 - 
 
333 
		LIST ( TYPE ) pt = DEREF_list ( type_func_ptypes ( t ) ) ;
 - 
 
334 
		while ( !IS_NULL_list ( ps ) && !IS_NULL_list ( pt ) ) {
 - 
 
335 
		    rs = DEREF_type ( HEAD_list ( ps ) ) ;
 - 
 
336 
		    rt = DEREF_type ( HEAD_list ( pt ) ) ;
 - 
 
337 
		    if ( eq_except ( rs, rt ) != 2 ) return ( 0 ) ;
 - 
 
338 
		    pt = TAIL_list ( pt ) ;
 - 
 
339 
		    ps = TAIL_list ( ps ) ;
 - 
 
340 
		}
 - 
 
341 
		rs = DEREF_type ( type_func_ret ( s ) ) ;
 - 
 
342 
		rt = DEREF_type ( type_func_ret ( t ) ) ;
 - 
 
343 
		if ( eq_except ( rs, rt ) != 2 ) return ( 0 ) ;
 - 
 
344 
	    }
 - 
 
345 
	    return ( eq ) ;
 - 
 
346 
	}
 - 
 
347 
 
 - 
 
348 
	case type_ptr_tag :
 - 
 
349 
	case type_ref_tag : {
 - 
 
350 
	    /* Pointer and reference types */
 - 
 
351 
	    TYPE ps = DEREF_type ( type_ptr_etc_sub ( s ) ) ;
 - 
 
352 
	    TYPE pt = DEREF_type ( type_ptr_etc_sub ( t ) ) ;
 - 
 
353 
	    return ( eq_except ( ps, pt ) ) ;
 - 
 
354 
	}
 - 
 
355 
 
 355 
 
- 
 
 356 
int
- 
 
 357 
eq_except(TYPE s, TYPE t)
- 
 
 358 
{
- 
 
 359 
	unsigned ns, nt;
- 
 
 360 
	if (EQ_type(s, t)) {
- 
 
 361 
		return (2);
- 
 
 362 
	}
- 
 
 363 
	if (IS_NULL_type(s)) {
- 
 
 364 
		return (0);
- 
 
 365 
	}
- 
 
 366 
	if (IS_NULL_type(t)) {
- 
 
 367 
		return (0);
- 
 
 368 
	}
- 
 
 369 
	ns = TAG_type(s);
- 
 
 370 
	nt = TAG_type(t);
- 
 
 371 
	if (ns != nt) {
- 
 
 372 
		return (2);
- 
 
 373 
	}
- 
 
 374 
	ASSERT(ORDER_type == 18);
- 
 
 375 
	switch (ns) {
- 
 
 376 
	case type_func_tag: {
- 
 
 377 
		/* Function types */
- 
 
 378 
		LIST(TYPE)es = DEREF_list(type_func_except(s));
- 
 
 379 
		LIST(TYPE)et = DEREF_list(type_func_except(t));
- 
 
 380 
		int eq = eq_type_set(es, et, 0);
- 
 
 381 
		if (eq) {
- 
 
 382 
			TYPE rs, rt;
- 
 
 383 
			LIST(TYPE)ps = DEREF_list(type_func_ptypes(s));
- 
 
 384 
			LIST(TYPE)pt = DEREF_list(type_func_ptypes(t));
- 
 
 385 
			while (!IS_NULL_list(ps) && !IS_NULL_list(pt)) {
- 
 
 386 
				rs = DEREF_type(HEAD_list(ps));
- 
 
 387 
				rt = DEREF_type(HEAD_list(pt));
- 
 
 388 
				if (eq_except(rs, rt) != 2) {
- 
 
 389 
					return (0);
- 
 
 390 
				}
- 
 
 391 
				pt = TAIL_list(pt);
- 
 
 392 
				ps = TAIL_list(ps);
- 
 
 393 
			}
- 
 
 394 
			rs = DEREF_type(type_func_ret(s));
- 
 
 395 
			rt = DEREF_type(type_func_ret(t));
- 
 
 396 
			if (eq_except(rs, rt) != 2) {
- 
 
 397 
				return (0);
- 
 
 398 
			}
- 
 
 399 
		}
- 
 
 400 
		return (eq);
- 
 
 401 
	}
- 
 
 402 
	case type_ptr_tag:
356 
	case type_ptr_mem_tag : {
 403 
	case type_ref_tag: {
357 
	    /* Pointer to member types */
 404 
		/* Pointer and reference types */
358 
	    TYPE ps = DEREF_type ( type_ptr_mem_sub ( s ) ) ;
 405 
		TYPE ps = DEREF_type(type_ptr_etc_sub(s));
359 
	    TYPE pt = DEREF_type ( type_ptr_mem_sub ( t ) ) ;
 406 
		TYPE pt = DEREF_type(type_ptr_etc_sub(t));
360 
	    return ( eq_except ( ps, pt ) ) ;
 407 
		return (eq_except(ps, pt));
361 
	}
 408 
	}
- 
 
 409 
	case type_ptr_mem_tag: {
- 
 
 410 
		/* Pointer to member types */
- 
 
 411 
		TYPE ps = DEREF_type(type_ptr_mem_sub(s));
- 
 
 412 
		TYPE pt = DEREF_type(type_ptr_mem_sub(t));
- 
 
 413 
		return (eq_except(ps, pt));
362 
 
 414 
	}
363 
	case type_array_tag : {
 415 
	case type_array_tag: {
364 
	    /* Array types */
 416 
		/* Array types */
365 
	    TYPE ps = DEREF_type ( type_array_sub ( s ) ) ;
 417 
		TYPE ps = DEREF_type(type_array_sub(s));
366 
	    TYPE pt = DEREF_type ( type_array_sub ( t ) ) ;
 418 
		TYPE pt = DEREF_type(type_array_sub(t));
367 
	    return ( eq_except ( ps, pt ) ) ;
 419 
		return (eq_except(ps, pt));
- 
 
 420 
	}
- 
 
 421 
	case type_templ_tag: {
- 
 
 422 
		/* Template types */
- 
 
 423 
		TOKEN as = DEREF_tok(type_templ_sort(s));
- 
 
 424 
		TOKEN at = DEREF_tok(type_templ_sort(t));
- 
 
 425 
		LIST(IDENTIFIER) qs = DEREF_list(tok_templ_pids(as));
- 
 
 426 
		LIST(IDENTIFIER) qt = DEREF_list(tok_templ_pids(at));
- 
 
 427 
		int eq = eq_templ_params(qs, qt);
- 
 
 428 
		if (eq) {
- 
 
 429 
			TYPE ps = DEREF_type(type_templ_defn(s));
- 
 
 430 
			TYPE pt = DEREF_type(type_templ_defn(t));
- 
 
 431 
			eq = eq_except(ps, pt);
- 
 
 432 
		}
- 
 
 433 
		restore_templ_params(qs);
- 
 
 434 
		return (eq);
368 
	}
 435 
	}
369 
 
 - 
 
370 
	case type_templ_tag : {
 - 
 
371 
	    /* Template types */
 - 
 
372 
	    TOKEN as = DEREF_tok ( type_templ_sort ( s ) ) ;
 - 
 
373 
	    TOKEN at = DEREF_tok ( type_templ_sort ( t ) ) ;
 - 
 
374 
	    LIST ( IDENTIFIER ) qs = DEREF_list ( tok_templ_pids ( as ) ) ;
 - 
 
375 
	    LIST ( IDENTIFIER ) qt = DEREF_list ( tok_templ_pids ( at ) ) ;
 - 
 
376 
	    int eq = eq_templ_params ( qs, qt ) ;
 - 
 
377 
	    if ( eq ) {
 - 
 
378 
		TYPE ps = DEREF_type ( type_templ_defn ( s ) ) ;
 - 
 
379 
		TYPE pt = DEREF_type ( type_templ_defn ( t ) ) ;
 - 
 
380 
		eq = eq_except ( ps, pt ) ;
 - 
 
381 
	    }
 - 
 
382 
	    restore_templ_params ( qs ) ;
 - 
 
383 
	    return ( eq ) ;
 - 
 
384 
	}
 436 
	}
385 
    }
 - 
 
386 
    return ( 2 ) ;
 437 
	return (2);
387 
}
 438 
}
388 
 
 439 
 
389 
 
 440 
 
390 
/*
 441 
/*
391 
    CREATE AN EXCEPTION TYPE
 442 
    CREATE AN EXCEPTION TYPE
392 
 
 443 
 
393 
    This routine converts the exception type t to its primary form.
 444 
    This routine converts the exception type t to its primary form.
394 
    Reference types are replaced by the referenced type and any top level
 445 
    Reference types are replaced by the referenced type and any top level
395 
    type qualifiers are removed.  chk gives the context for the conversion,
 446 
    type qualifiers are removed.  chk gives the context for the conversion,
396 
    1 for a throw expression, 2 for a catch statement, 3 for an exception
 447 
    1 for a throw expression, 2 for a catch statement, 3 for an exception
397 
    specifier and 0 otherwise.
 448 
    specifier and 0 otherwise.
398 
*/
 449 
*/
399 
 
 450 
 
400 
TYPE exception_type
 451 
TYPE
401 
    PROTO_N ( ( t, chk ) )
 - 
 
402 
    PROTO_T ( TYPE t X int chk )
 452 
exception_type(TYPE t, int chk)
403 
{
 453 
{
404 
    if ( !IS_NULL_type ( t ) ) {
 454 
	if (!IS_NULL_type(t)) {
405 
	unsigned tag = TAG_type ( t ) ;
 455 
		unsigned tag = TAG_type(t);
406 
	if ( tag == type_ref_tag ) {
 456 
		if (tag == type_ref_tag) {
407 
	    t = DEREF_type ( type_ref_sub ( t ) ) ;
 457 
			t = DEREF_type(type_ref_sub(t));
408 
	    tag = TAG_type ( t ) ;
 - 
 
409 
	}
 - 
 
410 
	t = qualify_type ( t, cv_none, 0 ) ;
 - 
 
411 
	if ( chk ) {
 - 
 
412 
	    /* Check exception type */
 - 
 
413 
	    TYPE s = t ;
 - 
 
414 
	    if ( tag == type_ptr_tag ) {
 - 
 
415 
		s = DEREF_type ( type_ptr_sub ( s ) ) ;
 - 
 
416 
		tag = TAG_type ( s ) ;
 458 
			tag = TAG_type(t);
417 
	    }
 - 
 
418 
	    if ( tag == type_compound_tag ) {
 - 
 
419 
		ERROR err = check_incomplete ( s ) ;
 - 
 
420 
		if ( !IS_NULL_err ( err ) ) {
 - 
 
421 
		    /* Can't have an incomplete class */
 - 
 
422 
		    ERROR err2 = NULL_err ;
 - 
 
423 
		    switch ( chk ) {
 - 
 
424 
			case 1 : err2 = ERR_except_throw_incompl () ; break ;
 - 
 
425 
			case 2 : err2 = ERR_except_handle_incompl () ; break ;
 - 
 
426 
			case 3 : err2 = ERR_except_spec_incompl () ; break ;
 - 
 
427 
		    }
 - 
 
428 
		    err = concat_error ( err, err2 ) ;
 - 
 
429 
		    report ( crt_loc, err ) ;
 - 
 
430 
		}
 459 
		}
- 
 
 460 
		t = qualify_type(t, cv_none, 0);
- 
 
 461 
		if (chk) {
- 
 
 462 
			/* Check exception type */
- 
 
 463 
			TYPE s = t;
- 
 
 464 
			if (tag == type_ptr_tag) {
- 
 
 465 
				s = DEREF_type(type_ptr_sub(s));
- 
 
 466 
				tag = TAG_type(s);
- 
 
 467 
			}
- 
 
 468 
			if (tag == type_compound_tag) {
- 
 
 469 
				ERROR err = check_incomplete(s);
- 
 
 470 
				if (!IS_NULL_err(err)) {
- 
 
 471 
					/* Can't have an incomplete class */
- 
 
 472 
					ERROR err2 = NULL_err;
- 
 
 473 
					switch (chk) {
- 
 
 474 
					case 1:
- 
 
 475 
						err2 =
- 
 
 476 
						    ERR_except_throw_incompl();
- 
 
 477 
						break;
- 
 
 478 
					case 2:
- 
 
 479 
						err2 =
- 
 
 480 
						    ERR_except_handle_incompl();
- 
 
 481 
						break;
- 
 
 482 
					case 3:
- 
 
 483 
						err2 =
- 
 
 484 
						    ERR_except_spec_incompl();
- 
 
 485 
						break;
- 
 
 486 
					}
- 
 
 487 
					err = concat_error(err, err2);
- 
 
 488 
					report(crt_loc, err);
- 
 
 489 
				}
431 
		if ( chk == 1 ) {
 490 
				if (chk == 1) {
432 
		    /* Can't throw a type with an ambiguous base */
 491 
					/* Can't throw a type with an ambiguous base */
- 
 
 492 
					CLASS_TYPE cs =
433 
		    CLASS_TYPE cs = DEREF_ctype ( type_compound_defn ( s ) ) ;
 493 
					    DEREF_ctype(type_compound_defn(s));
434 
		    err = class_info ( cs, cinfo_ambiguous, 1 ) ;
 494 
					err = class_info(cs, cinfo_ambiguous,
- 
 
 495 
							 1);
435 
		    if ( !IS_NULL_err ( err ) ) {
 496 
					if (!IS_NULL_err(err)) {
- 
 
 497 
						ERROR err2 =
436 
			ERROR err2 = ERR_except_throw_ambig () ;
 498 
						    ERR_except_throw_ambig();
437 
			err = concat_error ( err, err2 ) ;
 499 
						err = concat_error(err, err2);
438 
			report ( crt_loc, err ) ;
 500 
						report(crt_loc, err);
439 
		    }
 501 
					}
- 
 
 502 
				}
- 
 
 503 
			}
440 
		}
 504 
		}
441 
	    }
 - 
 
442 
	}
 505 
	}
443 
    }
 - 
 
444 
    return ( t ) ;
 506 
	return (t);
445 
}
 507 
}
446 
 
 508 
 
447 
 
 509 
 
448 
/*
 510 
/*
449 
    CHECK AN EXCEPTION SPECIFIER TYPE
 511 
    CHECK AN EXCEPTION SPECIFIER TYPE
450 
 
 512 
 
451 
    This routine checks the type t, which forms part of an exception
 513 
    This routine checks the type t, which forms part of an exception
452 
    specification for a function.  The argument n gives the number of types
 514 
    specification for a function.  The argument n gives the number of types
453 
    defined in t.
 515 
    defined in t.
454 
*/
 516 
*/
455 
 
 517 
 
456 
TYPE check_except_type
 518 
TYPE
457 
    PROTO_N ( ( t, n ) )
 - 
 
458 
    PROTO_T ( TYPE t X int n )
 519 
check_except_type(TYPE t, int n)
459 
{
 520 
{
- 
 
 521 
	if (n) {
460 
    if ( n ) report ( crt_loc, ERR_except_spec_typedef () ) ;
 522 
		report(crt_loc, ERR_except_spec_typedef());
- 
 
 523 
	}
461 
    IGNORE exception_type ( t, 3 ) ;
 524 
	IGNORE exception_type(t, 3);
462 
    return ( t ) ;
 525 
	return (t);
463 
}
 526 
}
464 
 
 527 
 
465 
 
 528 
 
466 
/*
 529 
/*
467 
    STACK OF CURRENTLY ACTIVE TRY BLOCKS
 530 
    STACK OF CURRENTLY ACTIVE TRY BLOCKS
Line 470... Line 533...
470 
    blocks and exception handlers.  The flag in_func_handler is set to
 533 
    blocks and exception handlers.  The flag in_func_handler is set to
471 
    1 (or 2 for constructors and destructors) in the handler of a function
 534 
    1 (or 2 for constructors and destructors) in the handler of a function
472 
    try block.
 535 
    try block.
473 
*/
 536 
*/
474 
 
 537 
 
475 
STACK ( EXP ) crt_try_blocks = NULL_stack ( EXP ) ;
 538 
STACK(EXP) crt_try_blocks = NULL_stack(EXP);
476 
static STACK ( STACK ( EXP ) ) past_try_blocks = NULL_stack ( STACK ( EXP ) ) ;
 539 
static STACK(STACK(EXP)) past_try_blocks = NULL_stack(STACK(EXP));
477 
int in_func_handler = 0 ;
 540 
int in_func_handler = 0;
478 
 
 541 
 
479 
 
 542 
 
480 
/*
 543 
/*
481 
    CHECK A THROWN TYPE
 544 
    CHECK A THROWN TYPE
482 
 
 545 
 
Line 484... Line 547...
484 
    (if expl is true) or a function call.  The null type is used to
 547 
    (if expl is true) or a function call.  The null type is used to
485 
    indicate an unknown type.  The routine returns true if the exception
 548 
    indicate an unknown type.  The routine returns true if the exception
486 
    is caught by an enclosing handler.
 549 
    is caught by an enclosing handler.
487 
*/
 550 
*/
488 
 
 551 
 
489 
int check_throw
 552 
int
490 
    PROTO_N ( ( t, expl ) )
 - 
 
491 
    PROTO_T ( TYPE t X int expl )
 553 
check_throw(TYPE t, int expl)
492 
{
 554 
{
493 
    IDENTIFIER fn ;
 555 
	IDENTIFIER fn;
494 
    LIST ( EXP ) p = LIST_stack ( crt_try_blocks ) ;
 556 
	LIST(EXP) p = LIST_stack(crt_try_blocks);
495 
    while ( !IS_NULL_list ( p ) ) {
 557 
	while (!IS_NULL_list(p)) {
496 
	EXP e = DEREF_exp ( HEAD_list ( p ) ) ;
 558 
		EXP e = DEREF_exp(HEAD_list(p));
497 
	if ( IS_exp_try_block ( e ) ) {
 559 
		if (IS_exp_try_block(e)) {
498 
	    /* Add to list of thrown types */
 560 
			/* Add to list of thrown types */
499 
	    LIST ( TYPE ) q ;
 561 
			LIST(TYPE)q;
500 
	    q = DEREF_list ( exp_try_block_ttypes ( e ) ) ;
 562 
			q = DEREF_list(exp_try_block_ttypes(e));
501 
	    if ( !EQ_list ( q, univ_type_set ) ) {
 563 
			if (!EQ_list(q, univ_type_set)) {
502 
		LIST ( LOCATION ) ql ;
 564 
				LIST(LOCATION)ql;
503 
		ql = DEREF_list ( exp_try_block_tlocs ( e ) ) ;
 565 
				ql = DEREF_list(exp_try_block_tlocs(e));
504 
		if ( IS_NULL_type ( t ) ) {
 566 
				if (IS_NULL_type(t)) {
505 
		    DESTROY_list ( q, SIZE_type ) ;
 567 
					DESTROY_list(q, SIZE_type);
506 
		    DESTROY_list ( ql, SIZE_loc ) ;
 568 
					DESTROY_list(ql, SIZE_loc);
507 
		    q = univ_type_set ;
 569 
					q = univ_type_set;
508 
		    ql = NULL_list ( LOCATION ) ;
 570 
					ql = NULL_list(LOCATION);
509 
		    CONS_loc ( crt_loc, ql, ql ) ;
 571 
					CONS_loc(crt_loc, ql, ql);
510 
		} else {
 572 
				} else {
511 
		    if ( !in_type_set ( q, t ) ) {
 573 
					if (!in_type_set(q, t)) {
512 
			CONS_type ( t, q, q ) ;
 574 
						CONS_type(t, q, q);
513 
			CONS_loc ( crt_loc, ql, ql ) ;
 575 
						CONS_loc(crt_loc, ql, ql);
514 
		    }
 576 
					}
515 
		}
 577 
				}
516 
		COPY_list ( exp_try_block_ttypes ( e ), q ) ;
 578 
				COPY_list(exp_try_block_ttypes(e), q);
517 
		COPY_list ( exp_try_block_tlocs ( e ), ql ) ;
 579 
				COPY_list(exp_try_block_tlocs(e), ql);
518 
	    }
 580 
			}
519 
	    return ( 1 ) ;
 581 
			return (1);
520 
	}
 582 
		}
521 
	if ( IS_NULL_type ( t ) && expl && IS_exp_handler ( e ) ) {
 583 
		if (IS_NULL_type(t) && expl && IS_exp_handler(e)) {
522 
	    /* Can deduce type of 'throw' inside a handler */
 584 
			/* Can deduce type of 'throw' inside a handler */
523 
	    IDENTIFIER ex = DEREF_id ( exp_handler_except ( e ) ) ;
 585 
			IDENTIFIER ex = DEREF_id(exp_handler_except(e));
524 
	    if ( !IS_NULL_id ( ex ) ) {
 586 
			if (!IS_NULL_id(ex)) {
525 
		t = DEREF_type ( id_variable_etc_type ( ex ) ) ;
 587 
				t = DEREF_type(id_variable_etc_type(ex));
526 
		t = exception_type ( t, 0 ) ;
 588 
				t = exception_type(t, 0);
527 
	    }
 589 
			}
528 
	}
 590 
		}
529 
	p = TAIL_list ( p ) ;
 591 
		p = TAIL_list(p);
530 
    }
 592 
	}
531 
 
 593 
 
532 
    /* Exception not caught by any try block */
 594 
	/* Exception not caught by any try block */
533 
    fn = crt_func_id ;
 595 
	fn = crt_func_id;
534 
    if ( IS_NULL_type ( t ) ) t = type_any ;
 596 
	if (IS_NULL_type(t)) {
- 
 
 597 
		t = type_any;
- 
 
 598 
	}
535 
    if ( IS_NULL_id ( fn ) ) {
 599 
	if (IS_NULL_id(fn)) {
536 
	report ( crt_loc, ERR_except_spec_throw ( t ) ) ;
 600 
		report(crt_loc, ERR_except_spec_throw(t));
537 
    } else {
 601 
	} else {
538 
	report ( crt_loc, ERR_except_spec_call ( fn, t ) ) ;
 602 
		report(crt_loc, ERR_except_spec_call(fn, t));
539 
    }
 603 
	}
540 
    return ( 0 ) ;
 604 
	return (0);
541 
}
 605 
}
542 
 
 606 
 
543 
 
 607 
 
544 
/*
 608 
/*
545 
    CHECK THE EXCEPTIONS THROWN IN A TRY BLOCK
 609 
    CHECK THE EXCEPTIONS THROWN IN A TRY BLOCK
546 
 
 610 
 
547 
    This routine checks the exceptions thrown in the try block e.  Any
 611 
    This routine checks the exceptions thrown in the try block e.  Any
548 
    which are not caught by the handlers of e are passed to the enclosing
 612 
    which are not caught by the handlers of e are passed to the enclosing
549 
    block or reported if this is the outermost block.  The routine
 613 
    block or reported if this is the outermost block.  The routine
550 
    returns true if all the exceptions are handled by an enclosing block.
 614 
    returns true if all the exceptions are handled by an enclosing block.
551 
*/
 615 
*/
552 
 
 616 
 
553 
int check_try_block
 617 
int
554 
    PROTO_N ( ( e ) )
 - 
 
555 
    PROTO_T ( EXP e )
 618 
check_try_block(EXP e)
556 
{
 619 
{
557 
    int res = 1 ;
 620 
	int res = 1;
558 
    if ( IS_exp_try_block ( e ) ) {
 621 
	if (IS_exp_try_block(e)) {
559 
	LOCATION loc ;
 622 
		LOCATION loc;
560 
	LIST ( LOCATION ) ql ;
 623 
		LIST(LOCATION)ql;
561 
	LIST ( TYPE ) p = DEREF_list ( exp_try_block_htypes ( e ) ) ;
 624 
		LIST(TYPE)p = DEREF_list(exp_try_block_htypes(e));
562 
	LIST ( TYPE ) q = DEREF_list ( exp_try_block_ttypes ( e ) ) ;
 625 
		LIST(TYPE)q = DEREF_list(exp_try_block_ttypes(e));
563 
	EXP a = DEREF_exp ( exp_try_block_ellipsis ( e ) ) ;
 626 
		EXP a = DEREF_exp(exp_try_block_ellipsis(e));
564 
	if ( EQ_list ( p, univ_type_set ) ) {
 627 
		if (EQ_list(p, univ_type_set)) {
565 
	    /* Have handlers for any type */
 628 
			/* Have handlers for any type */
566 
	    return ( 1 ) ;
 629 
			return (1);
567 
	}
 630 
		}
568 
	if ( !IS_NULL_exp ( a ) && IS_exp_handler ( a ) ) {
 631 
		if (!IS_NULL_exp(a) && IS_exp_handler(a)) {
569 
	    /* Have a ... handler */
 632 
			/* Have a ... handler */
570 
	    return ( 1 ) ;
 633 
			return (1);
571 
	}
 - 
 
572 
	bad_crt_loc++ ;
 - 
 
573 
	loc = crt_loc ;
 - 
 
574 
	ql = DEREF_list ( exp_try_block_tlocs ( e ) ) ;
 - 
 
575 
	if ( EQ_list ( q, univ_type_set ) ) {
 - 
 
576 
	    /* Can throw any type */
 - 
 
577 
	    DEREF_loc ( HEAD_list ( ql ), crt_loc ) ;
 - 
 
578 
	    res = check_throw ( NULL_type, 0 ) ;
 - 
 
579 
	} else {
 - 
 
580 
	    /* Can throw a finite set of types */
 - 
 
581 
	    q = REVERSE_list ( q ) ;
 - 
 
582 
	    ql = REVERSE_list ( ql ) ;
 - 
 
583 
	    COPY_list ( exp_try_block_ttypes ( e ), q ) ;
 - 
 
584 
	    COPY_list ( exp_try_block_tlocs ( e ), ql ) ;
 - 
 
585 
	    while ( !IS_NULL_list ( q ) ) {
 - 
 
586 
		TYPE t = DEREF_type ( HEAD_list ( q ) ) ;
 - 
 
587 
		TYPE u = from_type_set ( p, t ) ;
 - 
 
588 
		if ( IS_NULL_type ( u ) ) {
 - 
 
589 
		    /* Throw uncaught type to enclosing block */
 - 
 
590 
		    DEREF_loc ( HEAD_list ( ql ), crt_loc ) ;
 - 
 
591 
		    if ( !check_throw ( t, 0 ) ) res = 0 ;
 - 
 
592 
		}
 634 
		}
- 
 
 635 
		bad_crt_loc++;
- 
 
 636 
		loc = crt_loc;
- 
 
 637 
		ql = DEREF_list(exp_try_block_tlocs(e));
- 
 
 638 
		if (EQ_list(q, univ_type_set)) {
- 
 
 639 
			/* Can throw any type */
- 
 
 640 
			DEREF_loc(HEAD_list(ql), crt_loc);
- 
 
 641 
			res = check_throw(NULL_type, 0);
- 
 
 642 
		} else {
- 
 
 643 
			/* Can throw a finite set of types */
- 
 
 644 
			q = REVERSE_list(q);
- 
 
 645 
			ql = REVERSE_list(ql);
- 
 
 646 
			COPY_list(exp_try_block_ttypes(e), q);
- 
 
 647 
			COPY_list(exp_try_block_tlocs(e), ql);
- 
 
 648 
			while (!IS_NULL_list(q)) {
- 
 
 649 
				TYPE t = DEREF_type(HEAD_list(q));
- 
 
 650 
				TYPE u = from_type_set(p, t);
- 
 
 651 
				if (IS_NULL_type(u)) {
- 
 
 652 
					/* Throw uncaught type to enclosing
- 
 
 653 
					 * block */
- 
 
 654 
					DEREF_loc(HEAD_list(ql), crt_loc);
- 
 
 655 
					if (!check_throw(t, 0)) {
- 
 
 656 
						res = 0;
- 
 
 657 
					}
- 
 
 658 
				}
593 
		ql = TAIL_list ( ql ) ;
 659 
				ql = TAIL_list(ql);
594 
		q = TAIL_list ( q ) ;
 660 
				q = TAIL_list(q);
595 
	    }
 661 
			}
596 
	}
 662 
		}
597 
	crt_loc = loc ;
 663 
		crt_loc = loc;
598 
	bad_crt_loc-- ;
 664 
		bad_crt_loc--;
599 
    }
 665 
	}
600 
    return ( res ) ;
 666 
	return (res);
601 
}
 667 
}
602 
 
 668 
 
603 
 
 669 
 
604 
/*
 670 
/*
605 
    CHECK THE EXCEPTIONS THROWN BY A FUNCTION CALL
 671 
    CHECK THE EXCEPTIONS THROWN BY A FUNCTION CALL
606 
 
 672 
 
607 
    This routine checks the possible exceptions thrown by a call to a
 673 
    This routine checks the possible exceptions thrown by a call to a
608 
    function of type fn.  When known the function name is given by fid.
 674 
    function of type fn.  When known the function name is given by fid.
609 
    The routine returns true if the exception is handled by an enclosing
 675 
    The routine returns true if the exception is handled by an enclosing
610 
    try-block.
 676 
    try-block.
611 
*/
 677 
*/
612 
 
 678 
 
613 
int check_func_throw
 679 
int
614 
    PROTO_N ( ( fn, fid ) )
 - 
 
615 
    PROTO_T ( TYPE fn X IDENTIFIER fid )
 680 
check_func_throw(TYPE fn, IDENTIFIER fid)
616 
{
 681 
{
617 
    int res = 1 ;
 682 
	int res = 1;
618 
    if ( IS_type_func ( fn ) ) {
 683 
	if (IS_type_func(fn)) {
619 
	LIST ( TYPE ) p = DEREF_list ( type_func_except ( fn ) ) ;
 684 
		LIST(TYPE)p = DEREF_list(type_func_except(fn));
620 
	if ( IS_NULL_list ( p ) ) return ( 1 ) ;
 685 
		if (IS_NULL_list(p)) {
- 
 
 686 
			return (1);
- 
 
 687 
		}
621 
	if ( EQ_list ( p, univ_type_set ) ) {
 688 
		if (EQ_list(p, univ_type_set)) {
622 
	    /* Can throw any type */
 689 
			/* Can throw any type */
623 
	    res = check_throw ( NULL_type, 0 ) ;
 690 
			res = check_throw(NULL_type, 0);
624 
	} else {
 691 
		} else {
625 
	    /* Can throw a finite set of types */
 692 
			/* Can throw a finite set of types */
626 
	    while ( !IS_NULL_list ( p ) ) {
 693 
			while (!IS_NULL_list(p)) {
627 
		TYPE t = DEREF_type ( HEAD_list ( p ) ) ;
 694 
				TYPE t = DEREF_type(HEAD_list(p));
628 
		if ( !IS_NULL_type ( t ) ) {
 695 
				if (!IS_NULL_type(t)) {
629 
		    if ( !check_throw ( t, 0 ) ) res = 0 ;
 696 
					if (!check_throw(t, 0)) {
- 
 
 697 
						res = 0;
- 
 
 698 
					}
630 
		}
 699 
				}
631 
		p = TAIL_list ( p ) ;
 700 
				p = TAIL_list(p);
632 
	    }
 701 
			}
633 
	}
 702 
		}
634 
    } else {
 703 
	} else {
635 
	res = check_throw ( NULL_type, 0 ) ;
 704 
		res = check_throw(NULL_type, 0);
636 
    }
 705 
	}
637 
    UNUSED ( fid ) ;
 706 
	UNUSED(fid);
638 
    return ( res ) ;
 707 
	return (res);
639 
}
 708 
}
640 
 
 709 
 
641 
 
 710 
 
642 
/*
 711 
/*
643 
    START THE EXCEPTION CHECKS FOR A FUNCTION DEFINITION
 712 
    START THE EXCEPTION CHECKS FOR A FUNCTION DEFINITION
644 
 
 713 
 
645 
    This routine starts the exception specification checks for a function
 714 
    This routine starts the exception specification checks for a function
646 
    which throws the types p.
 715 
    which throws the types p.
647 
*/
 716 
*/
648 
 
 717 
 
649 
void start_try_check
 718 
void
650 
    PROTO_N ( ( p ) )
 - 
 
651 
    PROTO_T ( LIST ( TYPE ) p )
 719 
start_try_check(LIST(TYPE) p)
652 
{
 720 
{
653 
    EXP e ;
 721 
	EXP e;
654 
    MAKE_exp_try_block ( type_void, NULL_exp, 0, e ) ;
 722 
	MAKE_exp_try_block(type_void, NULL_exp, 0, e);
655 
    COPY_list ( exp_try_block_htypes ( e ), p ) ;
 723 
	COPY_list(exp_try_block_htypes(e), p);
656 
    PUSH_stack ( crt_try_blocks, past_try_blocks ) ;
 724 
	PUSH_stack(crt_try_blocks, past_try_blocks);
657 
    crt_try_blocks = NULL_stack ( EXP ) ;
 725 
	crt_try_blocks = NULL_stack(EXP);
658 
    PUSH_exp ( e, crt_try_blocks ) ;
 726 
	PUSH_exp(e, crt_try_blocks);
659 
    return ;
 727 
	return;
660 
}
 728 
}
661 
 
 729 
 
662 
 
 730 
 
663 
/*
 731 
/*
664 
    END THE EXCEPTION CHECKS FOR A FUNCTION DEFINITION
 732 
    END THE EXCEPTION CHECKS FOR A FUNCTION DEFINITION
665 
 
 733 
 
666 
    This routine ends the exception specification checks for the function
 734 
    This routine ends the exception specification checks for the function
667 
    id with definition a.
 735 
    id with definition a.
668 
*/
 736 
*/
669 
 
 737 
 
670 
EXP end_try_check
 738 
EXP
671 
    PROTO_N ( ( id, a ) )
 - 
 
672 
    PROTO_T ( IDENTIFIER id X EXP a )
 739 
end_try_check(IDENTIFIER id, EXP a)
673 
{
 740 
{
674 
    EXP e ;
 741 
	EXP e;
675 
    POP_exp ( e, crt_try_blocks ) ;
 742 
	POP_exp(e, crt_try_blocks);
676 
    POP_stack ( crt_try_blocks, past_try_blocks ) ;
 743 
	POP_stack(crt_try_blocks, past_try_blocks);
677 
    if ( !IS_NULL_exp ( e ) && IS_exp_try_block ( e ) ) {
 744 
	if (!IS_NULL_exp(e) && IS_exp_try_block(e)) {
678 
	IDENTIFIER fid = crt_func_id ;
 745 
		IDENTIFIER fid = crt_func_id;
679 
	crt_func_id = id ;
 746 
		crt_func_id = id;
680 
	IGNORE check_try_block ( e ) ;
 747 
		IGNORE check_try_block(e);
681 
	if ( EQ_id ( fid, id ) ) {
 748 
		if (EQ_id(fid, id)) {
682 
	    LIST ( TYPE ) p = DEREF_list ( exp_try_block_ttypes ( e ) ) ;
 749 
			LIST(TYPE)p = DEREF_list(exp_try_block_ttypes(e));
683 
	    if ( IS_NULL_list ( p ) && !in_template_decl ) {
 750 
			if (IS_NULL_list(p) && !in_template_decl) {
684 
		/* Function can't throw an exception */
 751 
				/* Function can't throw an exception */
685 
		DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
 752 
				DECL_SPEC ds = DEREF_dspec(id_storage(id));
686 
		ds |= dspec_friend ;
 753 
				ds |= dspec_friend;
687 
		COPY_dspec ( id_storage ( id ), ds ) ;
 754 
				COPY_dspec(id_storage(id), ds);
688 
	    }
 755 
			}
- 
 
 756 
		}
- 
 
 757 
		COPY_list(exp_try_block_htypes(e), NULL_list(TYPE));
- 
 
 758 
		free_exp(e, 1);
- 
 
 759 
		crt_func_id = fid;
689 
	}
 760 
	}
690 
	COPY_list ( exp_try_block_htypes ( e ), NULL_list ( TYPE ) ) ;
 - 
 
691 
	free_exp ( e, 1 ) ;
 - 
 
692 
	crt_func_id = fid ;
 - 
 
693 
    }
 - 
 
694 
    return ( a ) ;
 761 
	return (a);
695 
}
 762 
}
696 
 
 763 
 
697 
 
 764 
 
698 
/*
 765 
/*
699 
    EXCEPTION HANDLING ROUTINES
 766 
    EXCEPTION HANDLING ROUTINES
700 
 
 767 
 
701 
    The exception handling routines are only included in the C++ producer.
 768 
    The exception handling routines are only included in the C++ producer.
702 
*/
 769 
*/
703 
 
 770 
 
704 
#if LANGUAGE_CPP
 771 
#if LANGUAGE_CPP
705 
 
 772 
 
Line 709... Line 776...
709 
 
 776 
 
710 
    This routine begins the construction of the statement 'try { body }
 777 
    This routine begins the construction of the statement 'try { body }
711 
    handlers'.  It is called immediately after the 'try'.  func is true
 778 
    handlers'.  It is called immediately after the 'try'.  func is true
712 
    for a function-try-block.
 779 
    for a function-try-block.
713 
*/
 780 
*/
714 
 
 781 
 
715 
EXP begin_try_stmt
 782 
EXP
716 
    PROTO_N ( ( func ) )
 - 
 
717 
    PROTO_T ( int func )
 783 
begin_try_stmt(int func)
718 
{
 784 
{
719 
    EXP e ;
 785 
	EXP e;
720 
    if ( func ) {
 786 
	if (func) {
721 
	/* Check function try blocks */
 787 
		/* Check function try blocks */
722 
	IDENTIFIER fn = crt_func_id ;
 788 
		IDENTIFIER fn = crt_func_id;
723 
	if ( !IS_NULL_id ( fn ) ) {
 789 
		if (!IS_NULL_id(fn)) {
724 
	    HASHID nm = DEREF_hashid ( id_name ( fn ) ) ;
 790 
			HASHID nm = DEREF_hashid(id_name(fn));
725 
	    unsigned tag = TAG_hashid ( nm ) ;
 791 
			unsigned tag = TAG_hashid(nm);
726 
	    if ( tag == hashid_constr_tag || tag == hashid_destr_tag ) {
 792 
			if (tag == hashid_constr_tag ||
- 
 
 793 
			    tag == hashid_destr_tag) {
727 
		/* Constructors and destructors are marked */
 794 
				/* Constructors and destructors are marked */
728 
		func = 2 ;
 795 
				func = 2;
729 
	    }
 796 
			}
730 
	} else {
 797 
		} else {
731 
	    func = 0 ;
 798 
			func = 0;
- 
 
 799 
		}
732 
	}
 800 
	}
733 
    }
 - 
 
734 
    MAKE_exp_try_block ( type_void, NULL_exp, func, e ) ;
 801 
	MAKE_exp_try_block(type_void, NULL_exp, func, e);
735 
    CONS_exp ( e, all_try_blocks, all_try_blocks ) ;
 802 
	CONS_exp(e, all_try_blocks, all_try_blocks);
736 
    PUSH_exp ( e, crt_try_blocks ) ;
 803 
	PUSH_exp(e, crt_try_blocks);
737 
    return ( e ) ;
 804 
	return (e);
738 
}
 805 
}
739 
 
 806 
 
740 
 
 807 
 
741 
/*
 808 
/*
742 
    INJECT FUNCTION PARAMETERS INTO A HANDLER
 809 
    INJECT FUNCTION PARAMETERS INTO A HANDLER
743 
 
 810 
 
744 
    It is not allowed to redeclare a function parameter in the body or
 811 
    It is not allowed to redeclare a function parameter in the body or
745 
    the handler of a function-try-block.  This routine ensures this by
 812 
    the handler of a function-try-block.  This routine ensures this by
746 
    injecting the function parameters into the current scope when prev
 813 
    injecting the function parameters into the current scope when prev
747 
    is a function-try-block.
 814 
    is a function-try-block.
748 
*/
 815 
*/
749 
 
 816 
 
750 
void inject_try_stmt
 817 
void
751 
    PROTO_N ( ( prev ) )
 - 
 
752 
    PROTO_T ( EXP prev )
 818 
inject_try_stmt(EXP prev)
753 
{
 819 
{
754 
    int func = DEREF_int ( exp_try_block_func ( prev ) ) ;
 820 
	int func = DEREF_int(exp_try_block_func(prev));
755 
    if ( func ) {
 821 
	if (func) {
756 
	IDENTIFIER id = crt_func_id ;
 822 
		IDENTIFIER id = crt_func_id;
757 
	if ( !IS_NULL_id ( id ) && IS_id_function_etc ( id ) ) {
 823 
		if (!IS_NULL_id(id) && IS_id_function_etc(id)) {
758 
	    LIST ( IDENTIFIER ) pids ;
 824 
			LIST(IDENTIFIER)pids;
759 
	    NAMESPACE ns = crt_namespace ;
 825 
			NAMESPACE ns = crt_namespace;
760 
	    TYPE t = DEREF_type ( id_function_etc_type ( id ) ) ;
 826 
			TYPE t = DEREF_type(id_function_etc_type(id));
761 
	    while ( IS_type_templ ( t ) ) {
 827 
			while (IS_type_templ(t)) {
762 
		t = DEREF_type ( type_templ_defn ( t ) ) ;
 828 
				t = DEREF_type(type_templ_defn(t));
763 
	    }
 829 
			}
764 
	    pids = DEREF_list ( type_func_pids ( t ) ) ;
 830 
			pids = DEREF_list(type_func_pids(t));
765 
	    while ( !IS_NULL_list ( pids ) ) {
 831 
			while (!IS_NULL_list(pids)) {
766 
		IDENTIFIER pid = DEREF_id ( HEAD_list ( pids ) ) ;
 832 
				IDENTIFIER pid = DEREF_id(HEAD_list(pids));
767 
		IGNORE redeclare_id ( ns, pid ) ;
 833 
				IGNORE redeclare_id(ns, pid);
768 
		pids = TAIL_list ( pids ) ;
 834 
				pids = TAIL_list(pids);
769 
	    }
 835 
			}
770 
	}
 836 
		}
771 
    }
 837 
	}
772 
    return ;
 838 
	return;
773 
}
 839 
}
774 
 
 840 
 
775 
 
 841 
 
776 
/*
 842 
/*
777 
    CONTINUE THE CONSTRUCTION OF A TRY STATEMENT
 843 
    CONTINUE THE CONSTRUCTION OF A TRY STATEMENT
778 
 
 844 
 
779 
    This routine continues the contruction of the try statement prev by
 845 
    This routine continues the contruction of the try statement prev by
780 
    filling in the given body statement.
 846 
    filling in the given body statement.
781 
*/
 847 
*/
782 
 
 848 
 
783 
EXP cont_try_stmt
 849 
EXP
784 
    PROTO_N ( ( prev, body ) )
 - 
 
785 
    PROTO_T ( EXP prev X EXP body )
 850 
cont_try_stmt(EXP prev, EXP body)
786 
{
 851 
{
787 
    EXP e ;
 852 
	EXP e;
788 
    int func = DEREF_int ( exp_try_block_func ( prev ) ) ;
 853 
	int func = DEREF_int(exp_try_block_func(prev));
- 
 
 854 
	if (func) {
789 
    if ( func ) in_func_handler = func ;
 855 
		in_func_handler = func;
- 
 
 856 
	}
790 
    COPY_exp ( exp_try_block_body ( prev ), body ) ;
 857 
	COPY_exp(exp_try_block_body(prev), body);
791 
    set_parent_stmt ( body, prev ) ;
 858 
	set_parent_stmt(body, prev);
792 
    POP_exp ( e, crt_try_blocks ) ;
 859 
	POP_exp(e, crt_try_blocks);
793 
    UNUSED ( e ) ;
 860 
	UNUSED(e);
794 
    return ( prev ) ;
 861 
	return (prev);
795 
}
 862 
}
796 
 
 863 
 
797 
 
 864 
 
798 
/*
 865 
/*
799 
    COMPLETE THE CONSTRUCTION OF A TRY STATEMENT
 866 
    COMPLETE THE CONSTRUCTION OF A TRY STATEMENT
800 
 
 867 
 
801 
    This routine completes the contruction of the try statement prev.  It
 868 
    This routine completes the contruction of the try statement prev.  It
802 
    checks whether it contains at least one handler and determines the
 869 
    checks whether it contains at least one handler and determines the
803 
    reachability of the following statement.
 870 
    reachability of the following statement.
804 
*/
 871 
*/
805 
 
 872 
 
806 
EXP end_try_stmt
 873 
EXP
807 
    PROTO_N ( ( prev, empty ) )
 - 
 
808 
    PROTO_T ( EXP prev X int empty )
 874 
end_try_stmt(EXP prev, int empty)
809 
{
 875 
{
810 
    EXP e ;
 876 
	EXP e;
811 
    TYPE t ;
 877 
	TYPE t;
812 
    int all_bottom = 1 ;
 878 
	int all_bottom = 1;
813 
    int func = DEREF_int ( exp_try_block_func ( prev ) ) ;
 879 
	int func = DEREF_int(exp_try_block_func(prev));
814 
 
 880 
 
815 
    /* Check handler list */
 881 
	/* Check handler list */
816 
    EXP ell = DEREF_exp ( exp_try_block_ellipsis ( prev ) ) ;
 882 
	EXP ell = DEREF_exp(exp_try_block_ellipsis(prev));
817 
    LIST ( EXP ) hs = DEREF_list ( exp_try_block_handlers ( prev ) ) ;
 883 
	LIST(EXP)hs = DEREF_list(exp_try_block_handlers(prev));
818 
    LIST ( TYPE ) ps = DEREF_list ( exp_try_block_ttypes ( prev ) ) ;
 884 
	LIST(TYPE)ps = DEREF_list(exp_try_block_ttypes(prev));
819 
    unsigned nh = LENGTH_list ( hs ) ;
 885 
	unsigned nh = LENGTH_list(hs);
820 
    if ( IS_NULL_exp ( ell ) ) {
 886 
	if (IS_NULL_exp(ell)) {
821 
	/* Create default handler if necessary */
 887 
		/* Create default handler if necessary */
822 
	if ( IS_NULL_list ( hs ) && !empty ) {
 888 
		if (IS_NULL_list(hs) && !empty) {
823 
	    /* Check that there is at least one handler */
 889 
			/* Check that there is at least one handler */
824 
	    report ( crt_loc, ERR_except_handlers () ) ;
 890 
			report(crt_loc, ERR_except_handlers());
825 
	}
 891 
		}
826 
	MAKE_exp_exception ( type_bottom, ell, NULL_exp, NULL_exp, 0, ell ) ;
 892 
		MAKE_exp_exception(type_bottom, ell, NULL_exp, NULL_exp, 0,
- 
 
 893 
				   ell);
827 
	COPY_exp ( exp_try_block_ellipsis ( prev ), ell ) ;
 894 
		COPY_exp(exp_try_block_ellipsis(prev), ell);
828 
    } else {
 895 
	} else {
829 
	nh++ ;
 896 
		nh++;
830 
    }
 897 
	}
831 
    IGNORE check_value ( OPT_VAL_exception_handlers, ( ulong ) nh ) ;
 898 
	IGNORE check_value(OPT_VAL_exception_handlers,(ulong)nh);
832 
 
 899 
 
833 
    /* Do unreached code analysis */
 900 
	/* Do unreached code analysis */
834 
    e = DEREF_exp ( exp_try_block_body ( prev ) ) ;
 901 
	e = DEREF_exp(exp_try_block_body(prev));
835 
    t = DEREF_type ( exp_type ( e ) ) ;
 902 
	t = DEREF_type(exp_type(e));
836 
    if ( IS_type_bottom ( t ) ) {
 903 
	if (IS_type_bottom(t)) {
837 
	/* Don't reach end of try block */
 904 
		/* Don't reach end of try block */
838 
	t = DEREF_type ( exp_type ( ell ) ) ;
 905 
		t = DEREF_type(exp_type(ell));
839 
	if ( !IS_type_bottom ( t ) ) all_bottom = 0 ;
 906 
		if (!IS_type_bottom(t)) {
- 
 
 907 
			all_bottom = 0;
- 
 
 908 
		}
840 
	while ( !IS_NULL_list ( hs ) && all_bottom ) {
 909 
		while (!IS_NULL_list(hs) && all_bottom) {
841 
	    /* Check the other handlers */
 910 
			/* Check the other handlers */
842 
	    e = DEREF_exp ( HEAD_list ( hs ) ) ;
 911 
			e = DEREF_exp(HEAD_list(hs));
843 
	    t = DEREF_type ( exp_type ( e ) ) ;
 912 
			t = DEREF_type(exp_type(e));
844 
	    if ( !IS_type_bottom ( t ) ) all_bottom = 0 ;
 913 
			if (!IS_type_bottom(t)) {
- 
 
 914 
				all_bottom = 0;
- 
 
 915 
			}
845 
	    hs = TAIL_list ( hs ) ;
 916 
			hs = TAIL_list(hs);
- 
 
 917 
		}
- 
 
 918 
	} else {
- 
 
 919 
		/* Reach end of try block */
- 
 
 920 
		all_bottom = 0;
- 
 
 921 
	}
- 
 
 922 
	if (all_bottom) {
- 
 
 923 
		COPY_type(exp_type(prev), type_bottom);
- 
 
 924 
		unreached_code = 1;
- 
 
 925 
		unreached_last = 0;
- 
 
 926 
	} else {
- 
 
 927 
		unreached_code = unreached_prev;
- 
 
 928 
	}
- 
 
 929 
	if (IS_NULL_list(ps) && !empty && !in_template_decl) {
- 
 
 930 
		report(crt_loc, ERR_except_not());
- 
 
 931 
	}
- 
 
 932 
	if (func) {
- 
 
 933 
		in_func_handler = 0;
846 
	}
 934 
	}
847 
    } else {
 - 
 
848 
	/* Reach end of try block */
 - 
 
849 
	all_bottom = 0 ;
 - 
 
850 
    }
 - 
 
851 
    if ( all_bottom ) {
 - 
 
852 
	COPY_type ( exp_type ( prev ), type_bottom ) ;
 - 
 
853 
	unreached_code = 1 ;
 - 
 
854 
	unreached_last = 0 ;
 - 
 
855 
    } else {
 - 
 
856 
	unreached_code = unreached_prev ;
 - 
 
857 
    }
 - 
 
858 
    if ( IS_NULL_list ( ps ) && !empty && !in_template_decl ) {
 - 
 
859 
	report ( crt_loc, ERR_except_not () ) ;
 - 
 
860 
    }
 - 
 
861 
    if ( func ) in_func_handler = 0 ;
 - 
 
862 
    IGNORE check_try_block ( prev ) ;
 935 
	IGNORE check_try_block(prev);
863 
    return ( prev ) ;
 936 
	return (prev);
864 
}
 937 
}
865 
 
 938 
 
866 
 
 939 
 
867 
/*
 940 
/*
868 
    MARK ALL VARIABLES ENCLOSING A TRY BLOCK
 941 
    MARK ALL VARIABLES ENCLOSING A TRY BLOCK
869 
 
 942 
 
870 
    This routine marks all the local variables of the function id which
 943 
    This routine marks all the local variables of the function id which
871 
    contain a try block within their scope.
 944 
    contain a try block within their scope.
872 
*/
 945 
*/
873 
 
 946 
 
874 
void end_try_blocks
 947 
void
875 
    PROTO_N ( ( id ) )
 - 
 
876 
    PROTO_T ( IDENTIFIER id )
 948 
end_try_blocks(IDENTIFIER id)
877 
{
 949 
{
878 
    LIST ( EXP ) p = all_try_blocks ;
 950 
	LIST(EXP)p = all_try_blocks;
879 
    if ( !IS_NULL_list ( p ) ) {
 951 
	if (!IS_NULL_list(p)) {
880 
	if ( !IS_NULL_id ( id ) ) {
 952 
		if (!IS_NULL_id(id)) {
881 
	    /* Mark function */
 953 
			/* Mark function */
882 
	    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
 954 
			DECL_SPEC ds = DEREF_dspec(id_storage(id));
883 
	    ds |= dspec_mutable ;
 955 
			ds |= dspec_mutable;
884 
	    COPY_dspec ( id_storage ( id ), ds ) ;
 956 
			COPY_dspec(id_storage(id), ds);
885 
	}
 957 
		}
886 
	while ( !IS_NULL_list ( p ) ) {
 958 
		while (!IS_NULL_list(p)) {
887 
	    EXP a = DEREF_exp ( HEAD_list ( p ) ) ;
 959 
			EXP a = DEREF_exp(HEAD_list(p));
888 
	    while ( !IS_NULL_exp ( a ) ) {
 960 
			while (!IS_NULL_exp(a)) {
889 
		if ( IS_exp_decl_stmt ( a ) ) {
 961 
				if (IS_exp_decl_stmt(a)) {
- 
 
 962 
					IDENTIFIER pid =
890 
		    IDENTIFIER pid = DEREF_id ( exp_decl_stmt_id ( a ) ) ;
 963 
					    DEREF_id(exp_decl_stmt_id(a));
- 
 
 964 
					DECL_SPEC ds =
891 
		    DECL_SPEC ds = DEREF_dspec ( id_storage ( pid ) ) ;
 965 
					    DEREF_dspec(id_storage(pid));
892 
		    if ( ds & dspec_auto ) {
 966 
					if (ds & dspec_auto) {
893 
			/* Mark local variable */
 967 
						/* Mark local variable */
894 
			ds |= dspec_mutable ;
 968 
						ds |= dspec_mutable;
895 
			COPY_dspec ( id_storage ( pid ), ds ) ;
 969 
						COPY_dspec(id_storage(pid), ds);
896 
		    }
 970 
					}
- 
 
 971 
				}
- 
 
 972 
				a = get_parent_stmt(a);
- 
 
 973 
			}
- 
 
 974 
			p = TAIL_list(p);
897 
		}
 975 
		}
898 
		a = get_parent_stmt ( a ) ;
 - 
 
899 
	    }
 - 
 
900 
	    p = TAIL_list ( p ) ;
 - 
 
901 
	}
 976 
	}
902 
    }
 - 
 
903 
    return ;
 977 
	return;
904 
}
 978 
}
905 
 
 979 
 
906 
 
 980 
 
907 
/*
 981 
/*
908 
    DECLARE AN EXCEPTION HANDLER
 982 
    DECLARE AN EXCEPTION HANDLER
909 
 
 983 
 
910 
    This routine declares an exception handler named id with type t and
 984 
    This routine declares an exception handler named id with type t and
911 
    declaration specifiers ds (which should always be empty).  n gives
 985 
    declaration specifiers ds (which should always be empty).  n gives
912 
    the number of types defined in t.
 986 
    the number of types defined in t.
913 
*/
 987 
*/
914 
 
 988 
 
915 
IDENTIFIER make_except_decl
 989 
IDENTIFIER
916 
    PROTO_N ( ( ds, t, id, n ) )
 - 
 
917 
    PROTO_T ( DECL_SPEC ds X TYPE t X IDENTIFIER id X int n )
 990 
make_except_decl(DECL_SPEC ds, TYPE t, IDENTIFIER id, int n)
918 
{
 991 
{
919 
    /* Declare id as a local variable */
 992 
	/* Declare id as a local variable */
920 
    EXP e ;
 993 
	EXP e;
921 
    if ( crt_id_qualifier == qual_nested || crt_templ_qualifier ) {
 994 
	if (crt_id_qualifier == qual_nested || crt_templ_qualifier) {
922 
	/* Other illegal identifiers are caught elsewhere */
 995 
		/* Other illegal identifiers are caught elsewhere */
923 
	report ( crt_loc, ERR_dcl_meaning_id ( qual_nested, id ) ) ;
 996 
		report(crt_loc, ERR_dcl_meaning_id(qual_nested, id));
924 
    }
 997 
	}
- 
 
 998 
	if (n) {
925 
    if ( n ) report ( crt_loc, ERR_except_handle_typedef () ) ;
 999 
		report(crt_loc, ERR_except_handle_typedef());
- 
 
 1000 
	}
926 
    t = make_param_type ( t, CONTEXT_PARAMETER ) ;
 1001 
	t = make_param_type(t, CONTEXT_PARAMETER);
927 
    id = make_object_decl ( ds, t, id, 0 ) ;
 1002 
	id = make_object_decl(ds, t, id, 0);
928 
 
 1003 
 
929 
    /* The initialising value is the current exception */
 1004 
	/* The initialising value is the current exception */
930 
    if ( IS_type_ref ( t ) ) {
 1005 
	if (IS_type_ref(t)) {
931 
	t = DEREF_type ( type_ref_sub ( t ) ) ;
 1006 
		t = DEREF_type(type_ref_sub(t));
932 
    }
 1007 
	}
933 
    t = lvalue_type ( t ) ;
 1008 
	t = lvalue_type(t);
934 
    MAKE_exp_thrown ( t, 0, e ) ;
 1009 
	MAKE_exp_thrown(t, 0, e);
935 
    IGNORE init_object ( id, e ) ;
 1010 
	IGNORE init_object(id, e);
936 
    return ( id ) ;
 1011 
	return (id);
937 
}
 1012 
}
938 
 
 1013 
 
939 
 
 1014 
 
940 
/*
 1015 
/*
941 
    BEGIN THE CONSTRUCTION OF A CATCH STATEMENT
 1016 
    BEGIN THE CONSTRUCTION OF A CATCH STATEMENT
942 
 
 1017 
 
943 
    This routine begins the construction of the handler 'catch ( ex )
 1018 
    This routine begins the construction of the handler 'catch ( ex )
944 
    { body }' associated with the try block block.  It is called after the
 1019 
    { body }' associated with the try block block.  It is called after the
945 
    declaration of ex.  Note that ex can be the null identifier, indicating
 1020 
    declaration of ex.  Note that ex can be the null identifier, indicating
946 
    that the handler is '...'.
 1021 
    that the handler is '...'.
947 
*/
 1022 
*/
948 
 
 1023 
 
949 
EXP begin_catch_stmt
 1024 
EXP
950 
    PROTO_N ( ( block, ex ) )
 - 
 
951 
    PROTO_T ( EXP block X IDENTIFIER ex )
 1025 
begin_catch_stmt(EXP block, IDENTIFIER ex)
952 
{
 1026 
{
953 
    /* Construct the result */
 1027 
	/* Construct the result */
954 
    EXP e, d ;
 1028 
	EXP e, d;
955 
    MAKE_exp_handler ( type_void, ex, NULL_exp, e ) ;
 1029 
	MAKE_exp_handler(type_void, ex, NULL_exp, e);
956 
    COPY_exp ( exp_handler_parent ( e ), block ) ;
 1030 
	COPY_exp(exp_handler_parent(e), block);
957 
    unreached_code = 0 ;
 1031 
	unreached_code = 0;
958 
    unreached_last = 0 ;
 1032 
	unreached_last = 0;
959 
 
 1033 
 
960 
    /* Check for '...' handlers */
 1034 
	/* Check for '...' handlers */
961 
    d = DEREF_exp ( exp_try_block_ellipsis ( block ) ) ;
 1035 
	d = DEREF_exp(exp_try_block_ellipsis(block));
962 
    if ( !IS_NULL_exp ( d ) ) {
 1036 
	if (!IS_NULL_exp(d)) {
963 
	/* Already have a '...' handler */
 1037 
		/* Already have a '...' handler */
964 
	report ( crt_loc, ERR_except_handle_ellipsis () ) ;
 1038 
		report(crt_loc, ERR_except_handle_ellipsis());
965 
	unreached_code = 1 ;
 1039 
		unreached_code = 1;
966 
    } else if ( IS_NULL_id ( ex ) ) {
 1040 
	} else if (IS_NULL_id(ex)) {
967 
	/* Set the '...' handler if necessary */
 1041 
		/* Set the '...' handler if necessary */
968 
	COPY_exp ( exp_try_block_ellipsis ( block ), e ) ;
 1042 
		COPY_exp(exp_try_block_ellipsis(block), e);
969 
    } else {
 1043 
	} else {
970 
	/* Add to list of other handlers */
 1044 
		/* Add to list of other handlers */
971 
	TYPE t0 ;
 1045 
		TYPE t0;
972 
	TYPE t, s ;
 1046 
		TYPE t, s;
973 
	LIST ( EXP ) p, q ;
 1047 
		LIST(EXP) p, q;
974 
	LIST ( TYPE ) u, v ;
 1048 
		LIST(TYPE) u, v;
975 
 
 1049 
 
976 
	/* Check list of handler types */
 1050 
		/* Check list of handler types */
977 
	u = DEREF_list ( exp_try_block_htypes ( block ) ) ;
 1051 
		u = DEREF_list(exp_try_block_htypes(block));
978 
	t0 = DEREF_type ( id_variable_etc_type ( ex ) ) ;
 1052 
		t0 = DEREF_type(id_variable_etc_type(ex));
979 
	t = exception_type ( t0, 2 ) ;
 1053 
		t = exception_type(t0, 2);
980 
	s = from_type_set ( u, t ) ;
 1054 
		s = from_type_set(u, t);
981 
	if ( !IS_NULL_type ( s ) ) {
 1055 
		if (!IS_NULL_type(s)) {
982 
	    report ( crt_loc, ERR_except_handle_unreach ( t0, s ) ) ;
 1056 
			report(crt_loc, ERR_except_handle_unreach(t0, s));
983 
	    unreached_code = 1 ;
 1057 
			unreached_code = 1;
984 
	}
 1058 
		}
985 
	CONS_type ( t, NULL_list ( TYPE ), v ) ;
 1059 
		CONS_type(t, NULL_list(TYPE), v);
986 
	u = APPEND_list ( u, v ) ;
 1060 
		u = APPEND_list(u, v);
987 
	COPY_list ( exp_try_block_htypes ( block ), u ) ;
 1061 
		COPY_list(exp_try_block_htypes(block), u);
988 
 
 1062 
 
989 
	/* Add ex to list of handler expressions */
 1063 
		/* Add ex to list of handler expressions */
990 
	p = DEREF_list ( exp_try_block_handlers ( block ) ) ;
 1064 
		p = DEREF_list(exp_try_block_handlers(block));
991 
	CONS_exp ( e, NULL_list ( EXP ), q ) ;
 1065 
		CONS_exp(e, NULL_list(EXP), q);
992 
	p = APPEND_list ( p, q ) ;
 1066 
		p = APPEND_list(p, q);
993 
	COPY_list ( exp_try_block_handlers ( block ), p ) ;
 1067 
		COPY_list(exp_try_block_handlers(block), p);
994 
    }
 1068 
	}
995 
    PUSH_exp ( e, crt_try_blocks ) ;
 1069 
	PUSH_exp(e, crt_try_blocks);
996 
    return ( e ) ;
 1070 
	return (e);
997 
}
 1071 
}
998 
 
 1072 
 
999 
 
 1073 
 
1000 
/*
 1074 
/*
1001 
    COMPLETE THE CONSTRUCTION OF A CATCH STATEMENT
 1075 
    COMPLETE THE CONSTRUCTION OF A CATCH STATEMENT
1002 
 
 1076 
 
1003 
    This routine completes the construction of the catch statement prev by
 1077 
    This routine completes the construction of the catch statement prev by
1004 
    filling in the given body statement.
 1078 
    filling in the given body statement.
1005 
*/
 1079 
*/
1006 
 
 1080 
 
1007 
EXP end_catch_stmt
 1081 
EXP
1008 
    PROTO_N ( ( prev, body ) )
 - 
 
1009 
    PROTO_T ( EXP prev X EXP body )
 1082 
end_catch_stmt(EXP prev, EXP body)
1010 
{
 1083 
{
1011 
    EXP e ;
 1084 
	EXP e;
1012 
    if ( unreached_code ) {
 1085 
	if (unreached_code) {
1013 
	/* Mark unreached statements */
 1086 
		/* Mark unreached statements */
1014 
	COPY_type ( exp_type ( prev ), type_bottom ) ;
 1087 
		COPY_type(exp_type(prev), type_bottom);
1015 
    } else {
 1088 
	} else {
1016 
	/* Control reaches end of handler */
 1089 
		/* Control reaches end of handler */
1017 
	int func ;
 1090 
		int func;
1018 
	e = DEREF_exp ( exp_handler_parent ( prev ) ) ;
 1091 
		e = DEREF_exp(exp_handler_parent(prev));
1019 
	func = DEREF_int ( exp_try_block_func ( e ) ) ;
 1092 
		func = DEREF_int(exp_try_block_func(e));
1020 
	if ( func == 2 ) {
 1093 
		if (func == 2) {
1021 
	    /* Re-throw current exception */
 1094 
			/* Re-throw current exception */
1022 
	    e = make_throw_exp ( NULL_exp, 0 ) ;
 1095 
			e = make_throw_exp(NULL_exp, 0);
1023 
	    body = add_compound_stmt ( body, e ) ;
 1096 
			body = add_compound_stmt(body, e);
1024 
	    COPY_type ( exp_type ( prev ), type_bottom ) ;
 1097 
			COPY_type(exp_type(prev), type_bottom);
- 
 
 1098 
		}
1025 
	}
 1099 
	}
1026 
    }
 - 
 
1027 
    COPY_exp ( exp_handler_body ( prev ), body ) ;
 1100 
	COPY_exp(exp_handler_body(prev), body);
1028 
    set_parent_stmt ( body, prev ) ;
 1101 
	set_parent_stmt(body, prev);
1029 
    POP_exp ( e, crt_try_blocks ) ;
 1102 
	POP_exp(e, crt_try_blocks);
1030 
    UNUSED ( e ) ;
 1103 
	UNUSED(e);
1031 
    return ( prev ) ;
 1104 
	return (prev);
1032 
}
 1105 
}
1033 
 
 1106 
 
1034 
 
 1107 
 
1035 
/*
 1108 
/*
1036 
    CONSTRUCT A THROW ARGUMENT FROM A TYPE
 1109 
    CONSTRUCT A THROW ARGUMENT FROM A TYPE
1037 
 
 1110 
 
1038 
    The syntax 'throw t' for a type t is exactly equivalent to 'throw t ()'.
 1111 
    The syntax 'throw t' for a type t is exactly equivalent to 'throw t ()'.
1039 
    This routine constructs the argument 't ()'.  n gives the number of types
 1112 
    This routine constructs the argument 't ()'.  n gives the number of types
1040 
    defined in t.
 1113 
    defined in t.
1041 
*/
 1114 
*/
1042 
 
 1115 
 
1043 
EXP make_throw_arg
 1116 
EXP
1044 
    PROTO_N ( ( t, n ) )
 - 
 
1045 
    PROTO_T ( TYPE t X int n )
 1117 
make_throw_arg(TYPE t, int n)
1046 
{
 1118 
{
1047 
    EXP e ;
 1119 
	EXP e;
1048 
    report ( crt_loc, ERR_except_throw_type () ) ;
 1120 
	report(crt_loc, ERR_except_throw_type());
- 
 
 1121 
	if (n) {
1049 
    if ( n ) report ( crt_loc, ERR_except_throw_typedef () ) ;
 1122 
		report(crt_loc, ERR_except_throw_typedef());
- 
 
 1123 
	}
1050 
    e = make_func_cast_exp ( t, NULL_list ( EXP ) ) ;
 1124 
	e = make_func_cast_exp(t, NULL_list(EXP));
1051 
    return ( e ) ;
 1125 
	return (e);
1052 
}
 1126 
}
1053 
 
 1127 
 
1054 
 
 1128 
 
1055 
/*
 1129 
/*
1056 
    CONSTRUCT A THROW EXPRESSION
 1130 
    CONSTRUCT A THROW EXPRESSION
Line 1058... Line 1132...
1058 
    This routine constructs the expressions 'throw a' and 'throw' (if a is
 1132 
    This routine constructs the expressions 'throw a' and 'throw' (if a is
1059 
    the null expression).  Note that a is assigned to a temporary variable
 1133 
    the null expression).  Note that a is assigned to a temporary variable
1060 
    of its own type.
 1134 
    of its own type.
1061 
*/
 1135 
*/
1062 
 
 1136 
 
1063 
EXP make_throw_exp
 1137 
EXP
1064 
    PROTO_N ( ( a, expl ) )
 - 
 
1065 
    PROTO_T ( EXP a X int expl )
 1138 
make_throw_exp(EXP a, int expl)
1066 
{
 1139 
{
1067 
    EXP e ;
 1140 
	EXP e;
1068 
    EXP b = NULL_exp ;
 1141 
	EXP b = NULL_exp;
1069 
    EXP d = NULL_exp ;
 1142 
	EXP d = NULL_exp;
1070 
    if ( !IS_NULL_exp ( a ) ) {
 1143 
	if (!IS_NULL_exp(a)) {
1071 
	/* Perform operand conversions on a */
 1144 
		/* Perform operand conversions on a */
1072 
	TYPE t ;
 1145 
		TYPE t;
1073 
	ERROR err ;
 1146 
		ERROR err;
1074 
	a = convert_reference ( a, REF_NORMAL ) ;
 1147 
		a = convert_reference(a, REF_NORMAL);
1075 
	t = DEREF_type ( exp_type ( a ) ) ;
 1148 
		t = DEREF_type(exp_type(a));
1076 
	if ( !IS_type_compound ( t ) ) {
 1149 
		if (!IS_type_compound(t)) {
1077 
	    a = convert_lvalue ( a ) ;
 1150 
			a = convert_lvalue(a);
1078 
	    t = DEREF_type ( exp_type ( a ) ) ;
 1151 
			t = DEREF_type(exp_type(a));
1079 
	}
 1152 
		}
1080 
	t = exception_type ( t, 1 ) ;
 1153 
		t = exception_type(t, 1);
1081 
	IGNORE check_throw ( t, 1 ) ;
 1154 
		IGNORE check_throw(t, 1);
1082 
	b = sizeof_exp ( t ) ;
 1155 
		b = sizeof_exp(t);
1083 
	err = check_complete ( t ) ;
 1156 
		err = check_complete(t);
1084 
	if ( IS_NULL_err ( err ) ) {
 1157 
		if (IS_NULL_err(err)) {
1085 
	    /* Exception is assigned to temporary variable */
 1158 
			/* Exception is assigned to temporary variable */
1086 
	    a = init_assign ( t, cv_none, a, &err ) ;
 1159 
			a = init_assign(t, cv_none, a, &err);
1087 
	    d = init_default ( t, &d, DEFAULT_DESTR, EXTRA_DESTR, &err ) ;
 1160 
			d = init_default(t, &d, DEFAULT_DESTR, EXTRA_DESTR,
- 
 
 1161 
					 &err);
- 
 
 1162 
			if (!IS_NULL_err(err)) {
1088 
	    if ( !IS_NULL_err ( err ) ) err = init_error ( err, 0 ) ;
 1163 
				err = init_error(err, 0);
- 
 
 1164 
			}
1089 
	}
 1165 
		}
1090 
	if ( !IS_NULL_err ( err ) ) {
 1166 
		if (!IS_NULL_err(err)) {
1091 
	    /* Report type errors */
 1167 
			/* Report type errors */
1092 
	    err = concat_error ( err, ERR_except_throw_copy () ) ;
 1168 
			err = concat_error(err, ERR_except_throw_copy());
1093 
	    report ( crt_loc, err ) ;
 1169 
			report(crt_loc, err);
- 
 
 1170 
		}
- 
 
 1171 
		a = check_return_exp(a, lex_throw);
- 
 
 1172 
	} else {
- 
 
 1173 
		/* Check thrown type */
- 
 
 1174 
		IGNORE check_throw(NULL_type, 1);
1094 
	}
 1175 
	}
1095 
	a = check_return_exp ( a, lex_throw ) ;
 - 
 
1096 
    } else {
 - 
 
1097 
	/* Check thrown type */
 - 
 
1098 
	IGNORE check_throw ( NULL_type, 1 ) ;
 - 
 
1099 
    }
 - 
 
1100 
    MAKE_exp_exception ( type_bottom, a, b, d, expl, e ) ;
 1176 
	MAKE_exp_exception(type_bottom, a, b, d, expl, e);
1101 
    return ( e ) ;
 1177 
	return (e);
1102 
}
 1178 
}
1103 
 
 1179 
 
1104 
 
 1180 
 
1105 
#endif
 1181 
#endif