Warning: Attempt to read property "date" on null in /usr/local/www/websvn.planix.org/blame.php on line 247

Warning: Attempt to read property "msg" on null in /usr/local/www/websvn.planix.org/blame.php on line 247
WebSVN – tendra.SVN – Blame – /branches/tendra4/src/producers/common/output/stmt.c – Rev 2

Subversion Repositories tendra.SVN

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1
/*
2
    		 Crown Copyright (c) 1997
3
 
4
    This TenDRA(r) Computer Program is subject to Copyright
5
    owned by the United Kingdom Secretary of State for Defence
6
    acting through the Defence Evaluation and Research Agency
7
    (DERA).  It is made available to Recipients with a
8
    royalty-free licence for its use, reproduction, transfer
9
    to other parties and amendment for any purpose not excluding
10
    product development provided that any such use et cetera
11
    shall be deemed to be acceptance of the following conditions:-
12
 
13
        (1) Its Recipients shall ensure that this Notice is
14
        reproduced upon any copies or amended versions of it;
15
 
16
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
18
        for the relevant amendment or amendments;
19
 
20
        (3) Its onward transfer from a recipient to another
21
        party shall be deemed to be that party's acceptance of
22
        these conditions;
23
 
24
        (4) DERA gives no warranty or assurance as to its
25
        quality or suitability for any purpose and DERA accepts
26
        no liability whatsoever in relation to any use to which
27
        it may be put.
28
*/
29
 
30
 
31
#include "config.h"
32
#include "version.h"
33
#include "c_types.h"
34
#include "exp_ops.h"
35
#include "hashid_ops.h"
36
#include "id_ops.h"
37
#include "error.h"
38
#include "tdf.h"
39
#include "basetype.h"
40
#include "capsule.h"
41
#include "check.h"
42
#include "compile.h"
43
#include "destroy.h"
44
#include "diag.h"
45
#include "encode.h"
46
#include "exp.h"
47
#include "init.h"
48
#include "redeclare.h"
49
#include "shape.h"
50
#include "statement.h"
51
#include "struct.h"
52
#include "stmt.h"
53
#include "syntax.h"
54
#include "throw.h"
55
#include "tok.h"
56
 
57
 
58
/*
59
    NUMBER OF PENDING DESTRUCTORS
60
 
61
    This variable keeps track of the number of destructors for local
62
    variables which are pending at any moment during the TDF generation.
63
    This includes such pseudo-destructors as for jump locations in
64
    try blocks.
65
*/
66
 
67
unsigned long no_destructors = 0 ;
68
 
69
 
70
/*
71
    TDF STATEMENT ENCODING ROUTINES
72
 
73
    The remaining routines are only included if TDF output is enabled.
74
*/
75
 
76
#if TDF_OUTPUT
77
 
78
 
79
/*
80
    FIND THE NUMBER OF COMPONENTS IN A STATEMENT
81
 
82
    This routine finds the number of components in the statement e,
83
    ignoring trivial statements and expanding compound statements
84
    recursively.  The result equals the number of statements added to
85
    the bitstream by enc_compound_stmt.
86
*/
87
 
88
unsigned stmt_length
89
    PROTO_N ( ( e ) )
90
    PROTO_T ( EXP e )
91
{
92
    if ( !IS_NULL_exp ( e ) ) {
93
	switch ( TAG_exp ( e ) ) {
94
	    case exp_sequence_tag : {
95
		/* Compound statements */
96
		unsigned n = 0 ;
97
		LIST ( EXP ) p = DEREF_list ( exp_sequence_first ( e ) ) ;
98
		while ( !IS_NULL_list ( p ) ) {
99
		    EXP a = DEREF_exp ( HEAD_list ( p ) ) ;
100
		    if ( !IS_NULL_exp ( a ) ) {
101
			n += stmt_length ( a ) ;
102
		    }
103
		    p = TAIL_list ( p ) ;
104
		}
105
		return ( n ) ;
106
	    }
107
	    case exp_location_tag : {
108
		/* Location statements */
109
		EXP a = DEREF_exp ( exp_location_arg ( e ) ) ;
110
		if ( !IS_NULL_exp ( a ) ) {
111
		    if ( is_diag_stmt ( a ) ) return ( 1 ) ;
112
		    return ( stmt_length ( a ) ) ;
113
		}
114
		break ;
115
	    }
116
	    case exp_reach_tag :
117
	    case exp_unreach_tag : {
118
		/* Flow control statement */
119
		EXP a = DEREF_exp ( exp_reach_etc_body ( e ) ) ;
120
		return ( stmt_length ( a ) ) ;
121
	    }
122
	    case exp_set_tag :
123
	    case exp_unused_tag : {
124
		/* Variable flow statements */
125
		break ;
126
	    }
127
	    default : {
128
		/* Other statements */
129
		return ( 1 ) ;
130
	    }
131
	}
132
    }
133
    return ( 0 ) ;
134
}
135
 
136
 
137
/*
138
    ENCODE A COMPOUND STATEMENT
139
 
140
    This routine adds the statement e to the bitstream bs, ignoring
141
    trivial statements and expanding compound statements recursively.
142
*/
143
 
144
BITSTREAM *enc_compound_stmt
145
    PROTO_N ( ( bs, e ) )
146
    PROTO_T ( BITSTREAM *bs X EXP e )
147
{
148
    if ( !IS_NULL_exp ( e ) ) {
149
	switch ( TAG_exp ( e ) ) {
150
	    case exp_sequence_tag : {
151
		/* Compound statements */
152
		LIST ( EXP ) p = DEREF_list ( exp_sequence_first ( e ) ) ;
153
		while ( !IS_NULL_list ( p ) ) {
154
		    EXP a = DEREF_exp ( HEAD_list ( p ) ) ;
155
		    if ( !IS_NULL_exp ( a ) ) {
156
			bs = enc_compound_stmt ( bs, a ) ;
157
		    }
158
		    p = TAIL_list ( p ) ;
159
		}
160
		break ;
161
	    }
162
	    case exp_location_tag : {
163
		/* Location statements */
164
		EXP a = DEREF_exp ( exp_location_arg ( e ) ) ;
165
		if ( !IS_NULL_exp ( a ) ) {
166
		    if ( is_diag_stmt ( a ) ) {
167
			BITSTREAM *ts = enc_diag_begin ( &bs ) ;
168
			ts = enc_stmt ( ts, a ) ;
169
			bs = enc_diag_end ( bs, ts, a, 1 ) ;
170
		    } else {
171
			bs = enc_compound_stmt ( bs, a ) ;
172
		    }
173
		}
174
		crt_enc_loc = exp_location_end ( e ) ;
175
		break ;
176
	    }
177
	    case exp_reach_tag :
178
	    case exp_unreach_tag : {
179
		/* Flow control statement */
180
		EXP a = DEREF_exp ( exp_reach_etc_body ( e ) ) ;
181
		bs = enc_compound_stmt ( bs, a ) ;
182
		break ;
183
	    }
184
	    case exp_set_tag :
185
	    case exp_unused_tag : {
186
		/* Variable flow statements */
187
		break ;
188
	    }
189
	    default : {
190
		/* Other statements */
191
		bs = enc_stmt ( bs, e ) ;
192
		break ;
193
	    }
194
	}
195
    }
196
    return ( bs ) ;
197
}
198
 
199
 
200
/*
201
    ENCODE A LIST OF DESTRUCTORS
202
 
203
    This routine adds all the destructors and pseudo-destructors called
204
    by a jump from e to d to the bitstream bs.
205
*/
206
 
207
static BITSTREAM *enc_destructors
208
    PROTO_N ( ( bs, e, d ) )
