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 56... Line 86...
56 
#include "tok.h"
 86 
#include "tok.h"
57 
#include "typeid.h"
 87 
#include "typeid.h"
58 
#include "ustring.h"
 88 
#include "ustring.h"
59 
#if TDF_OUTPUT
 89 
#if TDF_OUTPUT
60 
 
 90 
 
61 
 
 91 
 
62 
/*
 92 
/*
63 
    ENCODE THE ADDRESS OF A DESTRUCTOR
 93 
    ENCODE THE ADDRESS OF A DESTRUCTOR
64 
 
 94 
 
65 
    This routine adds the address of the destructor function corresponding
 95 
    This routine adds the address of the destructor function corresponding
66 
    to d to the bitstream bs.
 96 
    to d to the bitstream bs.
67 
*/
 97 
*/
68 
 
 98 
 
69 
BITSTREAM *enc_destr_func
 99 
BITSTREAM *
70 
    PROTO_N ( ( bs, d ) )
 - 
 
71 
    PROTO_T ( BITSTREAM *bs X EXP d )
 100 
enc_destr_func(BITSTREAM *bs, EXP d)
72 
{
 101 
{
73 
    if ( !IS_NULL_exp ( d ) ) {
 102 
	if (!IS_NULL_exp(d)) {
74 
	EXP f ;
 103 
		EXP f;
75 
	while ( IS_exp_nof ( d ) ) {
 104 
		while (IS_exp_nof(d)) {
76 
	    d = DEREF_exp ( exp_nof_pad ( d ) ) ;
 105 
			d = DEREF_exp(exp_nof_pad(d));
77 
	}
 106 
		}
78 
	f = DEREF_exp ( exp_destr_call ( d ) ) ;
 107 
		f = DEREF_exp(exp_destr_call(d));
79 
	if ( IS_exp_func_id ( f ) ) {
 108 
		if (IS_exp_func_id(f)) {
80 
	    ulong n ;
 109 
			ulong n;
81 
	    IDENTIFIER fn = DEREF_id ( exp_func_id_id ( f ) ) ;
 110 
			IDENTIFIER fn = DEREF_id(exp_func_id_id(f));
82 
	    IGNORE capsule_id ( fn, VAR_tag ) ;
 111 
			IGNORE capsule_id(fn, VAR_tag);
83 
	    n = unit_no ( bs, fn, VAR_tag, 0 ) ;
 112 
			n = unit_no(bs, fn, VAR_tag, 0);
84 
	    ENC_obtain_tag ( bs ) ;
 113 
			ENC_obtain_tag(bs);
85 
	    ENC_make_tag ( bs, n ) ;
 114 
			ENC_make_tag(bs, n);
86 
	    return ( bs ) ;
 115 
			return (bs);
- 
 
 116 
		}
87 
	}
 117 
	}
88 
    }
 - 
 
89 
    ENC_make_null_proc ( bs ) ;
 118 
	ENC_make_null_proc(bs);
90 
    return ( bs ) ;
 119 
	return (bs);
91 
}
 120 
}
92 
 
 121 
 
93 
 
 122 
 
94 
/*
 123 
/*
95 
    EXCEPTION HANDLING ROUTINES
 124 
    EXCEPTION HANDLING ROUTINES
Line 109... Line 138...
109 
    lab.  Otherwise the handler body, consisting of seq statements,
 138 
    lab.  Otherwise the handler body, consisting of seq statements,
110 
    followed by the code if the exception is not caught, needs to be
 139 
    followed by the code if the exception is not caught, needs to be
111 
    added later.
 140 
    added later.
112 
*/
 141 
*/
113 
 
 142 
 
114 
static BITSTREAM *enc_catch
 143 
static BITSTREAM *
115 
    PROTO_N ( ( bs, t, lab, seq ) )
 - 
 
116 
    PROTO_T ( BITSTREAM *bs X TYPE t X ulong lab X unsigned seq )
 144 
enc_catch(BITSTREAM *bs, TYPE t, ulong lab, unsigned seq)
117 
{
 145 
{
118 
    BITSTREAM *ts ;
 146 
	BITSTREAM *ts;
119 
    NTEST tst = ntest_eq ;
 147 
	NTEST tst = ntest_eq;
120 
    if ( lab == LINK_NONE ) {
 148 
	if (lab == LINK_NONE) {
121 
	/* Create label if necessary */
 149 
		/* Create label if necessary */
122 
	lab = unit_no ( bs, NULL_id, VAR_label, 1 ) ;
 150 
		lab = unit_no(bs, NULL_id, VAR_label, 1);
123 
	ENC_conditional ( bs ) ;
 151 
		ENC_conditional(bs);
124 
	ENC_make_label ( bs, lab ) ;
 152 
		ENC_make_label(bs, lab);
125 
	ENC_SEQUENCE ( bs, seq ) ;
 153 
		ENC_SEQUENCE(bs, seq);
126 
	tst = ntest_not_eq ;
 154 
		tst = ntest_not_eq;
127 
    }
 155 
	}
128 
    ENC_integer_test ( bs ) ;
 156 
	ENC_integer_test(bs);
129 
    ENC_OFF ( bs ) ;
 157 
	ENC_OFF(bs);
130 
    bs = enc_ntest ( bs, tst ) ;
 158 
	bs = enc_ntest(bs, tst);
131 
    ENC_make_label ( bs, lab ) ;
 159 
	ENC_make_label(bs, lab);
132 
    bs = enc_special ( bs, TOK_except_catch ) ;
 160 
	bs = enc_special(bs, TOK_except_catch);
133 
    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
 161 
	ts = start_bitstream(NIL(FILE), bs->link);
134 
    ts = enc_rtti_type ( ts, t, lex_typeid ) ;
 162 
	ts = enc_rtti_type(ts, t, lex_typeid);
135 
    bs = enc_bitstream ( bs, ts ) ;
 163 
	bs = enc_bitstream(bs, ts);
136 
    bs = enc_make_int ( bs, type_sint, 0 ) ;
 164 
	bs = enc_make_int(bs, type_sint, 0);
137 
    return ( bs ) ;
 165 
	return (bs);
138 
}
 166 
}
139 
 
 167 
 
140 
 
 168 
 
141 
/*
 169 
/*
142 
    ENCODE THE START OF A TRY BLOCK
 170 
    ENCODE THE START OF A TRY BLOCK
143 
 
 171 
 
144 
    This routine adds the start of a try block to the bitstream bs.  seq
 172 
    This routine adds the start of a try block to the bitstream bs.  seq
145 
    gives the number of statements to follow.
 173 
    gives the number of statements to follow.
146 
*/
 174 
*/
147 
 
 175 
 
148 
BITSTREAM *enc_try_start
 176 
BITSTREAM *
149 
    PROTO_N ( ( bs, pn, seq ) )
 - 
 
150 
    PROTO_T ( BITSTREAM *bs X ulong *pn X unsigned seq )
 177 
enc_try_start(BITSTREAM *bs, ulong *pn, unsigned seq)
151 
{
 - 
 
152 
    ulong n ;
 - 
 
153 
    ulong lab ;
 - 
 
154 
    BITSTREAM *ts ;
 - 
 
155 
 
 - 
 
156 
    /* Must be in a function definition */
 - 
 
157 
    if ( in_dynamic_init ) output_init = 1 ;
 - 
 
158 
 
 - 
 
159 
    /* Encode the try block jump buffer */
 - 
 
160 
    n = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
 - 
 
161 
    ENC_variable ( bs ) ;
 - 
 
162 
    bs = enc_access ( bs, crt_func_access ) ;
 - 
 
163 
    ENC_make_tag ( bs, n ) ;
 - 
 
164 
    ENC_make_value ( bs ) ;
 - 
 
165 
    bs = enc_special ( bs, TOK_try_type ) ;
 - 
 
166 
    *pn = n ;
 - 
 
167 
 
 - 
 
168 
    /* Encode the try block label */
 - 
 
169 
    lab = unit_no ( bs, NULL_id, VAR_label, 1 ) ;
 - 
 
170 
    ENC_conditional ( bs ) ;
 - 
 
171 
    ENC_make_label ( bs, lab ) ;
 - 
 
172 
 
 - 
 
173 
    /* Encode the try block body */
 - 
 
174 
    ENC_SEQUENCE ( bs, seq ) ;
 - 
 
175 
    bs = enc_special ( bs, TOK_try_begin ) ;
 - 
 
176 
    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
 - 
 
177 
    ENC_obtain_tag ( ts ) ;
 - 
 
178 
    ENC_make_tag ( ts, n ) ;
 - 
 
179 
    ENC_current_env ( ts ) ;
 - 
 
180 
    ENC_make_local_lv ( ts ) ;
 - 
 
181 
    ENC_make_label ( ts, lab ) ;
 - 
 
182 
    bs = enc_bitstream ( bs, ts ) ;
 - 
 
183 
    return ( bs ) ;
 - 
 
184 
}
 - 
 
185 
 
 - 
 
186 
 
 - 
 
187 
/*
 - 
 
188 
    ENCODE THE END OF A TRY BLOCK
 - 
 
189 
 
 - 
 
190 
    This routine adds the end of the current try block to the bitstream bs.
 - 
 
191 
*/
 - 
 
192 
 
 - 
 
193 
BITSTREAM *enc_try_end
 - 
 
194 
    PROTO_N ( ( bs, n ) )
 - 
 
195 
    PROTO_T ( BITSTREAM *bs X ulong n )
 - 
 
196 
{
 - 
 
197 
    BITSTREAM *ts ;
 - 
 
198 
    bs = enc_special ( bs, TOK_try_end ) ;
 - 
 
199 
    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
 - 
 
200 
    ENC_obtain_tag ( ts ) ;
 - 
 
201 
    ENC_make_tag ( ts, n ) ;
 - 
 
202 
    bs = enc_bitstream ( bs, ts ) ;
 - 
 
203 
    return ( bs ) ;
 - 
 
204 
}
 - 
 
205 
 
 - 
 
206 
 
 - 
 
207 
/*
 - 
 
208 
    ENCODE A TRY BLOCK
 - 
 
209 
 
 - 
 
210 
    This routine adds the try block e to the bitstream bs.
 - 
 
211 
*/
 - 
 