209
    PROTO_T ( BITSTREAM *bs X EXP e X EXP d )
210
{
211
    unsigned long m = no_destructors ;
212
    if ( m && !unreached_code ) {
213
	unsigned long n = 0 ;
214
	unsigned long extra = 0 ;
215
#if LANGUAGE_CPP
216
	unsigned ptag = null_tag ;
217
#endif
218
	BITSTREAM *ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
219
	while ( !EQ_exp ( e, d ) && !IS_NULL_exp ( e ) && n < m ) {
220
	    unsigned tag = TAG_exp ( e ) ;
221
	    if ( tag == exp_decl_stmt_tag ) {
222
		/* Jump out of variable scope */
223
		IDENTIFIER id = DEREF_id ( exp_decl_stmt_id ( e ) ) ;
224
		DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
225
		if ( ds & dspec_auto ) {
226
		    EXP a = DEREF_exp ( id_variable_term ( id ) ) ;
227
		    if ( !IS_NULL_exp ( a ) ) {
228
			/* Destructor found */
229
			ulong v ;
230
			int var = 1 ;
231
			TYPE t = DEREF_type ( id_variable_type ( id ) ) ;
232
			if ( ds & dspec_explicit ) {
233
			    if ( ds & dspec_temp ) var = 4 ;
234
			}
235
			v = unit_no ( ts, id, VAR_tag, 0 ) ;
236
			ts = enc_term_local ( ts, v, NULL_off, 0, t, a, var ) ;
237
			extra++ ;
238
			n++ ;
239
		    }
240
		}
241
	    }
242
#if LANGUAGE_CPP
243
	    /* ... continued */ else if ( tag == exp_try_block_tag ) {
244
		/* Jump out of try block */
245
		if ( ptag != exp_handler_tag ) {
246
		    ulong ex = DEREF_ulong ( exp_try_block_no ( e ) ) ;
247
		    ts = enc_try_end ( ts, ex ) ;
248
		    n++ ;
249
		}
250
	    } else if ( tag == exp_handler_tag ) {
251
		/* Jump out of exception handler */
252
		ts = enc_special ( ts, TOK_except_end ) ;
253
		n++ ;
254
	    }
255
	    ptag = tag ;
256
#endif
257
	    e = get_parent_stmt ( e ) ;
258
	}
259
 
260
	/* Check for exception specifications */
261
#if LANGUAGE_CPP
262
	if ( IS_NULL_exp ( e ) && n < m && in_exception_spec ) {
263
	    ts = enc_try_end ( ts, last_params [ DUMMY_catch ] ) ;
264
	    n++ ;
265
	}
266
#endif
267
 
268
	/* Add destructors to main list */
269
	if ( n ) ENC_SEQUENCE ( bs, n + extra ) ;
270
	bs = join_bitstreams ( bs, ts ) ;
271
    }
272
    return ( bs ) ;
273
}
274
 
275
 
276
/*
277
    ENCODE THE DESTRUCTOR FOR A CONDITION DECLARATION
278
 
279
    If a condition-declaration in a while or for loop has a destructor
280
    then this destructor needs to be called at the completion of the
281
    loop (this is the normal end-of-scope destructor) and just before
282
    the second and subsequent evaluations of the condition.  This
283
    routine adds the latter such destructors for the variable ids to
284
    the bitstream bs
285
*/
286
 
287
static BITSTREAM *enc_while_destr
288
    PROTO_N ( ( bs, ids ) )
289
    PROTO_T ( BITSTREAM *bs X LIST ( IDENTIFIER ) ids )
290
{
291
    while ( !IS_NULL_list ( ids ) ) {
292
	IDENTIFIER id = DEREF_id ( HEAD_list ( ids ) ) ;
293
	EXP d = DEREF_exp ( id_variable_term ( id ) ) ;
294
	if ( !IS_NULL_exp ( d ) ) {
295
	    int var = 1 ;
296
	    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
297
	    TYPE t = DEREF_type ( id_variable_type ( id ) ) ;
298
	    ulong n = unit_no ( bs, id, VAR_tag, 0 ) ;
299
	    ENC_SEQ_SMALL ( bs, 2 ) ;
300
	    if ( ( ds & dspec_explicit ) && ( ds & dspec_temp ) ) {
301
		var = 4 ;
302
	    }
303
	    bs = enc_term_local ( bs, n, NULL_off, 0, t, d, var ) ;
304
	}
305
	ids = TAIL_list ( ids ) ;
306
    }
307
    return ( bs ) ;
308
}
309
 
310
 
311
/*
312
    ENCODE A LABELLED STATEMENT
313
 
314
    This routine adds the labelled statement 'e' to the bitstream bs.
315
*/
316
 
317
static BITSTREAM *enc_label_stmt
318
    PROTO_N ( ( bs, e ) )
319
    PROTO_T ( BITSTREAM *bs X EXP e )
320
{
321
    EXP a = DEREF_exp ( exp_label_stmt_body ( e ) ) ;
322
    IDENTIFIER lab = DEREF_id ( exp_label_stmt_label ( e ) ) ;
323
    IDENTIFIER flab = DEREF_id ( id_alias ( lab ) ) ;
324
    if ( EQ_id ( lab, flab ) ) {
325
	/* Simple label */
326
	ulong n = DEREF_ulong ( id_no ( flab ) ) ;
327
	if ( n == LINK_NONE ) {
328
	    /* Label not previously output */
329
	    DECL_SPEC info = DEREF_dspec ( id_storage ( flab ) ) ;
330
	    if ( info & dspec_used ) {
331
		n = unit_no ( bs, flab, VAR_label, 1 ) ;
332
		ENC_repeat ( bs ) ;
333
		ENC_make_label ( bs, n ) ;
334
		ENC_make_top ( bs ) ;
335
		unreached_code = 0 ;
336
		bs = enc_stmt ( bs, a ) ;
337
		clear_no ( flab ) ;
338
	    } else {
339
		bs = enc_stmt ( bs, a ) ;
340
	    }
341
	} else {
342
	    /* Label body output separately */
343
	    ENC_goto ( bs ) ;
344
	    ENC_make_label ( bs, n ) ;
345
	    unreached_code = 1 ;
346
	}
347
    } else {
348
	/* Label alias */
349
	bs = enc_stmt ( bs, a ) ;
350
    }
351
    return ( bs ) ;
352
}
353
 
354
 
355
/*
356
    ADD A LABEL TO A LIST
357
 
358
    This routine adds the label lab to the list q if it has not been
359
    output in bitstream bs and is not already a member of the list.
360
*/
361
 
362
static LIST ( IDENTIFIER ) add_label
363
    PROTO_N ( ( bs, lab, q ) )
364
    PROTO_T ( BITSTREAM *bs X IDENTIFIER lab X LIST ( IDENTIFIER ) q )
365
{
366
    if ( !IS_NULL_id ( lab ) ) {
367
	IDENTIFIER flab = DEREF_id ( id_alias ( lab ) ) ;
368
	ulong n = DEREF_ulong ( id_no ( flab ) ) ;
369
	if ( n == LINK_NONE ) {
370
	    /* Not previously output */
371
	    IGNORE unit_no ( bs, flab, VAR_label, 1 ) ;
372
	    CONS_id ( flab, q, q ) ;
373
	}
374
    }
375
    return ( q ) ;
376
}
377
 
378
 
379
/*
380
    ADD A NUMBER OF LABELS TO A LIST
381
 
382
    This routine adds the those labels in the list p which have not been
383
    output in bitstream bs to the list q.
384
*/
385
 
386
static LIST ( IDENTIFIER ) add_labels
387
    PROTO_N ( ( bs, p, q ) )