212 
 
 - 
 
213 
BITSTREAM *enc_try
 - 
 
214 
    PROTO_N ( ( bs, e ) )
 - 
 
215 
    PROTO_T ( BITSTREAM *bs X EXP e )
 - 
 
216 
{
 178 
{
217 
    int uc ;
 179 
	ulong n;
218 
    ulong ex ;
 180 
	ulong lab;
- 
 
 181 
	BITSTREAM *ts;
- 
 
 182 
 
- 
 
 183 
	/* Must be in a function definition */
- 
 
 184 
	if (in_dynamic_init) {
219 
    unsigned seq ;
 185 
		output_init = 1;
- 
 
 186 
	}
- 
 
 187 
 
220 
    EXP a = DEREF_exp ( exp_try_block_body ( e ) ) ;
 188 
	/* Encode the try block jump buffer */
221 
    LIST ( EXP ) p = DEREF_list ( exp_try_block_handlers ( e ) ) ;
 189 
	n = unit_no(bs, NULL_id, VAR_tag, 1);
- 
 
 190 
	ENC_variable(bs);
222 
    LIST ( TYPE ) q = DEREF_list ( exp_try_block_htypes ( e ) ) ;
 191 
	bs = enc_access(bs, crt_func_access);
- 
 
 192 
	ENC_make_tag(bs, n);
- 
 
 193 
	ENC_make_value(bs);
223 
    EXP c = DEREF_exp ( exp_try_block_ellipsis ( e ) ) ;
 194 
	bs = enc_special(bs, TOK_try_type);
- 
 
 195 
	*pn = n;
224 
 
 196 
 
- 
 
 197 
	/* Encode the try block label */
- 
 
 198 
	lab = unit_no(bs, NULL_id, VAR_label, 1);
- 
 
 199 
	ENC_conditional(bs);
- 
 
 200 
	ENC_make_label(bs, lab);
- 
 
 201 
 
- 
 
 202 
	/* Encode the try block body */
- 
 
 203 
	ENC_SEQUENCE(bs, seq);
- 
 
 204 
	bs = enc_special(bs, TOK_try_begin);
- 
 
 205 
	ts = start_bitstream(NIL(FILE), bs->link);
- 
 
 206 
	ENC_obtain_tag(ts);
- 
 
 207 
	ENC_make_tag(ts, n);
- 
 
 208 
	ENC_current_env(ts);
- 
 
 209 
	ENC_make_local_lv(ts);
- 
 
 210 
	ENC_make_label(ts, lab);
- 
 
 211 
	bs = enc_bitstream(bs, ts);
- 
 
 212 
	return (bs);
- 
 
 213 
}
- 
 
 214 
 
- 
 
 215 
 
- 
 
 216 
/*
- 
 
 217 
    ENCODE THE END OF A TRY BLOCK
- 
 
 218 
 
- 
 
 219 
    This routine adds the end of the current try block to the bitstream bs.
- 
 
 220 
*/
- 
 
 221 
 
- 
 
 222 
BITSTREAM *
- 
 
 223 
enc_try_end(BITSTREAM *bs, ulong n)
- 
 
 224 
{
- 
 
 225 
	BITSTREAM *ts;
- 
 
 226 
	bs = enc_special(bs, TOK_try_end);
- 
 
 227 
	ts = start_bitstream(NIL(FILE), bs->link);
- 
 
 228 
	ENC_obtain_tag(ts);
- 
 
 229 
	ENC_make_tag(ts, n);
- 
 
 230 
	bs = enc_bitstream(bs, ts);
- 
 
 231 
	return (bs);
- 
 
 232 
}
- 
 
 233 
 
- 
 
 234 
 
- 
 
 235 
/*
- 
 
 236 
    ENCODE A TRY BLOCK
- 
 
 237 
 
- 
 
 238 
    This routine adds the try block e to the bitstream bs.
- 
 
 239 
*/
- 
 
 240 
 
- 
 
 241 
BITSTREAM *
- 
 
 242 
enc_try(BITSTREAM *bs, EXP e)
- 
 
 243 
{
- 
 
 244 
	int uc;
- 
 
 245 
	ulong ex;
- 
 
 246 
	unsigned seq;
- 
 
 247 
	EXP a = DEREF_exp(exp_try_block_body(e));
- 
 
 248 
	LIST(EXP)p = DEREF_list(exp_try_block_handlers(e));
- 
 
 249 
	LIST(TYPE)q = DEREF_list(exp_try_block_htypes(e));
- 
 
 250 
	EXP c = DEREF_exp(exp_try_block_ellipsis(e));
- 
 
 251 
 
225 
    /* Ignore handlers if exception handling disabled */
 252 
	/* Ignore handlers if exception handling disabled */
226 
    if ( !output_except ) {
 253 
	if (!output_except) {
227 
	bs = enc_stmt ( bs, a ) ;
 254 
		bs = enc_stmt(bs, a);
228 
	return ( bs ) ;
 255 
		return (bs);
229 
    }
 256 
	}
230 
 
 257 
 
231 
    /* Encode the try block */
 258 
	/* Encode the try block */
232 
    no_destructors++ ;
 259 
	no_destructors++;
233 
    if ( output_new_diag ) {
 260 
	if (output_new_diag) {
234 
	seq = 2 ;
 261 
		seq = 2;
235 
    } else {
 262 
	} else {
236 
	seq = stmt_length ( a ) + 1 ;
 263 
		seq = stmt_length(a) + 1;
237 
    }
 264 
	}
238 
    bs = enc_try_start ( bs, &ex, seq ) ;
 265 
	bs = enc_try_start(bs, &ex, seq);
239 
    COPY_ulong ( exp_try_block_no ( e ), ex ) ;
 266 
	COPY_ulong(exp_try_block_no(e), ex);
240 
    if ( output_new_diag ) {
 267 
	if (output_new_diag) {
241 
	BITSTREAM *ts = enc_diag_begin ( &bs ) ;
 268 
		BITSTREAM *ts = enc_diag_begin(&bs);
242 
	ts = enc_stmt ( ts, a ) ;
 269 
		ts = enc_stmt(ts, a);
243 
	bs = enc_diag_end ( bs, ts, e, 1 ) ;
 270 
		bs = enc_diag_end(bs, ts, e, 1);
244 
    } else {
 271 
	} else {
245 
	bs = enc_compound_stmt ( bs, a ) ;
 272 
		bs = enc_compound_stmt(bs, a);
246 
    }
 273 
	}
247 
    bs = enc_try_end ( bs, ex ) ;
 274 
	bs = enc_try_end(bs, ex);
248 
    uc = unreached_code ;
 275 
	uc = unreached_code;
249 
 
 276 
 
250 
    /* Encode the handlers */
 277 
	/* Encode the handlers */
251 
    while ( !IS_NULL_list ( p ) ) {
 278 
	while (!IS_NULL_list(p)) {
252 
	EXP b = DEREF_exp ( HEAD_list ( p ) ) ;
 279 
		EXP b = DEREF_exp(HEAD_list(p));
253 
	TYPE t = DEREF_type ( HEAD_list ( q ) ) ;
 280 
		TYPE t = DEREF_type(HEAD_list(q));
254 
	unreached_code = 0 ;
 281 
		unreached_code = 0;
255 
	if ( !output_new_diag ) {
 282 
		if (!output_new_diag) {
256 
	    b = DEREF_exp ( exp_handler_body ( b ) ) ;
 283 
			b = DEREF_exp(exp_handler_body(b));
257 
	}
 284 
		}
258 
	seq = stmt_length ( b ) + 1 ;
 285 
		seq = stmt_length(b) + 1;
259 
	bs = enc_catch ( bs, t, LINK_NONE, seq ) ;
 286 
		bs = enc_catch(bs, t, LINK_NONE, seq);
260 
	bs = enc_compound_stmt ( bs, b ) ;
 287 
		bs = enc_compound_stmt(bs, b);
261 
	bs = enc_special ( bs, TOK_except_end ) ;
 288 
		bs = enc_special(bs, TOK_except_end);
262 
	if ( !unreached_code ) uc = 0 ;
 289 
		if (!unreached_code) {
- 
 
 290 
			uc = 0;
- 
 
 291 
		}
263 
	q = TAIL_list ( q ) ;
 292 
		q = TAIL_list(q);
264 
	p = TAIL_list ( p ) ;
 293 
		p = TAIL_list(p);
265 
    }
 294 
	}
266 
 
 295 
 
267 
    /* Encode the default handler */
 296 
	/* Encode the default handler */
268 
    unreached_code = 0 ;
 297 
	unreached_code = 0;
269 
    if ( IS_exp_handler ( c ) ) {
 298 
	if (IS_exp_handler(c)) {
270 
	if ( !output_new_diag ) {
 299 
		if (!output_new_diag) {
271 
	    c = DEREF_exp ( exp_handler_body ( c ) ) ;
 300 
			c = DEREF_exp(exp_handler_body(c));
272 
	}
 301 
		}
273 
	seq = stmt_length ( c ) ;
 302 
		seq = stmt_length(c);
274 
	if ( seq ) {
 303 
		if (seq) {
275 
	    ENC_SEQUENCE ( bs, seq ) ;
 304 
			ENC_SEQUENCE(bs, seq);
276 
	    bs = enc_compound_stmt ( bs, c ) ;
 305 
			bs = enc_compound_stmt(bs, c);
277 
	}
 306 
		}
278 
	bs = enc_special ( bs, TOK_except_end ) ;
 307 
		bs = enc_special(bs, TOK_except_end);
279 
    } else {
 308 
	} else {
280 
	/* Re-throw current exception */
 309 
		/* Re-throw current exception */
281 
	bs = enc_exp ( bs, c ) ;
 310 
		bs = enc_exp(bs, c);
282 
    }
 311 
	}
283 
    if ( !unreached_code ) uc = 0 ;
 312 
	if (!unreached_code) {
- 
 
 313 
		uc = 0;
- 
 
 314 
	}
284 
    unreached_code = uc ;
 315 
	unreached_code = uc;
285 
    no_destructors-- ;
 316 
	no_destructors--;
286 
    return ( bs ) ;
 317 
	return (bs);
287 
}
 318 
}
288 
 
 319 
 