388
    PROTO_T ( BITSTREAM *bs X LIST ( IDENTIFIER ) p X LIST ( IDENTIFIER ) q )
389
{
390
    while ( !IS_NULL_list ( p ) ) {
391
	IDENTIFIER lab = DEREF_id ( HEAD_list ( p ) ) ;
392
	q = add_label ( bs, lab, q ) ;
393
	p = TAIL_list ( p ) ;
394
    }
395
    return ( q ) ;
396
}
397
 
398
 
399
/*
400
    ENCODE THE START OF A LABELLED STATEMENT
401
 
402
    This routine adds the start of a labelled statement for the labels
403
    lbs to the bitstream bs.  This comprises outputting the list of
404
    labels.  vars gives a list of variable declarations which need to
405
    be moved outside the labelled statement.
406
*/
407
 
408
static BITSTREAM *enc_labelled_start
409
    PROTO_N ( ( bs, lbs, vars ) )
410
    PROTO_T ( BITSTREAM *bs X LIST ( IDENTIFIER ) lbs X
411
	      LIST ( IDENTIFIER ) vars )
412
{
413
    unsigned nl = LENGTH_list ( lbs ) ;
414
    while ( !IS_NULL_list ( vars ) ) {
415
	/* Declare variables */
416
	IDENTIFIER id = DEREF_id ( HEAD_list ( vars ) ) ;
417
	DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
418
	if ( !( ds & dspec_reserve ) || !is_anon_member ( id ) ) {
419
	    int var = 2 ;
420
	    EXP d = NULL_exp ;
421
	    if ( ( ds & dspec_explicit ) && ( ds & dspec_temp ) ) {
422
		var = 4 ;
423
	    }
424
	    bs = enc_variable ( bs, id, var, &d, NULL_exp ) ;
425
	    if ( !IS_NULL_exp ( d ) ) no_destructors++ ;
426
	}
427
	vars = TAIL_list ( vars ) ;
428
    }
429
    if ( nl == 0 ) {
430
	/* No labels */
431
	/* EMPTY */
432
    } else if ( nl == 1 ) {
433
	/* Single label can be mapped to conditional */
434
	IDENTIFIER lab = DEREF_id ( HEAD_list ( lbs ) ) ;
435
	ulong n = unit_no ( bs, lab, VAR_label, 1 ) ;
436
	ENC_conditional ( bs ) ;
437
	ENC_make_label ( bs, n ) ;
438
    } else {
439
	/* Multiple labels require labelled */
440
	ENC_labelled ( bs ) ;
441
	ENC_LIST ( bs, nl ) ;
442
	while ( !IS_NULL_list ( lbs ) ) {
443
	    IDENTIFIER lab = DEREF_id ( HEAD_list ( lbs ) ) ;
444
	    ulong n = unit_no ( bs, lab, VAR_label, 1 ) ;
445
	    ENC_make_label ( bs, n ) ;
446
	    lbs = TAIL_list ( lbs ) ;
447
	}
448
    }
449
    return ( bs ) ;
450
}
451
 
452
 
453
/*
454
    ENCODE A BRANCH OF A LABELLED STATEMENT
455
 
456
    This routine adds the branch of the labelled statement d corresponding
457
    to the label lab to the bitstream bs.  Note that each such branch is
458
    terminated by a jump to an immediately following label, a jump to an
459
    enclosing break or continue label, or by falling through to the end
460
    of the labelled statement (see end_solve_branch).
461
*/
462
 
463
static BITSTREAM *enc_labelled_branch
464
    PROTO_N ( ( bs, lab, d ) )
465
    PROTO_T ( BITSTREAM *bs X IDENTIFIER lab X EXP d )
466
{
467
    ulong n ;
468
    IDENTIFIER nlab ;
469
    EXP e = DEREF_exp ( id_label_stmt ( lab ) ) ;
470
    EXP f = e ;
471
    EXP g = NULL_exp ;
472
 
473
    /* Examine label type */
474
    int op = DEREF_int ( id_label_op ( lab ) ) ;
475
    switch ( op ) {
476
 
477
	case lex_while :
478
	case lex_for : {
479
	    /* While or for label */
480
	    e = DEREF_exp ( exp_label_stmt_parent ( e ) ) ;
481
	    nlab = DEREF_id ( exp_while_stmt_cont_lab ( e ) ) ;
482
	    e = DEREF_exp ( exp_while_stmt_body ( e ) ) ;
483
	    if ( is_diag_stmt ( e ) ) g = e ;
484
	    break ;
485
	}
486
 
487
	case lex_do : {
488
	    /* Do label */
489
	    e = DEREF_exp ( exp_label_stmt_parent ( e ) ) ;
490
	    nlab = DEREF_id ( exp_do_stmt_cont_lab ( e ) ) ;
491
	    e = DEREF_exp ( exp_do_stmt_body ( e ) ) ;
492
	    if ( is_diag_stmt ( e ) ) g = e ;
493
	    break ;
494
	}
495
 
496
	case lex_if : {
497
	    /* Conditional label */
498
	    EXP c ;
499
	    int sw = 0 ;
500
	    nlab = DEREF_id ( exp_label_stmt_next ( e ) ) ;
501
	    e = DEREF_exp ( exp_label_stmt_parent ( e ) ) ;
502
	    c = DEREF_exp ( exp_if_stmt_cond ( e ) ) ;
503
	    IGNORE simplify_cond ( c, &sw ) ;
504
	    if ( sw ) {
505
		e = DEREF_exp ( exp_if_stmt_true_code ( e ) ) ;
506
	    } else {
507
		e = DEREF_exp ( exp_if_stmt_false_code ( e ) ) ;
508
	    }
509
	    if ( is_diag_stmt ( e ) ) g = e ;
510
	    break ;
511
	}
512
 
513
	case lex_continue : {
514
	    /* Continue label */
515
	    EXP c ;
516
	    unsigned m ;
517
	    IDENTIFIER rlab ;
518
	    LIST ( IDENTIFIER ) cids ;
519
	    EXP b = DEREF_exp ( exp_label_stmt_body ( e ) ) ;
520
	    e = DEREF_exp ( exp_label_stmt_parent ( e ) ) ;
521
	    if ( IS_exp_while_stmt ( e ) ) {
522
		c = DEREF_exp ( exp_while_stmt_cond ( e ) ) ;
523
		rlab = DEREF_id ( exp_while_stmt_loop_lab ( e ) ) ;
524
		nlab = DEREF_id ( exp_while_stmt_break_lab ( e ) ) ;
525
		cids = DEREF_list ( exp_while_stmt_cond_id ( e ) ) ;
526
	    } else {
527
		c = DEREF_exp ( exp_do_stmt_cond ( e ) ) ;
528
		rlab = DEREF_id ( exp_do_stmt_loop_lab ( e ) ) ;
529
		nlab = DEREF_id ( exp_do_stmt_break_lab ( e ) ) ;
530
		cids = NULL_list ( IDENTIFIER ) ;
531
	    }
532
	    m = stmt_length ( b ) ;
533
	    ENC_SEQUENCE ( bs, m + 1 ) ;
534
	    if ( m ) bs = enc_compound_stmt ( bs, b ) ;
535
 
536
	    /* Output conditional jump */
537
	    n = unit_no ( bs, rlab, VAR_label, 0 ) ;
538
	    if ( !IS_NULL_list ( cids ) ) {
539
		bs = enc_while_destr ( bs, cids ) ;
540
	    }
541
	    bs = enc_condition ( bs, c, LINK_NONE, n ) ;
542
	    n = unit_no ( bs, nlab, VAR_label, 0 ) ;
543
	    ENC_goto ( bs ) ;
544
	    ENC_make_label ( bs, n ) ;
545
	    unreached_code = 1 ;
546
	    return ( bs ) ;
547
	}
548
 
549
	default : {
550
	    /* Other labels */
551
	    if ( !IS_NULL_exp ( e ) ) {
552
		if ( is_diag_stmt ( e ) ) g = e ;
553
		nlab = DEREF_id ( exp_label_stmt_next ( e ) ) ;
554
		e = DEREF_exp ( exp_label_stmt_body ( e ) ) ;
555
	    } else {
556
		nlab = NULL_id ;
557
	    }
558
	    break ;
559
	}
560
    }
561
 
562
    /* Output label body */
563
    if ( IS_NULL_id ( nlab ) ) {
564
	/* Fall through to end of labelled statement */
565
	if ( no_destructors ) {
566
	    if ( !IS_NULL_exp ( e ) ) {
567
		ENC_SEQ_SMALL ( bs, 1 ) ;
568
		if ( !IS_NULL_exp ( g ) ) {
569
		    BITSTREAM *ts = enc_diag_begin ( &bs ) ;
570
		    ts = enc_stmt ( ts, e ) ;
571
		    bs = enc_diag_end ( bs, ts, g, 1 ) ;
572
		} else {
573
		    bs = enc_stmt ( bs, e ) ;
574
		}
575
	    }
576
	    bs = enc_destructors ( bs, f, d ) ;
577
	    ENC_make_top ( bs ) ;
578
	} else {
579
	    if ( !IS_NULL_exp ( g ) ) {
580
		BITSTREAM *ts = enc_diag_begin ( &bs ) ;
581
		ts = enc_stmt ( ts, e ) ;
582
		bs = enc_diag_end ( bs, ts, g, 1 ) ;
583
	    } else {
584
		bs = enc_stmt ( bs, e ) ;
585
	    }
586
	}
587
    } else {
588
	/* Jump to following label */
589
	if ( !IS_NULL_exp ( e ) ) {
590
	    ENC_SEQ_SMALL ( bs, 1 ) ;
591
	    if ( !IS_NULL_exp ( g ) ) {
592
		BITSTREAM *ts = enc_diag_begin ( &bs ) ;
593
		ts = enc_stmt ( ts, e ) ;
594
		bs = enc_diag_end ( bs, ts, g, 1 ) ;
595
	    } else {
596
		bs = enc_stmt ( bs, e ) ;
597
	    }
598
	}
599
	op = DEREF_int ( id_label_op ( nlab ) ) ;
600
	if ( op == lex_break || op == lex_continue ) {
601
	    /* Need to call destructors for jump */
602
	    EXP b = DEREF_exp ( id_label_stmt ( nlab ) ) ;
603
	    b = DEREF_exp ( exp_label_stmt_parent ( b ) ) ;
604
	    bs = enc_destructors ( bs, f, b ) ;
605
	}
606
	n = unit_no ( bs, nlab, VAR_label, 0 ) ;
607
	ENC_goto ( bs ) ;
608
	ENC_make_label ( bs, n ) ;
609
	unreached_code = 1 ;
610
    }
611
    return ( bs ) ;
612
}
613
 
614
 
615
/*
616
    ENCODE THE END OF A LABELLED STATEMENT
617
 
618
    This routine adds the end of the labelled statement e to the bitstream
619
    bs.  This comprises outputting the list of label bodies for the labels
620
    lbs and then taking the labels and the variables vars out of scope.
621
*/
622
 
623
static BITSTREAM *enc_labelled_end
624
    PROTO_N ( ( bs, lbs, vars, e ) )
625
    PROTO_T ( BITSTREAM *bs X LIST ( IDENTIFIER ) lbs X
626
	      LIST ( IDENTIFIER ) vars X EXP e )
627
{
628
    int uc = unreached_code ;
629
    unsigned nl = LENGTH_list ( lbs ) ;
630
    if ( nl == 0 ) {
631
	/* No labels */
632
	/* EMPTY */
633
    } else if ( nl == 1 ) {
634
	/* Single label */
635
	IDENTIFIER lab = DEREF_id ( HEAD_list ( lbs ) ) ;
636
	unreached_code = 0 ;
637
	bs = enc_labelled_branch ( bs, lab, e ) ;
638
	if ( !unreached_code ) uc = 0 ;
639
	clear_no ( lab ) ;
640
    } else {
641
	/* Multiple labels */
642
	LIST ( IDENTIFIER ) p = lbs ;
643
	ENC_LIST ( bs, nl ) ;
644
	while ( !IS_NULL_list ( p ) ) {
645
	    IDENTIFIER lab = DEREF_id ( HEAD_list ( p ) ) ;
646
	    unreached_code = 0 ;
647
	    bs = enc_labelled_branch ( bs, lab, e ) ;
648
	    if ( !unreached_code ) uc = 0 ;
649
	    p = TAIL_list ( p ) ;
650
	}
651
	p = lbs ;
652
	while ( !IS_NULL_list ( p ) ) {
653
	    IDENTIFIER lab = DEREF_id ( HEAD_list ( p ) ) ;
654
	    clear_no ( lab ) ;
655
	    p = TAIL_list ( p ) ;
656
	}
657
    }
658
    while ( !IS_NULL_list ( vars ) ) {
659
	/* Take variables out of scope */
660
	IDENTIFIER id = DEREF_id ( HEAD_list ( vars ) ) ;
661
	DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
662
	if ( ds & dspec_auto ) clear_no ( id ) ;
663
	vars = TAIL_list ( vars ) ;
664
    }
665
    unreached_code = uc ;
666
    return ( bs ) ;
667
}
668
 
669
 
670
/*
671
    CURRENT ENCODING LOCATION
672
 
673
    This location is used to store the current location during the
674
    encoding of statements.
675
*/
676
 
677
PTR ( LOCATION ) crt_enc_loc = NULL_ptr ( LOCATION ) ;
678
 
679
 
680
/*
681
    ENCODE A DECLARATION STATEMENT
682
 
683
    This routine adds the declaration statement e to the bitstream bs.
684
*/
685
 
686
static BITSTREAM *enc_decl_stmt
687
    PROTO_N ( ( bs, e ) )
688
    PROTO_T ( BITSTREAM *bs X EXP e )