289 
 
 320 
 
290 
/*
 321 
/*
291 
    RETHROW THE CURRENT EXCEPTION
 322 
    RETHROW THE CURRENT EXCEPTION
292 
 
 323 
 
293 
    This routine adds the expression 'throw' to the bitstream bs.
 324 
    This routine adds the expression 'throw' to the bitstream bs.
294 
*/
 325 
*/
295 
 
 326 
 
296 
BITSTREAM *enc_rethrow
 327 
BITSTREAM *
297 
    PROTO_N ( ( bs ) )
 - 
 
298 
    PROTO_T ( BITSTREAM *bs )
 328 
enc_rethrow(BITSTREAM *bs)
299 
{
 329 
{
300 
    if ( output_except ) {
 330 
	if (output_except) {
301 
	bs = enc_special ( bs, TOK_except_rethrow ) ;
 331 
		bs = enc_special(bs, TOK_except_rethrow);
302 
    } else {
 332 
	} else {
303 
	BITSTREAM *ts ;
 333 
		BITSTREAM *ts;
304 
	bs = enc_special ( bs, TOK_except_bad ) ;
 334 
		bs = enc_special(bs, TOK_except_bad);
305 
	ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
 335 
		ts = start_bitstream(NIL(FILE), bs->link);
306 
	ts = enc_make_snat ( ts, 0 ) ;
 336 
		ts = enc_make_snat(ts, 0);
307 
	bs = enc_bitstream ( bs, ts ) ;
 337 
		bs = enc_bitstream(bs, ts);
308 
    }
 338 
	}
309 
    unreached_code = 1 ;
 339 
	unreached_code = 1;
310 
    return ( bs ) ;
 340 
	return (bs);
311 
}
 341 
}
312 
 
 342 
 
313 
 
 343 
 
314 
/*
 344 
/*
315 
    ENCODE A THROW EXPRESSION
 345 
    ENCODE A THROW EXPRESSION
316 
 
 346 
 
317 
    This routine adds the expression 'throw a' to the bitstream bs.  If
 347 
    This routine adds the expression 'throw a' to the bitstream bs.  If
318 
    a is the null expression then the current exception is rethrown.  b
 348 
    a is the null expression then the current exception is rethrown.  b
319 
    and d give the size and destructor for the exception type.
 349 
    and d give the size and destructor for the exception type.
320 
*/
 350 
*/
321 
 
 351 
 
322 
BITSTREAM *enc_throw
 352 
BITSTREAM *
323 
    PROTO_N ( ( bs, a, b, d ) )
 - 
 
324 
    PROTO_T ( BITSTREAM *bs X EXP a X EXP b X EXP d )
 353 
enc_throw(BITSTREAM *bs, EXP a, EXP b, EXP d)
325 
{
 354 
{
326 
    if ( !IS_NULL_exp ( a ) && output_except ) {
 355 
	if (!IS_NULL_exp(a) && output_except) {
327 
	/* Set up variable */
 356 
		/* Set up variable */
328 
	EXP c ;
 357 
		EXP c;
329 
	BITSTREAM *ts, *us ;
 358 
		BITSTREAM *ts, *us;
330 
	TYPE t = DEREF_type ( exp_type ( a ) ) ;
 359 
		TYPE t = DEREF_type(exp_type(a));
331 
	ulong n = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
 360 
		ulong n = unit_no(bs, NULL_id, VAR_tag, 1);
332 
	ENC_variable ( bs ) ;
 361 
		ENC_variable(bs);
333 
	bs = enc_access ( bs, dspec_none ) ;
 362 
		bs = enc_access(bs, dspec_none);
334 
	ENC_make_tag ( bs, n ) ;
 363 
		ENC_make_tag(bs, n);
335 
	MAKE_exp_dummy ( t, NULL_exp, n, NULL_off, 2, c ) ;
 364 
		MAKE_exp_dummy(t, NULL_exp, n, NULL_off, 2, c);
336 
 
 365 
 
337 
	/* Allocate space for exception value */
 366 
		/* Allocate space for exception value */
338 
	bs = enc_special ( bs, TOK_from_ptr_void ) ;
 367 
		bs = enc_special(bs, TOK_from_ptr_void);
339 
	ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
 368 
		ts = start_bitstream(NIL(FILE), bs->link);
340 
	ts = enc_alignment ( ts, t ) ;
 369 
		ts = enc_alignment(ts, t);
341 
	ts = enc_special ( ts, TOK_except_alloc ) ;
 370 
		ts = enc_special(ts, TOK_except_alloc);
342 
	us = start_bitstream ( NIL ( FILE ), ts->link ) ;
 371 
		us = start_bitstream(NIL(FILE), ts->link);
343 
	us = enc_exp ( us, b ) ;
 372 
		us = enc_exp(us, b);
344 
	ts = enc_bitstream ( ts, us ) ;
 373 
		ts = enc_bitstream(ts, us);
345 
	bs = enc_bitstream ( bs, ts ) ;
 374 
		bs = enc_bitstream(bs, ts);
346 
 
 375 
 
347 
	/* Assign exception value */
 376 
		/* Assign exception value */
348 
	ENC_SEQ_SMALL ( bs, 1 ) ;
 377 
		ENC_SEQ_SMALL(bs, 1);
349 
	bs = enc_init_tag ( bs, n, NULL_off, 1, t, a, NULL_exp, 0 ) ;
 378 
		bs = enc_init_tag(bs, n, NULL_off, 1, t, a, NULL_exp, 0);
350 
 
 379 
 
351 
	/* Throw the exception */
 380 
		/* Throw the exception */
352 
	bs = enc_special ( bs, TOK_except_throw ) ;
 381 
		bs = enc_special(bs, TOK_except_throw);
353 
	ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
 382 
		ts = start_bitstream(NIL(FILE), bs->link);
354 
	ts = enc_special ( ts, TOK_to_ptr_void ) ;
 383 
		ts = enc_special(ts, TOK_to_ptr_void);
355 
	us = start_bitstream ( NIL ( FILE ), ts->link ) ;
 384 
		us = start_bitstream(NIL(FILE), ts->link);
356 
	us = enc_alignment ( us, t ) ;
 385 
		us = enc_alignment(us, t);
357 
	us = enc_exp ( us, c ) ;
 386 
		us = enc_exp(us, c);
358 
	ts = enc_bitstream ( ts, us ) ;
 387 
		ts = enc_bitstream(ts, us);
359 
	ts = enc_rtti_type ( ts, t, lex_typeid ) ;
 388 
		ts = enc_rtti_type(ts, t, lex_typeid);
360 
	ts = enc_destr_func ( ts, d ) ;
 389 
		ts = enc_destr_func(ts, d);
361 
	bs = enc_bitstream ( bs, ts ) ;
 390 
		bs = enc_bitstream(bs, ts);
362 
	unreached_code = 1 ;
 391 
		unreached_code = 1;
363 
	free_exp ( c, 1 ) ;
 392 
		free_exp(c, 1);
364 
 
 393 
 
365 
    } else {
 394 
	} else {
366 
	/* Rethrow the current exception */
 395 
		/* Rethrow the current exception */
367 
	bs = enc_rethrow ( bs ) ;
 396 
		bs = enc_rethrow(bs);
368 
    }
 397 
	}
369 
    return ( bs ) ;
 398 
	return (bs);
370 
}
 399 
}
371 
 
 400 
 