689
{
690
    int var = 1 ;
691
    int scope = 0 ;
692
    BITSTREAM *ts ;
693
    ulong nlabs = 0 ;
694
    EXP d = NULL_exp ;
695
    int diag = output_diag ;
696
    EXP a = DEREF_exp ( exp_decl_stmt_body ( e ) ) ;
697
    IDENTIFIER id = DEREF_id ( exp_decl_stmt_id ( e ) ) ;
698
    TYPE t = DEREF_type ( id_variable_type ( id ) ) ;
699
    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
700
    if ( !( ds & dspec_reserve ) || !is_anon_member ( id ) ) {
701
	EXP b = DEREF_exp ( id_variable_init ( id ) ) ;
702
	if ( IS_NULL_exp ( b ) || !output_diag ) {
703
	    /* Don't output diagnostics */
704
	    e = NULL_exp ;
705
	}
706
	if ( ds & dspec_explicit ) {
707
	    /* Only declare explicitly initialised variables */
708
	    if ( ds & dspec_temp ) {
709
		nlabs = no_labels ( bs ) ;
710
		e = NULL_exp ;
711
		var = 4 ;
712
	    } else {
713
		var = 3 ;
714
	    }
715
	}
716
	if ( ds & dspec_done ) {
717
	    /* Variable previously declared */
718
	    int dummy = 0 ;
719
	    EXP d1 = DEREF_exp ( id_variable_term ( id ) ) ;
720
	    if ( !IS_NULL_exp ( d1 ) ) {
721
		/* Allow for terminator expressions */
722
		if ( output_except ) {
723
		    while ( IS_exp_nof ( d1 ) ) {
724
			d1 = DEREF_exp ( exp_nof_pad ( d1 ) ) ;
725
		    }
726
		    if ( IS_NULL_exp ( b ) && var == 1 ) {
727
			/* Force initialisation */
728
			b = make_dummy_init ( t ) ;
729
			dummy = 1 ;
730
		    }
731
		} else {
732
		    d1 = NULL_exp ;
733
		}
734
	    }
735
	    if ( !IS_NULL_exp ( b ) ) {
736
		ulong n = unit_no ( bs, id, VAR_tag, 0 ) ;
737
		bs = enc_assign_local ( bs, b, d1, n, t, e ) ;
738
		if ( IS_exp_thrown ( b ) && output_new_diag ) diag = 0 ;
739
		if ( dummy ) free_exp ( b, 1 ) ;
740
	    }
741
	} else {
742
	    /* Variable not previously declared */
743
	    bs = enc_variable ( bs, id, var, &d, e ) ;
744
	    if ( ds & dspec_auto ) scope = 1 ;
745
	}
746
    }
747
    if ( diag && !( ds & dspec_temp ) ) {
748
	HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
749
	if ( !IS_hashid_anon ( nm ) ) {
750
	    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
751
	} else {
752
	    ts = bs ;
753
	    diag = 0 ;
754
	}
755
    } else {
756
	ts = bs ;
757
	diag = 0 ;
758
    }
759
    if ( IS_NULL_exp ( d ) ) {
760
	ts = enc_stmt ( ts, a ) ;
761
    } else {
762
	unsigned seq = stmt_length ( a ) + 1 ;
763
	no_destructors++ ;
764
	ENC_SEQUENCE ( ts, seq ) ;
765
	ts = enc_compound_stmt ( ts, a ) ;
766
	if ( unreached_code ) {
767
	    ENC_make_top ( ts ) ;
768
	    ENC_make_top ( ts ) ;
769
	} else {
770
	    ulong n = unit_no ( ts, id, VAR_tag, 0 ) ;
771
	    if ( var == 4 && nlabs == no_labels ( bs ) ) var = 3 ;
772
	    ts = enc_term_local ( ts, n, NULL_off, 0, t, d, var ) ;
773
	}
774
	no_destructors-- ;
775
    }
776
    if ( diag ) {
777
	bs = enc_diag_local ( bs, id, ts ) ;
778
    } else {
779
	bs = ts ;
780
    }
781
    if ( scope ) {
782
	/* Take variable out of scope */
783
	clear_no ( id ) ;
784
    }
785
    return ( bs ) ;
786
}
787
 
788
 
789
/*
790
    ENCODE A TDF BODY STATEMENT
791
 
792
    This routine is identical to enc_stmt except that it makes explicit
793
    provision for diagnostic information.
794
*/
795
 
796
static BITSTREAM *enc_body_stmt
797
    PROTO_N ( ( bs, e ) )
798
    PROTO_T ( BITSTREAM *bs X EXP e )
799
{
800
    if ( output_diag && is_diag_stmt ( e ) ) {
801
	BITSTREAM *ts = enc_diag_begin ( &bs ) ;
802
	ts = enc_stmt ( ts, e ) ;
803
	bs = enc_diag_end ( bs, ts, e, 1 ) ;
804
    } else {
805
	bs = enc_stmt ( bs, e ) ;
806
    }
807
    return ( bs ) ;
808
}
809
 
810
 
811
/*
812
    ENCODE A TDF STATEMENT
813
 
814
    This routine adds the statement e to the bitstream bs as a TDF EXP.
815
*/
816
 
817
BITSTREAM *enc_stmt
818
    PROTO_N ( ( bs, e ) )
819
    PROTO_T ( BITSTREAM *bs X EXP e )
820
{
821
    if ( IS_NULL_exp ( e ) ) {
822
	/* Deal with null expressions */
823
	ENC_make_top ( bs ) ;
824
	return ( bs ) ;
825
    }
826
 
827
    /* Examine expression cases */
828
    switch ( TAG_exp ( e ) ) {
829
 
830
	case exp_sequence_tag : {
831
	    /* Sequences of statements */
832
	    unsigned n = stmt_length ( e ) ;
833
	    if ( n == 0 ) {
834
		ENC_make_top ( bs ) ;
835
	    } else {
836
		if ( n > 1 ) ENC_SEQUENCE ( bs, n - 1 ) ;
837
		bs = enc_compound_stmt ( bs, e ) ;
838
	    }
839
	    break ;
840
	}
841
 
842
	case exp_solve_stmt_tag : {
843
	    /* Solve statements */
844
	    LIST ( IDENTIFIER ) p ;
845
	    EXP a = DEREF_exp ( exp_solve_stmt_body ( e ) ) ;
846
	    p = DEREF_list ( exp_solve_stmt_labels ( e ) ) ;
847
	    if ( IS_NULL_list ( p ) ) {
848
		/* No labels */
849
		bs = enc_stmt ( bs, a ) ;
850
	    } else {
851
		LIST ( IDENTIFIER ) lbs ;
852
		LIST ( IDENTIFIER ) vars ;
853
		ulong nd = no_destructors ;
854
		lbs = add_labels ( bs, p, NULL_list ( IDENTIFIER ) ) ;
855
		vars = DEREF_list ( exp_solve_stmt_vars ( e ) ) ;
856
		bs = enc_labelled_start ( bs, lbs, vars ) ;
857
		bs = enc_stmt ( bs, a ) ;
858
		bs = enc_labelled_end ( bs, lbs, vars, e ) ;
859
		DESTROY_list ( lbs, SIZE_id ) ;
860
		no_destructors = nd ;
861
	    }
862
	    break ;
863
	}
864
 
865
	case exp_decl_stmt_tag : {
866
	    /* Variable declarations */
867
	    bs = enc_decl_stmt ( bs, e ) ;
868
	    break ;
869
	}
870
 
871
	case exp_while_stmt_tag : {
872
	    /* 'while' and 'for' statements */
873
	    EXP d ;
874
	    int uc ;
875
	    unsigned m ;
876
	    ulong an, bn ;
877
	    DECL_SPEC ds ;
878
	    LIST ( IDENTIFIER ) cids ;
879
	    EXP c = DEREF_exp ( exp_while_stmt_cond ( e ) ) ;
880
	    EXP a = DEREF_exp ( exp_while_stmt_body ( e ) ) ;
881
	    IDENTIFIER lab = DEREF_id ( exp_while_stmt_break_lab ( e ) ) ;
882
	    IDENTIFIER loop = DEREF_id ( exp_while_stmt_loop_lab ( e ) ) ;
883
	    cids = DEREF_list ( exp_while_stmt_cond_id ( e ) ) ;
884
 
885
	    /* Check for labelled statements */
886
	    an = DEREF_ulong ( id_no ( loop ) ) ;
887
	    if ( an != LINK_NONE ) {
888
		bn = unit_no ( bs, lab, VAR_label, 0 ) ;
889
		an = unit_no ( bs, loop, VAR_label, 0 ) ;
890
		ENC_SEQ_SMALL ( bs, 1 ) ;
891
		bs = enc_condition ( bs, c, bn, LINK_NONE ) ;
892
		ENC_goto ( bs ) ;
893
		ENC_make_label ( bs, an ) ;
894
		unreached_code = 1 ;
895
		break ;
896
	    }
897
 
898
	    /* Encode the start of the loop */
899
	    bn = unit_no ( bs, lab, VAR_label, 1 ) ;
900
	    an = unit_no ( bs, loop, VAR_label, 1 ) ;
901
	    ENC_conditional ( bs ) ;
902
	    ENC_make_label ( bs, bn ) ;
903
	    ENC_SEQ_SMALL ( bs, 1 ) ;
904
	    bs = enc_condition ( bs, c, bn, LINK_NONE ) ;
905
	    ENC_repeat ( bs ) ;
906
	    ENC_make_label ( bs, an ) ;
907
	    ENC_make_top ( bs ) ;
908
	    uc = unreached_code ;
909
 
910
	    /* Check for continue jump */
911
	    ENC_SEQ_SMALL ( bs, 1 ) ;
912
	    lab = DEREF_id ( exp_while_stmt_cont_lab ( e ) ) ;
913
	    ds = DEREF_dspec ( id_storage ( lab ) ) ;
914
	    if ( ds & dspec_used ) {
915
		/* Body contains a continue jump */
916
		ulong cn = unit_no ( bs, lab, VAR_label, 1 ) ;
917
		ENC_conditional ( bs ) ;
918
		ENC_make_label ( bs, cn ) ;
919
		bs = enc_body_stmt ( bs, a ) ;
920
		ENC_make_top ( bs ) ;
921
	    } else {
922
		/* No continue jump */
923
		bs = enc_body_stmt ( bs, a ) ;
924
	    }
925
 
926
	    /* Encode end of label */
927
	    d = DEREF_exp ( id_label_stmt ( lab ) ) ;
928
	    d = DEREF_exp ( exp_label_stmt_body ( d ) ) ;
929
	    m = stmt_length ( d ) ;
930
	    if ( m ) {
931
		ENC_SEQUENCE ( bs, m ) ;
932
		bs = enc_compound_stmt ( bs, d ) ;
933
	    }
934
	    if ( !IS_NULL_list ( cids ) ) {
935
		bs = enc_while_destr ( bs, cids ) ;
936
	    }
937
	    bs = enc_condition ( bs, c, LINK_NONE, an ) ;
938
	    ENC_make_top ( bs ) ;
939
	    if ( !uc ) unreached_code = 0 ;
940
	    clear_no ( loop ) ;
941
	    clear_no ( lab ) ;
942
	    break ;
943
	}
944
 
945
	case exp_do_stmt_tag : {
946
	    /* 'do' statements */
947
	    ulong an ;
948
	    DECL_SPEC ds ;
949
	    int have_break = 0 ;
950
	    EXP c = DEREF_exp ( exp_do_stmt_cond ( e ) ) ;
951
	    EXP a = DEREF_exp ( exp_do_stmt_body ( e ) ) ;
952
	    IDENTIFIER lab = DEREF_id ( exp_do_stmt_break_lab ( e ) ) ;
953
	    IDENTIFIER loop = DEREF_id ( exp_do_stmt_loop_lab ( e ) ) ;
954
 
955
	    /* Check for labelled statements */
956
	    an = DEREF_ulong ( id_no ( loop ) ) ;
957
	    if ( an != LINK_NONE ) {
958
		an = unit_no ( bs, loop, VAR_label, 0 ) ;
959
		ENC_goto ( bs ) ;
960
		ENC_make_label ( bs, an ) ;
961
		unreached_code = 1 ;
962
		break ;
963
	    }
964
 
965
	    /* Check for break label */
966
	    ds = DEREF_dspec ( id_storage ( lab ) ) ;
967
	    if ( ds & dspec_used ) {
968
		ulong bn = unit_no ( bs, lab, VAR_label, 1 ) ;
969
		ENC_conditional ( bs ) ;
970
		ENC_make_label ( bs, bn ) ;
971
		have_break = 1 ;
972
	    }
973
 
974
	    /* Encode the start of the loop */
975
	    an = unit_no ( bs, loop, VAR_label, 1 ) ;
976
	    ENC_repeat ( bs ) ;
977
	    ENC_make_label ( bs, an ) ;
978
	    ENC_make_top ( bs ) ;
979
	    ENC_SEQ_SMALL ( bs, 1 ) ;
980
 
981
	    /* Check for continue label */
982
	    lab = DEREF_id ( exp_do_stmt_cont_lab ( e ) ) ;
983
	    ds = DEREF_dspec ( id_storage ( lab ) ) ;
984
	    if ( ds & dspec_used ) {
985
		ulong cn = unit_no ( bs, lab, VAR_label, 1 ) ;
986
		ENC_conditional ( bs ) ;
987
		ENC_make_label ( bs, cn ) ;
988
		bs = enc_body_stmt ( bs, a ) ;
989
		ENC_make_top ( bs ) ;
990
	    } else {
991
		bs = enc_body_stmt ( bs, a ) ;
992
	    }
993
 
994
	    /* Encode the end of the loop */
995
	    bs = enc_condition ( bs, c, LINK_NONE, an ) ;
996
	    if ( have_break ) {
997
		ENC_make_top ( bs ) ;
998
		unreached_code = 0 ;
999
	    }
1000
	    clear_no ( loop ) ;
1001
	    clear_no ( lab ) ;
1002
	    break ;
1003
	}
1004
 
1005
	case exp_switch_stmt_tag : {
1006
	    /* 'switch' statements */
1007
	    EXP a ;
1008
	    EXP b ;
1009
	    ulong n ;
1010
	    unsigned nc ;
1011
	    LIST ( NAT ) cns ;
1012
	    IDENTIFIER dl, bl ;
1013
	    LIST ( IDENTIFIER ) cls ;
1014
	    LIST ( IDENTIFIER ) lbs ;
1015
	    LIST ( IDENTIFIER ) els ;
1016
	    LIST ( IDENTIFIER ) vars ;
1017
	    unsigned long nd = no_destructors ;
1018
 
1019
	    /* Start labelled statement */
1020
	    b = DEREF_exp ( exp_switch_stmt_body ( e ) ) ;
1021
	    cns = DEREF_list ( exp_switch_stmt_cases ( e ) ) ;
1022
	    cls = DEREF_list ( exp_switch_stmt_case_labs ( e ) ) ;
1023
	    dl = DEREF_id ( exp_switch_stmt_default_lab ( e ) ) ;
1024
	    bl = DEREF_id ( exp_switch_stmt_break_lab ( e ) ) ;
1025
	    els = DEREF_list ( exp_solve_stmt_labels ( b ) ) ;
1026
	    nc = LENGTH_list ( cls ) ;
1027
 
1028
	    /* Create list of labels */
1029
	    vars = DEREF_list ( exp_solve_stmt_vars ( b ) ) ;
1030
	    lbs = add_labels ( bs, cls, NULL_list ( IDENTIFIER ) ) ;
1031
	    lbs = add_label ( bs, dl, lbs ) ;
1032
	    lbs = add_label ( bs, bl, lbs ) ;
1033
	    lbs = add_labels ( bs, els, lbs ) ;
1034
	    lbs = REVERSE_list ( lbs ) ;
1035
	    bs = enc_labelled_start ( bs, lbs, vars ) ;
1036
 
1037
	    /* Encode case jump */
1038
	    ENC_SEQ_SMALL ( bs, 1 ) ;
1039
	    a = DEREF_exp ( exp_switch_stmt_control ( e ) ) ;
1040
	    if ( IS_NULL_list ( cls ) ) {
1041
		/* No cases */
1042
		bs = enc_exp ( bs, a ) ;
1043
	    } else {
1044
		ENC_case ( bs ) ;
1045
		ENC_false ( bs ) ;
1046
		bs = enc_exp ( bs, a ) ;
1047
		ENC_LIST ( bs, nc ) ;
1048
		while ( !IS_NULL_list ( cls ) ) {
1049
		    /* Encode case limbs */
1050
		    NAT cn = DEREF_nat ( HEAD_list ( cns ) ) ;
1051
		    IDENTIFIER cl = DEREF_id ( HEAD_list ( cls ) ) ;
1052
		    n = unit_no ( bs, cl, VAR_label, 0 ) ;
1053
		    ENC_make_label ( bs, n ) ;
1054
		    bs = enc_snat ( bs, cn, 0, 1 ) ;
1055
		    bs = enc_snat ( bs, cn, 0, 1 ) ;
1056
		    cns = TAIL_list ( cns ) ;
1057
		    cls = TAIL_list ( cls ) ;
1058
		}
1059
	    }
1060
 
1061
	    /* Default or break jump */
1062
	    if ( IS_NULL_id ( dl ) ) dl = bl ;
1063
	    n = unit_no ( bs, dl, VAR_label, 0 ) ;
1064
	    ENC_goto ( bs ) ;
1065
	    ENC_make_label ( bs, n ) ;
1066
	    unreached_code = 1 ;
1067
 
1068
	    /* End labelled statement */
1069
	    bs = enc_labelled_end ( bs, lbs, vars, e ) ;
1070
	    DESTROY_list ( lbs, SIZE_id ) ;
1071
	    no_destructors = nd ;
1072
	    break ;
1073
	}
1074
 
1075
	case exp_return_stmt_tag : {
1076
	    /* Return expressions */
1077
	    ulong r = last_params [ DUMMY_return ] ;
1078
	    EXP a = DEREF_exp ( exp_return_stmt_value ( e ) ) ;
1079
	    if ( IS_NULL_exp ( a ) ) {
1080
		/* Plain return */
1081
		bs = enc_destructors ( bs, e, NULL_exp ) ;
1082
		ENC_return ( bs ) ;
1083
		ENC_make_top ( bs ) ;
1084
	    } else if ( r != LINK_NONE ) {
1085
		/* Reference return */
1086
		ENC_SEQ_SMALL ( bs, 1 ) ;
1087
		if ( r == LINK_ZERO ) {
1088
		    bs = enc_exp ( bs, a ) ;
1089
		} else {
1090
		    OFFSET off = NULL_off ;
1091
		    TYPE t = DEREF_type ( exp_type ( a ) ) ;
1092
		    bs = enc_init_tag ( bs, r, off, 1, t, a, NULL_exp, 0 ) ;
1093
		}
1094
		bs = enc_destructors ( bs, e, NULL_exp ) ;
1095
		ENC_return ( bs ) ;
1096
		ENC_make_top ( bs ) ;
1097
	    } else {
1098
		if ( no_destructors ) {
1099
		    /* Return with destructors */
1100
		    if ( is_const_exp ( a, -1 ) ) {
1101
			bs = enc_destructors ( bs, e, NULL_exp ) ;
1102
			ENC_return ( bs ) ;
1103
			bs = enc_exp ( bs, a ) ;
1104
		    } else {
1105
			ulong n = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
1106
			ENC_identify ( bs ) ;
1107
			bs = enc_access ( bs, dspec_none ) ;
1108
			ENC_make_tag ( bs, n ) ;
1109
			bs = enc_exp ( bs, a ) ;
1110
			bs = enc_destructors ( bs, e, NULL_exp ) ;
1111
			ENC_return ( bs ) ;
1112
			ENC_obtain_tag ( bs ) ;
1113
			ENC_make_tag ( bs, n ) ;
1114
		    }
1115
		} else {
1116
		    /* Simple return */
1117
		    ENC_return ( bs ) ;
1118
		    bs = enc_exp ( bs, a ) ;
1119
		}
1120
	    }
1121
	    unreached_code = 1 ;
1122
	    break ;
1123
	}
1124
 
1125
	case exp_goto_stmt_tag : {
1126
	    /* Goto expressions */
1127
	    EXP a = DEREF_exp ( exp_goto_stmt_join ( e ) ) ;
1128
	    IDENTIFIER lab = DEREF_id ( exp_goto_stmt_label ( e ) ) ;
1129
	    ulong n = unit_no ( bs, lab, VAR_label, 0 ) ;
1130
	    bs = enc_destructors ( bs, e, a ) ;
1131
	    ENC_goto ( bs ) ;
1132
	    ENC_make_label ( bs, n ) ;
1133
	    unreached_code = 1 ;
1134
	    break ;
1135
	}
1136
 
1137
	case exp_label_stmt_tag : {
1138
	    /* Labelled expressions */
1139
	    if ( is_diag_stmt ( e ) ) {
1140
		IDENTIFIER lab = DEREF_id ( exp_label_stmt_label ( e ) ) ;
1141
		ulong n = DEREF_ulong ( id_no ( lab ) ) ;
1142
		if ( n == LINK_NONE ) {
1143
		    BITSTREAM *ts = enc_diag_begin ( &bs ) ;
1144
		    ts = enc_label_stmt ( ts, e ) ;
1145
		    bs = enc_diag_end ( bs, ts, e, 1 ) ;
1146
		} else {
1147
		    bs = enc_label_stmt ( bs, e ) ;
1148
		}
1149
	    } else {
1150
		bs = enc_label_stmt ( bs, e ) ;
1151
	    }
1152
	    break ;
1153
	}
1154
 
1155
#if LANGUAGE_CPP
1156
	case exp_try_block_tag : {
1157
	    /* Try block */
1158
	    bs = enc_try ( bs, e ) ;
1159
	    break ;
1160
	}
1161
 
1162
	case exp_handler_tag : {
1163
	    /* Exception handler */
1164
	    BITSTREAM *ts ;
1165
	    EXP a = DEREF_exp ( exp_handler_body ( e ) ) ;
1166
	    IDENTIFIER id = DEREF_id ( exp_handler_except ( e ) ) ;
1167
	    if ( !IS_NULL_id ( id ) ) {
1168
		/* Declare exception variable */
1169
		EXP d = NULL_exp ;
1170
		bs = enc_variable ( bs, id, 2, &d, NULL_exp ) ;
1171
		if ( !IS_NULL_exp ( d ) ) no_destructors++ ;
1172
	    }
1173
	    ts = enc_diag_begin ( &bs ) ;
1174
	    ts = enc_stmt ( ts, a ) ;
1175
	    bs = enc_diag_end ( bs, ts, e, 1 ) ;
1176
	    clear_no ( id ) ;
1177
	    break ;
1178
	}
1179
#endif
1180
 
1181
	case exp_location_tag : {
1182
	    /* Location statement */
1183
	    EXP a = DEREF_exp ( exp_location_arg ( e ) ) ;
1184
	    bs = enc_body_stmt ( bs, a ) ;
1185
	    crt_enc_loc = exp_location_end ( e ) ;
1186
	    break ;
1187
	}
1188
 
1189
	case exp_reach_tag :
1190
	case exp_unreach_tag : {
1191
	    /* Flow control statement */
1192
	    EXP a = DEREF_exp ( exp_reach_etc_body ( e ) ) ;
1193
	    bs = enc_stmt ( bs, a ) ;
1194
	    break ;
1195
	}
1196
 
1197
	case exp_if_stmt_tag :
1198
	case exp_hash_if_tag :
1199
	default : {
1200
	    /* Expression statements */
1201
	    bs = enc_stmt_exp ( bs, e, type_void, 0 ) ;
1202
	    break ;
1203
	}
1204
    }
1205
    return ( bs ) ;
1206
}
1207
 