372 
 
 401 
 
373 
/*
 402 
/*
374 
    ENCODE A CAUGHT EXPRESSION
 403 
    ENCODE A CAUGHT EXPRESSION
375 
 
 404 
 
376 
    This routine adds the initialiser for an exception handler variable
 405 
    This routine adds the initialiser for an exception handler variable
377 
    of type t to the bitstream bs.  This is obtained by casting the
 406 
    of type t to the bitstream bs.  This is obtained by casting the
378 
    current exception value to a pointer to t.
 407 
    current exception value to a pointer to t.
379 
*/
 408 
*/
380 
 
 409 
 
381 
BITSTREAM *enc_thrown
 410 
BITSTREAM *
382 
    PROTO_N ( ( bs, t ) )
 - 
 
383 
    PROTO_T ( BITSTREAM *bs X TYPE t )
 411 
enc_thrown(BITSTREAM *bs, TYPE t)
384 
{
 412 
{
385 
    BITSTREAM *ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
 413 
	BITSTREAM *ts = start_bitstream(NIL(FILE), bs->link);
386 
    bs = enc_special ( bs, TOK_from_ptr_void ) ;
 414 
	bs = enc_special(bs, TOK_from_ptr_void);
387 
    ts = enc_alignment ( ts, t ) ;
 415 
	ts = enc_alignment(ts, t);
388 
    ts = enc_special ( ts, TOK_except_value ) ;
 416 
	ts = enc_special(ts, TOK_except_value);
389 
    bs = enc_bitstream ( bs, ts ) ;
 417 
	bs = enc_bitstream(bs, ts);
390 
    return ( bs ) ;
 418 
	return (bs);
391 
}
 419 
}
392 
 
 420 
 
393 
 
 421 
 
394 
/*
 422 
/*
395 
    EXCEPTION SPECIFICATION FLAG
 423 
    EXCEPTION SPECIFICATION FLAG
396 
 
 424 
 
397 
    This flag is set to true if the current function has an exception
 425 
    This flag is set to true if the current function has an exception
398 
    specification.
 426 
    specification.
399 
*/
 427 
*/
400 
 
 428 
 
401 
int in_exception_spec = 0 ;
 429 
int in_exception_spec = 0;
402 
 
 430 
 
403 
 
 431 
 
404 
/*
 432 
/*
405 
    ENCODE THE START OF A FUNCTION EXCEPTION HANDLER
 433 
    ENCODE THE START OF A FUNCTION EXCEPTION HANDLER
406 
 
 434 
 
407 
    This routine is called at the start of a function definition declared
 435 
    This routine is called at the start of a function definition declared
408 
    with a non-trivial exception specification.  It sets up a try block
 436 
    with a non-trivial exception specification.  It sets up a try block
409 
    enclosing the complete function body.
 437 
    enclosing the complete function body.
410 
*/
 438 
*/
411 
 
 439 
 
412 
BITSTREAM *enc_try_func
 440 
BITSTREAM *
413 
    PROTO_N ( ( bs, a ) )
 - 
 
414 
    PROTO_T ( BITSTREAM *bs X EXP a )
 441 
enc_try_func(BITSTREAM *bs, EXP a)
415 
{
 442 
{
416 
    if ( !IS_NULL_exp ( a ) ) {
 443 
	if (!IS_NULL_exp(a)) {
417 
	/* Declare counter variable */
 444 
		/* Declare counter variable */
418 
	EXP b = sizeof_init ( a, type_sint ) ;
 445 
		EXP b = sizeof_init(a, type_sint);
419 
	ulong n = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
 446 
		ulong n = unit_no(bs, NULL_id, VAR_tag, 1);
420 
	ENC_variable ( bs ) ;
 447 
		ENC_variable(bs);
421 
	bs = enc_access ( bs, crt_func_access ) ;
 448 
		bs = enc_access(bs, crt_func_access);
422 
	ENC_make_tag ( bs, n ) ;
 449 
		ENC_make_tag(bs, n);
423 
	bs = enc_exp ( bs, b ) ;
 450 
		bs = enc_exp(bs, b);
424 
	free_exp ( b, 1 ) ;
 451 
		free_exp(b, 1);
425 
	last_params [ DUMMY_count ] = n ;
 452 
		last_params[DUMMY_count] = n;
426 
    }
 453 
	}
427 
    no_destructors++ ;
 454 
	no_destructors++;
428 
    in_exception_spec++ ;
 455 
	in_exception_spec++;
429 
    ENC_SEQ_SMALL ( bs, 1 ) ;
 456 
	ENC_SEQ_SMALL(bs, 1);
430 
    bs = enc_try_start ( bs, last_params + DUMMY_catch, ( unsigned ) 1 ) ;
 457 
	bs = enc_try_start(bs, last_params + DUMMY_catch,(unsigned)1);
431 
    return ( bs ) ;
 458 
	return (bs);
432 
}
 459 
}
433 
 
 460 
 
434 
 
 461 
 
435 
/*
 462 
/*
436 
    BAD EXCEPTION TYPE
 463 
    BAD EXCEPTION TYPE
437 
 
 464 
 
438 
    This type represents the standard class 'std::bad_exception' which has
 465 
    This type represents the standard class 'std::bad_exception' which has
439 
    a special meaning within exception specifications.
 466 
    a special meaning within exception specifications.
440 
*/
 467 
*/
441 
 
 468 
 
442 
static TYPE bad_except = NULL_type ;
 469 
static TYPE bad_except = NULL_type;
443 
 
 470 
 
444 
 
 471 
 
445 
/*
 472 
/*
446 
    ENCODE THE END OF A FUNCTION EXCEPTION HANDLER
 473 
    ENCODE THE END OF A FUNCTION EXCEPTION HANDLER
447 
 
 474 
 
448 
    This routine is called at the end of a function definition declared
 475 
    This routine is called at the end of a function definition declared
449 
    with the set of exceptions p.  It sets up a list of exception handlers
 476 
    with the set of exceptions p.  It sets up a list of exception handlers
450 
    for each element of p which re-throw the current exception.  If the
 477 
    for each element of p which re-throw the current exception.  If the
451 
    exception remains uncaught then the bad exception token is called
 478 
    exception remains uncaught then the bad exception token is called
452 
    (which calls unexpected).
 479 
    (which calls unexpected).
453 
*/
 480 
*/
454 
 
 481 
 
455 
BITSTREAM *enc_catch_func
 482 
BITSTREAM *
456 
    PROTO_N ( ( bs, p, a ) )
 - 
 
457 
    PROTO_T ( BITSTREAM *bs X LIST ( TYPE ) p X EXP a )
 483 