1208
 
1209
/*
1210
    ENCODE A TDF EXPRESSION STATEMENT
1211
 
1212
    This routine adds the expression statement e to the bitstream bs as
1213
    a TDF EXP.  use indicates how the value of the expression is used.
1214
*/
1215
 
1216
BITSTREAM *enc_stmt_exp
1217
    PROTO_N ( ( bs, e, t, use ) )
1218
    PROTO_T ( BITSTREAM *bs X EXP e X TYPE t X int use )
1219
{
1220
    if ( IS_NULL_exp ( e ) ) {
1221
	/* Deal with null expressions */
1222
	ENC_make_top ( bs ) ;
1223
	return ( bs ) ;
1224
    }
1225
 
1226
    /* Examine expression cases */
1227
    switch ( TAG_exp ( e ) ) {
1228
 
1229
	case exp_solve_stmt_tag :
1230
	case exp_decl_stmt_tag :
1231
	case exp_while_stmt_tag :
1232
	case exp_do_stmt_tag :
1233
	case exp_switch_stmt_tag :
1234
	case exp_return_stmt_tag :
1235
	case exp_goto_stmt_tag :
1236
	case exp_label_stmt_tag :
1237
	case exp_try_block_tag :
1238
	case exp_handler_tag : {
1239
	    /* Simple statements */
1240
	    bs = enc_stmt ( bs, e ) ;
1241
	    break ;
1242
	}
1243
 
1244
	case exp_sequence_tag : {
1245
	    /* Lexical blocks */
1246
	    bs = enc_body_stmt ( bs, e ) ;
1247
	    break ;
1248
	}
1249
 
1250
	case exp_if_stmt_tag : {
1251
	    /* Conditional statements */
1252
	    ulong n ;
1253
	    int ua, ub ;
1254
	    int sw = 0 ;
1255
	    int whole = 1 ;
1256
	    ulong m = LINK_NONE ;
1257
	    EXP c = DEREF_exp ( exp_if_stmt_cond ( e ) ) ;
1258
	    EXP a = DEREF_exp ( exp_if_stmt_true_code ( e ) ) ;
1259
	    EXP b = DEREF_exp ( exp_if_stmt_false_code ( e ) ) ;
1260
 
1261
	    /* Check for labelled statements */
1262
	    IDENTIFIER lab = DEREF_id ( exp_if_stmt_label ( e ) ) ;
1263
	    if ( !IS_NULL_id ( lab ) ) {
1264
		n = DEREF_ulong ( id_no ( lab ) ) ;
1265
		if ( n != LINK_NONE ) whole = 0 ;
1266
	    }
1267
	    n = unit_no ( bs, lab, VAR_label, whole ) ;
1268
	    if ( whole ) {
1269
		/* Introduce conditional label */
1270
		ENC_conditional ( bs ) ;
1271
		ENC_make_label ( bs, n ) ;
1272
	    }
1273
	    c = simplify_cond ( c, &sw ) ;
1274
	    if ( sw ) {
1275
		/* Switch conditions */
1276
		EXP d = a ;
1277
		a = b ;
1278
		b = d ;
1279
		m = n ;
1280
		n = LINK_NONE ;
1281
	    }
1282
	    if ( !IS_NULL_exp ( a ) ) {
1283
		ENC_SEQ_SMALL ( bs, 1 ) ;
1284
	    }
1285
	    bs = enc_condition ( bs, c, n, m ) ;
1286
	    ub = unreached_code ;
1287
	    if ( !IS_NULL_exp ( a ) ) {
1288
		bs = enc_stmt_exp ( bs, a, t, use ) ;
1289
	    }
1290
	    ua = unreached_code ;
1291
	    if ( whole ) {
1292
		/* Conditional label body */
1293
		unreached_code = ub ;
1294
		bs = enc_stmt_exp ( bs, b, t, use ) ;
1295
		ub = unreached_code ;
1296
		clear_no ( lab ) ;
1297
	    }
1298
	    unreached_code = ( ua && ub ) ;
1299
	    break ;
1300
	}
1301
 
1302
	case exp_hash_if_tag : {
1303
	    /* Conditional compilations */
1304
	    int ua, ub ;
1305
	    BITSTREAM *ts ;
1306
	    EXP c = DEREF_exp ( exp_hash_if_cond ( e ) ) ;
1307
	    EXP a = DEREF_exp ( exp_hash_if_true_code ( e ) ) ;
1308
	    EXP b = DEREF_exp ( exp_hash_if_false_code ( e ) ) ;
1309
	    ENC_exp_cond ( bs ) ;
1310
	    bs = enc_exp ( bs, c ) ;
1311
	    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1312
	    ub = unreached_code ;
1313
	    ts = enc_stmt_exp ( ts, a, t, use ) ;
1314
	    ua = unreached_code ;
1315
	    bs = enc_bitstream ( bs, ts ) ;
1316
	    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1317
	    unreached_code = ub ;
1318
	    ts = enc_stmt_exp ( ts, b, t, use ) ;
1319
	    ub = unreached_code ;
1320
	    bs = enc_bitstream ( bs, ts ) ;
1321
	    unreached_code = ( ua && ub ) ;
1322
	    break ;
1323
	}
1324
 
1325
	case exp_location_tag : {
1326
	    /* Location statements */
1327
	    EXP a = DEREF_exp ( exp_location_arg ( e ) ) ;
1328
	    BITSTREAM *ts = enc_diag_begin ( &bs ) ;
1329
	    ts = enc_stmt_exp ( ts, a, t, use ) ;
1330
	    crt_enc_loc = exp_location_end ( e ) ;
1331
	    bs = enc_diag_end ( bs, ts, a, 0 ) ;
1332
	    break ;
1333
	}
1334
 
1335
	case exp_comma_tag : {
1336
	    /* Comma expressions */
1337
	    EXP a ;
1338
	    LIST ( EXP ) p = DEREF_list ( exp_comma_args ( e ) ) ;
1339
	    unsigned m = LENGTH_list ( p ) ;
1340
	    if ( m > 1 ) ENC_SEQUENCE ( bs, m - 1 ) ;
1341
	    for ( ; ; ) {
1342
		a = DEREF_exp ( HEAD_list ( p ) ) ;
1343
		p = TAIL_list ( p ) ;
1344
		if ( IS_NULL_list ( p ) ) break ;
1345
		bs = enc_stmt_exp ( bs, a, type_void, 0 ) ;
1346
	    }
1347
	    if ( use != -1 ) {
1348
		bs = enc_stmt_exp ( bs, a, t, use ) ;
1349
	    }
1350
	    break ;
1351
	}
1352
 
1353
	case exp_paren_tag :
1354
	case exp_copy_tag : {
1355
	    /* Parenthesised expressions */
1356
	    EXP a = DEREF_exp ( exp_paren_etc_arg ( e ) ) ;
1357
	    bs = enc_stmt_exp ( bs, a, t, use ) ;
1358
	    break ;
1359
	}
1360
 
1361
	case exp_contents_tag : {
1362
	    /* Contents expressions */
1363
	    if ( use == 0 ) {
1364
		EXP a = DEREF_exp ( exp_contents_ptr ( e ) ) ;
1365
		bs = enc_exp ( bs, a ) ;
1366
		break ;
1367
	    }
1368
	    goto default_lab ;
1369
	}
1370
 
1371
	default :
1372
	default_lab : {
1373
	    /* Simple expressions */
1374
	    switch ( use ) {
1375
		case 2 : {
1376
		    bs = enc_addr_exp ( bs, t, e ) ;
1377
		    break ;
1378
		}
1379
		case 3 : {
1380
		    bs = enc_cont_exp ( bs, t, e ) ;
1381
		    break ;
1382
		}
1383
		default : {
1384
		    bs = enc_exp ( bs, e ) ;
1385
		    break ;
1386
		}
1387
	    }
1388
	    break ;
1389
	}
1390
    }
1391
    return ( bs ) ;
1392
}
1393
 
1394
 
1395
#endif /* TDF_OUTPUT */