enc_catch_func(BITSTREAM *bs, LIST(TYPE)p, EXP a)
458 
{
 484 
{
459 
    int rethrow = 0 ;
 485 
	int rethrow = 0;
460 
    bs = enc_try_end ( bs, last_params [ DUMMY_catch ] ) ;
 486 
	bs = enc_try_end(bs, last_params[DUMMY_catch]);
461 
    if ( !IS_NULL_exp ( a ) ) {
 487 
	if (!IS_NULL_exp(a)) {
462 
	ENC_SEQ_SMALL ( bs, 1 ) ;
 488 
		ENC_SEQ_SMALL(bs, 1);
463 
	bs = enc_exp ( bs, a ) ;
 489 
		bs = enc_exp(bs, a);
464 
    }
 490 
	}
465 
    if ( EQ_list ( p, univ_type_set ) ) {
 491 
	if (EQ_list(p, univ_type_set)) {
466 
	/* Can throw any exception */
 492 
		/* Can throw any exception */
467 
	rethrow = 1 ;
 493 
		rethrow = 1;
468 
    } else {
 494 
	} else {
469 
	BITSTREAM *ts ;
 495 
		BITSTREAM *ts;
470 
	int have_bad = 0 ;
 496 
		int have_bad = 0;
471 
	if ( !IS_NULL_list ( p ) ) {
 497 
		if (!IS_NULL_list(p)) {
472 
	    /* Check list of exceptions */
 498 
			/* Check list of exceptions */
473 
	    unsigned n = 0 ;
 499 
			unsigned n = 0;
474 
	    LIST ( TYPE ) q = p ;
 500 
			LIST(TYPE)q = p;
475 
	    while ( !IS_NULL_list ( q ) ) {
 501 
			while (!IS_NULL_list(q)) {
476 
		TYPE t = DEREF_type ( HEAD_list ( q ) ) ;
 502 
				TYPE t = DEREF_type(HEAD_list(q));
477 
		if ( !IS_NULL_type ( t ) ) n++ ;
 503 
				if (!IS_NULL_type(t)) {
- 
 
 504 
					n++;
- 
 
 505 
				}
478 
		q = TAIL_list ( q ) ;
 506 
				q = TAIL_list(q);
479 
	    }
 507 
			}
480 
	    if ( n ) {
 508 
			if (n) {
481 
		ulong lab ;
 509 
				ulong lab;
482 
		TYPE s = bad_except ;
 510 
				TYPE s = bad_except;
483 
		if ( IS_NULL_type ( s ) ) {
 511 
				if (IS_NULL_type(s)) {
484 
		    s = find_std_type ( "bad_exception", 1, 0 ) ;
 512 
					s = find_std_type("bad_exception", 1,
- 
 
 513 
							  0);
485 
		    s = exception_type ( s, 0 ) ;
 514 
					s = exception_type(s, 0);
486 
		    bad_except = s ;
 515 
					bad_except = s;
- 
 
 516 
				}
- 
 
 517 
				lab = unit_no(bs, NULL_id, VAR_label, 1);
- 
 
 518 
				ENC_conditional(bs);
- 
 
 519 
				ENC_make_label(bs, lab);
- 
 
 520 
				ENC_SEQUENCE(bs, n);
- 
 
 521 
				while (!IS_NULL_list(p)) {
- 
 
 522 
					TYPE t = DEREF_type(HEAD_list(p));
- 
 
 523 
					if (!IS_NULL_type(t)) {
- 
 
 524 
						t = exception_type(t, 0);
- 
 
 525 
						if (eq_type(t, s)) {
- 
 
 526 
							have_bad = 1;
- 
 
 527 
						}
- 
 
 528 
						bs = enc_catch(bs, t,
- 
 
 529 
							       lab,(unsigned)0);
- 
 
 530 
					}
- 
 
 531 
					p = TAIL_list(p);
- 
 
 532 
				}
- 
 
 533 
				rethrow = 1;
- 
 
 534 
			}
487 
		}
 535 
		}
488 
		lab = unit_no ( bs, NULL_id, VAR_label, 1 ) ;
 536 
		bs = enc_special(bs, TOK_except_bad);
489 
		ENC_conditional ( bs ) ;
 537 
		ts = start_bitstream(NIL(FILE), bs->link);
490 
		ENC_make_label ( bs, lab ) ;
 538 
		ts = enc_make_snat(ts, have_bad);
491 
		ENC_SEQUENCE ( bs, n ) ;
 539 
		bs = enc_bitstream(bs, ts);
492 
		while ( !IS_NULL_list ( p ) ) {
 - 
 
493 
		    TYPE t = DEREF_type ( HEAD_list ( p ) ) ;
 - 
 
- 
 
 540 
	}
494 
		    if ( !IS_NULL_type ( t ) ) {
 541 
	if (rethrow) {
495 
			t = exception_type ( t, 0 ) ;
 - 
 
496 
			if ( eq_type ( t, s ) ) have_bad = 1 ;
 542 
		/* Re-throw the current exception */
497 
			bs = enc_catch ( bs, t, lab, ( unsigned ) 0 ) ;
 543 
		bs = enc_special(bs, TOK_except_rethrow);
498 
		    }
 - 
 
499 
		    p = TAIL_list ( p ) ;
 - 
 
500 
		}
 - 
 
501 
		rethrow = 1 ;
 544 
		unreached_code = 1;
502 
	    }
 - 
 
503 
	}
 545 
	}
504 
	bs = enc_special ( bs, TOK_except_bad ) ;
 - 
 
505 
	ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
 - 
 
506 
	ts = enc_make_snat ( ts, have_bad ) ;
 - 
 
507 
	bs = enc_bitstream ( bs, ts ) ;
 - 
 
508 
    }
 - 
 
509 
    if ( rethrow ) {
 - 
 
510 
	/* Re-throw the current exception */
 - 
 
511 
	bs = enc_special ( bs, TOK_except_rethrow ) ;
 - 
 
512 
	unreached_code = 1 ;
 - 
 
513 
    }
 - 
 
514 
    in_exception_spec-- ;
 546 
	in_exception_spec--;
515 
    no_destructors-- ;
 547 
	no_destructors--;
516 
    UNUSED ( a ) ;
 548 
	UNUSED(a);
517 
    return ( bs ) ;
 549 
	return (bs);
518 
}
 550 
}
519 
 
 551 
 
520 
 
 552 
 
521 
#endif /* LANGUAGE_CPP */
 553 
#endif /* LANGUAGE_CPP */
522 
#endif /* TDF_OUTPUT */
 554 
#endif /* TDF_OUTPUT */