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, 1998
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 "ctype_ops.h"
35 
#include "exp_ops.h"
36 
#include "etype_ops.h"
37 
#include "graph_ops.h"
38 
#include "id_ops.h"
39 
#include "nat_ops.h"
40 
#include "off_ops.h"
41 
#include "str_ops.h"
42 
#include "type_ops.h"
43 
#include "virt_ops.h"
44 
#include "error.h"
45 
#include "tdf.h"
46 
#include "assign.h"
47 
#include "basetype.h"
48 
#include "capsule.h"
49 
#include "check.h"
50 
#include "class.h"
51 
#include "compile.h"
52 
#include "constant.h"
53 
#include "convert.h"
54 
#include "derive.h"
55 
#include "destroy.h"
56 
#include "diag.h"
57 
#include "encode.h"
58 
#include "exp.h"
59 
#include "expression.h"
60 
#include "function.h"
61 
#include "identifier.h"
62 
#include "init.h"
63 
#include "literal.h"
64 
#include "member.h"
65 
#include "redeclare.h"
66 
#include "shape.h"
67 
#include "statement.h"
68 
#include "stmt.h"
69 
#include "struct.h"
70 
#include "syntax.h"
71 
#include "tok.h"
72 
#include "throw.h"
73 
#include "ustring.h"
74 
#include "virtual.h"
75 
#if TDF_OUTPUT
76 
 
77 
 
78 
/*
79 
    ENCODE A SMALL TDF INTEGER CONSTANT
80 
 
81 
    This routine adds the small integer n to the bitstream bs as a TDF
82 
    SIGNED_NAT.
83 
*/
84 
 
85 
BITSTREAM *enc_make_snat
86 
    PROTO_N ( ( bs, n ) )
87 
    PROTO_T ( BITSTREAM *bs X int n )
88 
{
89 
    ENC_make_signed_nat ( bs ) ;
90 
    if ( n >= 0 ) {
91 
	ENC_OFF ( bs ) ;
92 
    } else {
93 
	ENC_ON ( bs ) ;
94 
	n = -n ;
95 
    }
96 
    ENC_INT ( bs, n ) ;
97 
    return ( bs ) ;
98 
}
99 
 
100 
 
101 
/*
102 
    ENCODE A SMALL TDF INTEGER
103 
 
104 
    This routine adds the small integer n of type t to the bitstream bs
105 
    as a TDF EXP.
106 
*/
107 
 
108 
BITSTREAM *enc_make_int
109 
    PROTO_N ( ( bs, t, n ) )
110 
    PROTO_T ( BITSTREAM *bs X TYPE t X int n )
111 
{
112 
    ENC_make_int ( bs ) ;
113 
    bs = enc_variety ( bs, t ) ;
114 
    bs = enc_make_snat ( bs, n ) ;
115 
    return ( bs ) ;
116 
}
117 
 
118 
 
119 
/*
120 
    ENCODE A NULL TDF EXPRESSION
121 
 
122 
    This routine adds a null TDF EXP with shape corresponding to the type
123 
    t to the bitstream bs.
124 
*/
125 
 
126 
BITSTREAM *enc_null_exp
127 
    PROTO_N ( ( bs, t ) )
128 
    PROTO_T ( BITSTREAM *bs X TYPE t )
129 
{
130 
    if ( IS_NULL_type ( t ) ) {
131 
	/* This shouldn't happen */
132 
	t = type_sint ;
133 
    }
134 
    switch ( TAG_type ( t ) ) {
135 
	case type_integer_tag :
136 
	case type_enumerate_tag : {
137 
	    /* Integral types */
138 
	    bs = enc_make_int ( bs, t, 0 ) ;
139 
	    break ;
140 
	}
141 
	case type_floating_tag : {
142 
	    /* Floating types */
143 
	    bs = enc_float_int ( bs, 0, t ) ;
144 
	    break ;
145 
	}
146 
	case type_top_tag :
147 
	case type_bottom_tag : {
148 
	    /* Top type */
149 
	    ENC_make_top ( bs ) ;
150 
	    break ;
151 
	}
152 
	case type_ptr_tag :
153 
	case type_ref_tag : {
154 
	    /* Pointer types */
155 
	    TYPE s = DEREF_type ( type_ptr_etc_sub ( t ) ) ;
156 
	    switch ( TAG_type ( s ) ) {
157 
		case type_top_tag :
158 
		case type_bottom_tag : {
159 
		    /* Generic pointer */
160 
		    bs = enc_special ( bs, TOK_null_pv ) ;
161 
		    break ;
162 
		}
163 
		case type_func_tag : {
164 
		    /* Function pointer */
165 
		    ENC_make_null_proc ( bs ) ;
166 
		    break ;
167 
		}
168 
		default : {
169 
		    /* Normal pointer */
170 
		    ENC_make_null_ptr ( bs ) ;
171 
		    bs = enc_alignment ( bs, s ) ;
172 
		    break ;
173 
		}
174 
	    }
175 
	    break ;
176 
	}
177 
	case type_ptr_mem_tag : {
178 
	    /* Pointer to member types */
179 
	    TYPE s = DEREF_type ( type_ptr_mem_sub ( t ) ) ;
180 
	    if ( IS_type_func ( s ) ) {
181 
		if ( in_static_init ) {
182 
		    bs = enc_special ( bs, TOK_pmf_null ) ;
183 
		} else {
184 
		    bs = enc_special ( bs, TOK_pmf_null2 ) ;
185 
		}
186 
	    } else {
187 
		bs = enc_special ( bs, TOK_pm_null ) ;
188 
	    }
189 
	    break ;
190 
	}
191 
	case type_array_tag : {
192 
	    /* Array types */
193 
	    NAT n = DEREF_nat ( type_array_size ( t ) ) ;
194 
	    TYPE s = DEREF_type ( type_array_sub ( t ) ) ;
195 
	    ENC_n_copies ( bs ) ;
196 
	    bs = enc_nat ( bs, n, 1 ) ;
197 
	    bs = enc_null_exp ( bs, s ) ;
198 
	    break ;
199 
	}
200 
	case type_bitfield_tag : {
201 
	    /* Bitfield types */
202 
	    TYPE s = find_bitfield_type ( t ) ;
203 
	    ENC_change_int_to_bitfield ( bs ) ;
204 
	    bs = enc_bfvar ( bs, t ) ;
205 
	    bs = enc_null_exp ( bs, s ) ;
206 
	    break ;
207 
	}
208 
	case type_compound_tag : {
209 
	    /* Compound types */
210 
	    CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
211 
	    TYPE s = DEREF_type ( ctype_form ( ct ) ) ;
212 
	    if ( is_tokenised_class ( s ) ) {
213 
		ENC_make_value ( bs ) ;
214 
		bs = enc_shape ( bs, s ) ;
215 
	    } else {
216 
		bs = enc_null_class ( bs, ct ) ;
217 
	    }
218 
	    break ;
219 
	}
220 
	default : {
221 
	    /* Other types */
222 
	    ENC_make_value ( bs ) ;
223 
	    bs = enc_shape ( bs, t ) ;
224 
	    break ;
225 
	}
226 
    }
227 
    return ( bs ) ;
228 
}
229 
 
230 
 
231 
/*
232 
    CHECK ANONYMOUS UNION MEMBER EXPRESSION
233 
 
234 
    This routine checks whether the identifier expression a arises from a
235 
    member of an anonymous union.  The routine also marks any external
236 
    variables.
237 
*/
238 
 
239 
static int is_anon_exp
240 
    PROTO_N ( ( a ) )
241 
    PROTO_T ( EXP a )
242 
{
243 
    IDENTIFIER id = DEREF_id ( exp_identifier_id ( a ) ) ;
244 
    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
245 
    if ( !( ds & dspec_auto ) ) {
246 
	/* Mark external variables */
247 
	IGNORE capsule_id ( id, VAR_tag ) ;
248 
    }
249 
    if ( ds & dspec_reserve ) {
250 
	/* Check for anonymous union members */
251 
	return ( is_anon_member ( id ) ) ;
252 
    }
253 
    return ( 0 ) ;
254 
}
255 
 
256 
 
257 
/*
258 
    CREATE AN IDENTITY DECLARATION
259 
 
260 
    This routine adds the start of an identity declaration for the
261 
    expression a to the bitstream bs.  The identity body will consist
262 
    of a sequence of seq + 1 expressions.  The identity tag number is
263 
    returned via pn.
264 
*/
265 
 
266 
static BITSTREAM *make_identity
267 
    PROTO_N ( ( bs, a, pn, cnt, seq ) )
268 
    PROTO_T ( BITSTREAM *bs X EXP a X ulong *pn X int cnt X int seq )
269 
{
270 
    ulong n ;
271 
    if ( IS_exp_identifier ( a ) ) {
272 
	/* No identity required in this case */
273 
	IDENTIFIER id = DEREF_id ( exp_identifier_id ( a ) ) ;
274 
	DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
275 
	if ( ( ds & dspec_auto ) && !is_anon_exp ( a ) ) {
276 
	    n = unit_no ( bs, id, VAR_tag, 0 ) ;
277 
	    if ( seq ) ENC_SEQUENCE ( bs, seq ) ;
278 
	    *pn = n ;
279 
	    return ( bs ) ;
280 
	}
281 
    }
282 
    /* Declare new identity */
283 
    n = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
284 
    ENC_identify ( bs ) ;
285 
    bs = enc_access ( bs, crt_func_access ) ;
286 
    ENC_make_tag ( bs, n ) ;
287 
    if ( cnt ) {
288 
	bs = enc_exp ( bs, a ) ;
289 
    } else {
290 
	TYPE t = DEREF_type ( exp_type ( a ) ) ;
291 
	bs = enc_addr_exp ( bs, t, a ) ;
292 
    }
293 
    if ( seq ) ENC_SEQUENCE ( bs, seq ) ;
294 
    *pn = n ;
295 
    return ( bs ) ;
296 
}
297 
 
298 
 
299 
/*
300 
    CREATE A POINTER TO MEMBER FUNCTION TAG
301 
 
302 
    This routine adds the start of an identity or variable declaration
303 
    for the pointer to member function or similar expression a to the
304 
    bitstream bs.  If var is true then a variable declaration is forced.
305 
    The tag number is returned via pn.
306 
*/
307 
 
308 
static BITSTREAM *make_ptr_mem_func
309 
    PROTO_N ( ( bs, a, pn, var ) )
310 
    PROTO_T ( BITSTREAM *bs X EXP a X ulong *pn X int var )
311 
{
312 
    if ( IS_exp_contents ( a ) && !var ) {
313 
	EXP b = DEREF_exp ( exp_contents_ptr ( a ) ) ;
314 
	bs = make_identity ( bs, b, pn, 0, 0 ) ;
315 
    } else {
316 
	ulong n = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
317 
	ENC_variable ( bs ) ;
318 
	bs = enc_access ( bs, crt_func_access ) ;
319 
	ENC_make_tag ( bs, n ) ;
320 
	bs = enc_exp ( bs, a ) ;
321 
	*pn = n ;
322 
    }
323 
    return ( bs ) ;
324 
}
325 
 
326 
 
327 
/*
328 
    ENCODE AN ASSIGNMENT OPERATOR
329 
 
330 
    This routine encodes an assignment operator for an expression of
331 
    type t.  bf is set to true for bitfields.
332 
*/
333 
 
334 
BITSTREAM *enc_assign_op
335 
    PROTO_N ( ( bs, t, bf ) )
336 
    PROTO_T ( BITSTREAM *bs X TYPE t X int *bf )
337 
{
338 
    CV_SPEC cv = DEREF_cv ( type_qual ( t ) ) ;
339 
    if ( IS_type_bitfield ( t ) ) {
340 
	if ( cv & cv_volatile ) {
341 
	    ENC_bitfield_assign_with_mode ( bs ) ;
342 
	    ENC_volatile ( bs ) ;
343 
	} else {
344 
	    ENC_bitfield_assign ( bs ) ;
345 
	}
346 
	*bf = 1 ;
347 
    } else {
348 
	if ( cv & cv_volatile ) {
349 
	    ENC_assign_with_mode ( bs ) ;
350 
	    ENC_volatile ( bs ) ;
351 
	} else {
352 
	    ENC_assign ( bs ) ;
353 
	}
354 
    }
355 
    return ( bs ) ;
356 
}
357 
 
358 
 
359 
/*
360 
    ENCODE THE ADDRESS OF A TDF EXPRESSION
361 
 
362 
    This routine adds the address of the expression e to the bitstream
363 
    bs as a TDF EXP.
364 
*/
365 
 
366 
BITSTREAM *enc_addr_exp
367 
    PROTO_N ( ( bs, t, e ) )
368 
    PROTO_T ( BITSTREAM *bs X TYPE t X EXP e )
369 
{
370 
    ulong n ;
371 
    int anon = 0 ;
372 
    TYPE s = DEREF_type ( exp_type ( e ) ) ;
373 
    switch ( TAG_exp ( e ) ) {
374 
 
375 
	case exp_identifier_tag : {
376 
	    /* Find tag corresponding to identifier */
377 
	    IDENTIFIER id = DEREF_id ( exp_identifier_id ( e ) ) ;
378 
	    anon = is_anon_exp ( e ) ;
379 
	    n = unit_no ( bs, id, VAR_tag, 0 ) ;
380 
	    break ;
381 
	}
382 
 
383 
	case exp_string_lit_tag : {
384 
	    /* Introduce tag for string literal */
385 
	    CV_SPEC qual = cv_none ;
386 
	    STRING str = DEREF_str ( exp_string_lit_str ( e ) ) ;
387 
	    if ( IS_type_ptr ( t ) ) {
388 
		t = DEREF_type ( type_ptr_sub ( t ) ) ;
389 
		qual = DEREF_cv ( type_qual ( t ) ) ;
390 
	    }
391 
	    if ( ( qual & cv_const ) && output_shared ) {
392 
		/* Share const strings */
393 
		n = DEREF_ulong ( str_simple_tok ( str ) ) ;
394 
		if ( n == LINK_NONE ) {
395 
		    n = make_tagdef ( NULL_id, s, e, NULL_exp, 1 ) ;
396 
		    COPY_ulong ( str_simple_tok ( str ), n ) ;
397 
		}
398 
	    } else {
399 
		/* Don't share non-const strings */
400 
		n = make_tagdef ( NULL_id, s, e, NULL_exp, 1 ) ;
401 
	    }
402 
	    n = link_no ( bs, n, VAR_tag ) ;
403 
	    break ;
404 
	}
405 
 
406 
	case exp_indir_tag : {
407 
	    /* Indirections are simple */
408 
	    EXP a = DEREF_exp ( exp_indir_ptr ( e ) ) ;
409 
	    bs = enc_exp ( bs, a ) ;
410 
	    return ( bs ) ;
411 
	}
412 
 
413 
	case exp_assign_tag : {
414 
	    /* Introduce identity for assignment */
415 
	    EXP a = DEREF_exp ( exp_assign_ref ( e ) ) ;
416 
	    EXP b = DEREF_exp ( exp_assign_arg ( e ) ) ;
417 
	    bs = make_identity ( bs, a, &n, 0, 1 ) ;
418 
	    bs = enc_init_tag ( bs, n, NULL_off, 0, s, b, NULL_exp, 0 ) ;
419 
	    break ;
420 
	}
421 
 
422 
	case exp_init_tag : {
423 
	    /* Introduce identity for initialisation */
424 
	    int context = 1 ;
425 
	    unsigned seq = 1 ;
426 
	    IDENTIFIER id = DEREF_id ( exp_init_id ( e ) ) ;
427 
	    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
428 
	    EXP a = DEREF_exp ( exp_init_arg ( e ) ) ;
429 
	    EXP d = DEREF_exp ( id_variable_etc_term ( id ) ) ;
430 
	    if ( !IS_NULL_exp ( d ) ) {
431 
		while ( IS_exp_nof ( d ) ) {
432 
		    d = DEREF_exp ( exp_nof_pad ( d ) ) ;
433 
		}
434 
		seq++ ;
435 
	    }
436 
	    ENC_SEQ_SMALL ( bs, seq ) ;
437 
	    if ( !( ds & dspec_auto ) ) {
438 
		/* Allow for external variables */
439 
		if ( capsule_id ( id, VAR_tag ) ) {
440 
		    make_term_global ( s, &d ) ;
441 
		}
442 
		context = 2 ;
443 
	    }
444 
	    n = unit_no ( bs, id, VAR_tag, 0 ) ;
445 
	    bs = enc_init_tag ( bs, n, NULL_off, 0, s, a, d, context ) ;
446 
	    break ;
447 
	}
448 
 
449 
	case exp_preinc_tag : {
450 
	    /* Pre-increment expressions */
451 
	    EXP a = DEREF_exp ( exp_preinc_ref ( e ) ) ;
452 
	    EXP b = DEREF_exp ( exp_preinc_op ( e ) ) ;
453 
	    EXP a1 = DEREF_exp ( exp_dummy_value ( a ) ) ;
454 
	    OFFSET off = DEREF_off ( exp_dummy_off ( a ) ) ;
455 
	    COPY_exp ( exp_dummy_value ( a ), NULL_exp ) ;
456 
	    bs = make_identity ( bs, a1, &n, 0, 1 ) ;
457 
	    COPY_ulong ( exp_dummy_no ( a ), n ) ;
458 
	    s = DEREF_type ( exp_type ( a ) ) ;
459 
	    bs = enc_init_tag ( bs, n, off, 0, s, b, NULL_exp, 0 ) ;
460 
	    COPY_exp ( exp_dummy_value ( a ), a1 ) ;
461 
	    break ;
462 
	}
463 
 
464 
	case exp_cast_tag : {
465 
	    /* Cast expressions */
466 
	    EXP a = DEREF_exp ( exp_cast_arg ( e ) ) ;
467 
	    bs = enc_addr_exp ( bs, t, a ) ;
468 
	    return ( bs ) ;
469 
	}
470 
 
471 
	case exp_decl_stmt_tag : {
472 
	    /* Variable declarations */
473 
	    IDENTIFIER id = DEREF_id ( exp_decl_stmt_id ( e ) ) ;
474 
	    EXP a = DEREF_exp ( exp_decl_stmt_body ( e ) ) ;
475 
	    bs = enc_variable ( bs, id, 1, NIL ( EXP ), NULL_exp ) ;
476 
	    ENC_SEQ_SMALL ( bs, 1 ) ;
477 
	    bs = enc_exp ( bs, a ) ;
478 
	    n = unit_no ( bs, id, VAR_tag, 0 ) ;
479 
	    break ;
480 
	}
481 
 
482 
	case exp_comma_tag :
483 
	case exp_if_stmt_tag :
484 
	case exp_hash_if_tag : {
485 
	    /* Statement-like expressions */
486 
	    bs = enc_stmt_exp ( bs, e, s, 2 ) ;
487 
	    return ( bs ) ;
488 
	}
489 
 
490 
	case exp_rtti_tag :
491 
	case exp_rtti_type_tag :
492 
	case exp_thrown_tag :
493 
	case exp_dummy_tag : {
494 
	    /* lvalue expressions */
495 
	    bs = enc_exp ( bs, e ) ;
496 
	    return ( bs ) ;
497 
	}
498 
 
499 
	case exp_token_tag : {
500 
	    /* Tokenised expressions */
501 
	    CV_SPEC qual = DEREF_cv ( type_qual ( s ) ) ;
502 
	    if ( qual & cv_lvalue ) {
503 
		bs = enc_exp ( bs, e ) ;
504 
		return ( bs ) ;
505 
	    }
506 
	    n = make_tagdef ( NULL_id, s, e, NULL_exp, 1 ) ;
507 
	    n = link_no ( bs, n, VAR_tag ) ;
508 
	    break ;
509 
	}
510 
 
511 
	default : {
512 
	    /* Create temporary variable */
513 
	    CV_SPEC qual = DEREF_cv ( type_qual ( s ) ) ;
514 
	    if ( qual & cv_lvalue ) {
515 
		bs = enc_exp ( bs, e ) ;
516 
		return ( bs ) ;
517 
	    }
518 
	    n = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
519 
	    ENC_variable ( bs ) ;
520 
	    bs = enc_access ( bs, dspec_none ) ;
521 
	    ENC_make_tag ( bs, n ) ;
522 
	    bs = enc_exp ( bs, e ) ;
523 
	    break ;
524 
	}
525 
    }
526 
 
527 
    /* Encode an obtain_tag expression */
528 
    if ( anon ) {
529 
	ENC_add_to_ptr ( bs ) ;
530 
    }
531 
    if ( IS_type_ref ( s ) ) {
532 
	int bf = 0 ;
533 
	bs = enc_cont_op ( bs, s, &bf ) ;
534 
	bs = enc_shape ( bs, s ) ;
535 
	ASSERT ( bf == 0 ) ;
536 
    }
537 
    ENC_obtain_tag ( bs ) ;
538 
    ENC_make_tag ( bs, n ) ;
539 
    if ( anon ) {
540 
	/* Allow for differing identifier types */
541 
	ENC_offset_zero ( bs ) ;
542 
	bs = enc_alignment ( bs, s ) ;
543 
    }
544 
    return ( bs ) ;
545 
}
546 
 
547 
 
548 
/*
549 
    ENCODE A CONTENTS OPERATOR
550 
 
551 
    This routine encodes a contents operator for an expression of type t.
552 
    bf is set to true for bitfields.
553 
*/
554 
 
555 
BITSTREAM *enc_cont_op
556 
    PROTO_N ( ( bs, t, bf ) )
557 
    PROTO_T ( BITSTREAM *bs X TYPE t X int *bf )
558 
{
559 
    CV_SPEC cv = DEREF_cv ( type_qual ( t ) ) ;
560 
    if ( IS_type_bitfield ( t ) ) {
561 
	if ( cv & cv_volatile ) {
562 
	    ENC_bitfield_contents_with_mode ( bs ) ;
563 
	    ENC_volatile ( bs ) ;
564 
	} else {
565 
	    ENC_bitfield_contents ( bs ) ;
566 
	}
567 
	*bf = 1 ;
568 
    } else {
569 
	if ( cv & cv_volatile ) {
570 
	    ENC_contents_with_mode ( bs ) ;
571 
	    ENC_volatile ( bs ) ;
572 
	} else {
573 
	    ENC_contents ( bs ) ;
574 
	}
575 
    }
576 
    return ( bs ) ;
577 
}
578 
 
579 
 
580 
/*
581 
    ENCODE THE CONTENTS OF A TDF EXPRESSION
582 
 
583 
    This routine adds the contents of the expression e of type t to the
584 
    bitstream bs as a TDF EXP.
585 
*/
586 
 
587 
BITSTREAM *enc_cont_exp
588 
    PROTO_N ( ( bs, t, e ) )
589 
    PROTO_T ( BITSTREAM *bs X TYPE t X EXP e )
590 
{
591 
    ulong n ;
592 
    int bf = 0 ;
593 
    OFFSET off = NULL_off ;
594 
    TYPE s = DEREF_type ( exp_type ( e ) ) ;
595 
 
596 
    switch ( TAG_exp ( e ) ) {
597 
 
598 
	case exp_assign_tag : {
599 
	    /* Assignment (can't be bitfield) */
600 
	    EXP a = DEREF_exp ( exp_assign_ref ( e ) ) ;
601 
	    EXP b = DEREF_exp ( exp_assign_arg ( e ) ) ;
602 
	    CV_SPEC cv = DEREF_cv ( type_qual ( s ) ) ;
603 
	    if ( !( cv & cv_lvalue ) ) {
604 
		if ( ( cv & cv_volatile ) && !is_init_complex ( b ) ) {
605 
		    /* Introduce identity for right hand side */
606 
		    bs = make_identity ( bs, b, &n, 1, 1 ) ;
607 
		    bs = enc_assign_op ( bs, s, &bf ) ;
608 
		    bs = enc_exp ( bs, a ) ;
609 
		    ENC_obtain_tag ( bs ) ;
610 
		    ENC_make_tag ( bs, n ) ;
611 
		    ENC_obtain_tag ( bs ) ;
612 
		    ENC_make_tag ( bs, n ) ;
613 
		    return ( bs ) ;
614 
		}
615 
	    }
616 
	    /* Introduce identity for left hand side */
617 
	    bs = make_identity ( bs, a, &n, 0, 1 ) ;
618 
	    bs = enc_init_tag ( bs, n, NULL_off, 0, t, b, NULL_exp, 0 ) ;
619 
	    break ;
620 
	}
621 
 
622 
	case exp_init_tag : {
623 
	    /* Introduce identity for initialisation */
624 
	    int context = 1 ;
625 
	    unsigned seq = 1 ;
626 
	    IDENTIFIER id = DEREF_id ( exp_init_id ( e ) ) ;
627 
	    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
628 
	    EXP a = DEREF_exp ( exp_init_arg ( e ) ) ;
629 
	    EXP d = DEREF_exp ( id_variable_etc_term ( id ) ) ;
630 
	    if ( !IS_NULL_exp ( d ) ) {
631 
		while ( IS_exp_nof ( d ) ) {
632 
		    d = DEREF_exp ( exp_nof_pad ( d ) ) ;
633 
		}
634 
		seq++ ;
635 
	    }
636 
	    ENC_SEQ_SMALL ( bs, seq ) ;
637 
	    if ( !( ds & dspec_auto ) ) {
638 
		/* Allow for external variables */
639 
		if ( capsule_id ( id, VAR_tag ) ) {
640 
		    make_term_global ( t, &d ) ;
641 
		}
642 
		context = 2 ;
643 
	    }
644 
	    n = unit_no ( bs, id, VAR_tag, 0 ) ;
645 
	    bs = enc_init_tag ( bs, n, NULL_off, 0, t, a, d, context ) ;
646 
	    break ;
647 
	}
648 
 
649 
	case exp_preinc_tag : {
650 
	    /* Pre-increment expressions */
651 
	    ulong m = LINK_NONE ;
652 
	    CV_SPEC cv = DEREF_cv ( type_qual ( s ) ) ;
653 
	    EXP a = DEREF_exp ( exp_preinc_ref ( e ) ) ;
654 
	    EXP b = DEREF_exp ( exp_preinc_op ( e ) ) ;
655 
	    EXP a1 = DEREF_exp ( exp_dummy_value ( a ) ) ;
656 
	    COPY_exp ( exp_dummy_value ( a ), NULL_exp ) ;
657 
	    bs = make_identity ( bs, a1, &n, 0, 0 ) ;
658 
	    COPY_ulong ( exp_dummy_no ( a ), n ) ;
659 
	    if ( !( cv & cv_lvalue ) || !( cv & cv_volatile ) ) {
660 
		/* Introduce identity for right hand side */
661 
		bs = make_identity ( bs, b, &m, 1, 0 ) ;
662 
	    }
663 
	    ENC_SEQ_SMALL ( bs, 1 ) ;
664 
	    s = DEREF_type ( exp_type ( a ) ) ;
665 
	    bs = enc_assign_op ( bs, s, &bf ) ;
666 
	    ENC_obtain_tag ( bs ) ;
667 
	    ENC_make_tag ( bs, n ) ;
668 
	    if ( bf ) {
669 
		off = DEREF_off ( exp_dummy_off ( a ) ) ;
670 
		bs = enc_offset ( bs, off ) ;
671 
	    }
672 
	    COPY_exp ( exp_dummy_value ( a ), a1 ) ;
673 
	    if ( m == LINK_NONE ) {
674 
		bs = enc_exp ( bs, b ) ;
675 
	    } else {
676 
		ENC_obtain_tag ( bs ) ;
677 
		ENC_make_tag ( bs, m ) ;
678 
	    }
679 
	    if ( bf && !IS_type_bitfield ( t ) ) {
680 
		/* Promotion conversion (see make_preinc_exp) */
681 
		ENC_change_bitfield_to_int ( bs ) ;
682 
		bs = enc_variety ( bs, t ) ;
683 
		t = s ;
684 
	    }
685 
	    if ( m == LINK_NONE ) break ;
686 
	    ENC_obtain_tag ( bs ) ;
687 
	    ENC_make_tag ( bs, m ) ;
688 
	    return ( bs ) ;
689 
	}
690 
 
691 
	case exp_decl_stmt_tag : {
692 
	    /* Variable declarations */
693 
	    IDENTIFIER id = DEREF_id ( exp_decl_stmt_id ( e ) ) ;
694 
	    EXP a = DEREF_exp ( exp_decl_stmt_body ( e ) ) ;
695 
	    bs = enc_variable ( bs, id, 1, NIL ( EXP ), NULL_exp ) ;
696 
	    ENC_SEQ_SMALL ( bs, 1 ) ;
697 
	    bs = enc_exp ( bs, a ) ;
698 
	    n = unit_no ( bs, id, VAR_tag, 0 ) ;
699 
	    break ;
700 
	}
701 
 
702 
	case exp_comma_tag :
703 
	case exp_if_stmt_tag :
704 
	case exp_hash_if_tag : {
705 
	    /* Statement-like expressions */
706 
	    bs = enc_stmt_exp ( bs, e, t, 3 ) ;
707 
	    return ( bs ) ;
708 
	}
709 
 
710 
	case exp_dummy_tag : {
711 
	    /* Dummy expressions */
712 
	    EXP a = DEREF_exp ( exp_dummy_value ( e ) ) ;
713 
	    if ( IS_NULL_exp ( a ) ) {
714 
		int cnt = DEREF_int ( exp_dummy_cont ( e ) ) ;
715 
		int virt = DEREF_int ( exp_dummy_virt ( e ) ) ;
716 
		n = DEREF_ulong ( exp_dummy_no ( e ) ) ;
717 
		bs = enc_cont_op ( bs, s, &bf ) ;
718 
		off = DEREF_off ( exp_dummy_off ( e ) ) ;
719 
		if ( bf ) {
720 
		    OFFSET off1 = decons_bitf_off ( &off ) ;
721 
		    bs = enc_bfvar ( bs, t ) ;
722 
		    bs = enc_dummy_exp ( bs, t, n, off, cnt, virt ) ;
723 
		    bs = enc_offset ( bs, off1 ) ;
724 
		} else {
725 
		    bs = enc_shape ( bs, t ) ;
726 
		    bs = enc_dummy_exp ( bs, t, n, off, cnt, virt ) ;
727 
		}
728 
		return ( bs ) ;
729 
	    }
730 
	    n = LINK_NONE ;
731 
	    break ;
732 
	}
733 
 
734 
	default : {
735 
	    /* This is the easy case */
736 
	    n = LINK_NONE ;
737 
	    break ;
738 
	}
739 
    }
740 
 
741 
    /* Encode a contents expression */
742 
    bs = enc_cont_op ( bs, s, &bf ) ;
743 
    if ( bf ) {
744 
	if ( IS_NULL_off ( off ) ) {
745 
	    /* Find bitfield offset */
746 
	    off = decons_bitf_exp ( &e ) ;
747 
	}
748 
	bs = enc_bfvar ( bs, t ) ;
749 
	if ( n == LINK_NONE ) {
750 
	    bs = enc_addr_exp ( bs, t, e ) ;
751 
	} else {
752 
	    ENC_obtain_tag ( bs ) ;
753 
	    ENC_make_tag ( bs, n ) ;
754 
	}
755 
	bs = enc_offset ( bs, off ) ;
756 
    } else {
757 
	bs = enc_shape ( bs, t ) ;
758 
	if ( n == LINK_NONE ) {
759 
	    bs = enc_exp ( bs, e ) ;
760 
	} else {
761 
	    ENC_obtain_tag ( bs ) ;
762 
	    ENC_make_tag ( bs, n ) ;
763 
	}
764 
    }
765 
    return ( bs ) ;
766 
}
767 
 
768 
 
769 
/*
770 
    ENCODE A LIST OF TDF EXPS
771 
 
772 
    This routines adds the expressions p to the bitstream bs as a list
773 
    of TDF EXPs.
774 
*/
775 
 
776 
BITSTREAM *enc_exp_list
777 
    PROTO_N ( ( bs, p ) )
778 
    PROTO_T ( BITSTREAM *bs X LIST ( EXP ) p )
779 
{
780 
    unsigned n = LENGTH_list ( p ) ;
781 
    ENC_LIST ( bs, n ) ;
782 
    while ( !IS_NULL_list ( p ) ) {
783 
	EXP e = DEREF_exp ( HEAD_list ( p ) ) ;
784 
	bs = enc_exp ( bs, e ) ;
785 
	p = TAIL_list ( p ) ;
786 
    }
787 
    return ( bs ) ;
788 
}
789 
 
790 
 
791 
/*
792 
    ENCODE A TDF NTEST
793 
 
794 
    This routine adds the comparison operator tst to the bitstream bs as
795 
    a TDF NTEST.  The macro ENC_NTEST exploits the correlation between
796 
    the internal representation of NTESTs and the TDF encoding.
797 
*/
798 
 
799 
BITSTREAM *enc_ntest
800 
    PROTO_N ( ( bs, tst ) )
801 
    PROTO_T ( BITSTREAM *bs X NTEST tst )
802 
{
803 
    ENC_NTEST ( bs, tst ) ;
804 
    return ( bs ) ;
805 
}
806 
 
807 
 
808 
/*
809 
    ENCODE A COMPARISON
810 
 
811 
    This routine adds a comparison expression to the bitstream bs for
812 
    comparing a with b using test tst.  lab gives the destination label
813 
    number.
814 
*/
815 
 
816 
BITSTREAM *enc_compare
817 
    PROTO_N ( ( bs, a, b, tst, lab, nlab ) )
818 
    PROTO_T ( BITSTREAM *bs X EXP a X EXP b X NTEST tst X
819 
	      ulong lab X ulong nlab )
820 
{
821 
    /* Find the test */
822 
    TYPE t = DEREF_type ( exp_type ( a ) ) ;
823 
    unsigned tag = TAG_type ( t ) ;
824 
    if ( lab == LINK_NONE ) {
825 
	if ( tst > ntest_not ) tst -= ntest_not ;
826 
	tst = ntest_negate - tst ;
827 
	lab = nlab ;
828 
    }
829 
 
830 
    /* Encode the comparison operation */
831 
    switch ( tag ) {
832 
 
833 
	case type_floating_tag : {
834 
	    /* Floating point comparisons */
835 
	    ENC_floating_test ( bs ) ;
836 
	    ENC_OFF ( bs ) ;
837 
	    ENC_impossible ( bs ) ;
838 
	    break ;
839 
	}
840 
 
841 
	case type_ptr_tag :
842 
	case type_ref_tag : {
843 
	    /* Pointer comparisons */
844 
	    TYPE s = DEREF_type ( type_ptr_etc_sub ( t ) ) ;
845 
	    switch ( TAG_type ( s ) ) {
846 
		case type_top_tag :
847 
		case type_bottom_tag : {
848 
		    /* 'void *' comparisons */
849 
		    int spec ;
850 
		    BITSTREAM *ts ;
851 
		    if ( IS_NULL_exp ( b ) || IS_exp_null ( b ) ) {
852 
			spec = TOK_pv_test ;
853 
			b = NULL_exp ;
854 
		    } else {
855 
			spec = TOK_pv_compare ;
856 
		    }
857 
		    bs = enc_special ( bs, spec ) ;
858 
		    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
859 
		    ts = enc_exp ( ts, a ) ;
860 
		    if ( !IS_NULL_exp ( b ) ) ts = enc_exp ( ts, b ) ;
861 
		    ENC_make_label ( ts, lab ) ;
862 
		    ts = enc_ntest ( ts, tst ) ;
863 
		    bs = enc_bitstream ( bs, ts ) ;
864 
		    return ( bs ) ;
865 
		}
866 
		case type_func_tag : {
867 
		    /* Function pointers */
868 
		    ENC_proc_test ( bs ) ;
869 
		    break ;
870 
		}
871 
		default : {
872 
		    /* Object pointers */
873 
		    ENC_pointer_test ( bs ) ;
874 
		    break ;
875 
		}
876 
	    }
877 
	    ENC_OFF ( bs ) ;
878 
	    break ;
879 
	}
880 
 
881 
	case type_ptr_mem_tag : {
882 
	    /* Pointer to member comparisons */
883 
	    int spec ;
884 
	    BITSTREAM *ts ;
885 
	    TYPE s = DEREF_type ( type_ptr_mem_sub ( t ) ) ;
886 
	    if ( IS_type_func ( s ) ) {
887 
		/* Pointer to member functions */
888 
		ulong n = LINK_NONE ;
889 
		ulong m = LINK_NONE ;
890 
		bs = make_ptr_mem_func ( bs, a, &n, 0 ) ;
891 
		if ( IS_NULL_exp ( b ) || IS_exp_null ( b ) ) {
892 
		    spec = TOK_pmf_test ;
893 
		    b = NULL_exp ;
894 
		} else {
895 
		    bs = make_ptr_mem_func ( bs, b, &m, 0 ) ;
896 
		    spec = TOK_pmf_compare ;
897 
		}
898 
		bs = enc_special ( bs, spec ) ;
899 
		ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
900 
		ENC_obtain_tag ( ts ) ;
901 
		ENC_make_tag ( ts, n ) ;
902 
		if ( !IS_NULL_exp ( b ) ) {
903 
		    ENC_obtain_tag ( ts ) ;
904 
		    ENC_make_tag ( ts, m ) ;
905 
		}
906 
		ENC_make_label ( ts, lab ) ;
907 
		ts = enc_ntest ( ts, tst ) ;
908 
		bs = enc_bitstream ( bs, ts ) ;
909 
	    } else {
910 
		/* Pointer to data members */
911 
		if ( IS_NULL_exp ( b ) || IS_exp_null ( b ) ) {
912 
		    spec = TOK_pm_test ;
913 
		    b = NULL_exp ;
914 
		} else {
915 
		    spec = TOK_pm_compare ;
916 
		}
917 
		bs = enc_special ( bs, spec ) ;
918 
		ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
919 
		ts = enc_exp ( ts, a ) ;
920 
		if ( !IS_NULL_exp ( b ) ) ts = enc_exp ( ts, b ) ;
921 
		ENC_make_label ( ts, lab ) ;
922 
		ts = enc_ntest ( ts, tst ) ;
923 
		bs = enc_bitstream ( bs, ts ) ;
924 
	    }
925 
	    return ( bs ) ;
926 
	}
927 
 
928 
	default : {
929 
	    /* Integer comparisons */
930 
	    ENC_integer_test ( bs ) ;
931 
	    ENC_OFF ( bs ) ;
932 
	    break ;
933 
	}
934 
    }
935 
 
936 
    /* Encode the comparison arguments */
937 
    bs = enc_ntest ( bs, tst ) ;
938 
    ENC_make_label ( bs, lab ) ;
939 
    bs = enc_exp ( bs, a ) ;
940 
    if ( IS_NULL_exp ( b ) ) {
941 
	bs = enc_null_exp ( bs, t ) ;
942 
    } else {
943 
	bs = enc_exp ( bs, b ) ;
944 
    }
945 
    return ( bs ) ;
946 
}
947 
 
948 
 
949 
/*
950 
    SIMPLIFY A CONDITION
951 
 
952 
    This routine simplifies the condition e by removing any double
953 
    negations.  sw is set to 1 if the result has the form 'a || b' or
954 
    '!( a && b )'.
955 
*/
956 
 
957 
EXP simplify_cond
958 
    PROTO_N ( ( e, sw ) )
959 
    PROTO_T ( EXP e X int *sw )
960 
{
961 
    EXP a = e ;
962 
    unsigned tag = TAG_exp ( a ) ;
963 
    if ( tag == exp_location_tag ) {
964 
	/* Can have location markers */
965 
	EXP b ;
966 
	a = DEREF_exp ( exp_location_arg ( e ) ) ;
967 
	b = simplify_cond ( a, sw ) ;
968 
	if ( !EQ_exp ( b, a ) ) {
969 
	    LOCATION loc ;
970 
	    TYPE t = DEREF_type ( exp_type ( e ) ) ;
971 
	    DEREF_loc ( exp_location_end ( e ), loc ) ;
972 
	    MAKE_exp_location ( t, loc, b, e ) ;
973 
	}
974 
	return ( e ) ;
975 
    }
976 
    while ( tag == exp_not_tag ) {
977 
	EXP b = DEREF_exp ( exp_not_arg ( a ) ) ;
978 
	tag = TAG_exp ( b ) ;
979 
	if ( tag != exp_not_tag ) {
980 
	    if ( tag == exp_log_and_tag ) *sw = 1 ;
981 
	    return ( a ) ;
982 
	}
983 
	a = DEREF_exp ( exp_not_arg ( b ) ) ;
984 
	tag = TAG_exp ( a ) ;
985 
    }
986 
    if ( tag == exp_log_or_tag ) *sw = 1 ;
987 
    return ( a ) ;
988 
}
989 
 
990 
 
991 
/*
992 
    ENCODE A CONDITION
993 
 
994 
    This routine adds the expression e as a conditional jump to the label
995 
    lab if true or label nlab if false to the bitstream bs.  Either label
996 
    may be LINK_NONE.
997 
*/
998 
 
999 
BITSTREAM *enc_condition
1000 
    PROTO_N ( ( bs, e, lab, nlab ) )
1001 
    PROTO_T ( BITSTREAM *bs X EXP e X ulong lab X ulong nlab )
1002 
{
1003 
    switch ( TAG_exp ( e ) ) {
1004 
 
1005 
	case exp_int_lit_tag : {
1006 
	    /* Constant conditions */
1007 
	    NAT n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
1008 
	    if ( IS_nat_small ( n ) ) {
1009 
		unsigned v = DEREF_unsigned ( nat_small_value ( n ) ) ;
1010 
		if ( v == BOOL_FALSE ) nlab = lab ;
1011 
		if ( nlab == LINK_NONE ) {
1012 
		    ENC_make_top ( bs ) ;
1013 
		} else {
1014 
		    ENC_goto ( bs ) ;
1015 
		    ENC_make_label ( bs, nlab ) ;
1016 
		}
1017 
		break ;
1018 
	    }
1019 
	    if ( IS_nat_calc ( n ) ) {
1020 
		EXP a = DEREF_exp ( nat_calc_value ( n ) ) ;
1021 
		bs = enc_condition ( bs, a, lab, nlab ) ;
1022 
		break ;
1023 
	    }
1024 
	    goto default_lab ;
1025 
	}
1026 
 
1027 
	case exp_not_tag : {
1028 
	    /* Negated conditions */
1029 
	    EXP a = DEREF_exp ( exp_not_arg ( e ) ) ;
1030 
	    bs = enc_condition ( bs, a, nlab, lab ) ;
1031 
	    break ;
1032 
	}
1033 
 
1034 
	case exp_log_and_tag : {
1035 
	    /* Logical and conditions */
1036 
	    EXP a = DEREF_exp ( exp_log_and_arg1 ( e ) ) ;
1037 
	    EXP b = DEREF_exp ( exp_log_and_arg2 ( e ) ) ;
1038 
	    if ( lab == LINK_NONE ) {
1039 
		/* '!( a && b )' equals '!a || !b' */
1040 
		ulong mlab = unit_no ( bs, NULL_id, VAR_label, 1 ) ;
1041 
		ENC_conditional ( bs ) ;
1042 
		ENC_make_label ( bs, mlab ) ;
1043 
		ENC_SEQ_SMALL ( bs, 1 ) ;
1044 
		bs = enc_condition ( bs, a, mlab, LINK_NONE ) ;
1045 
		bs = enc_condition ( bs, b, LINK_NONE, nlab ) ;
1046 
		ENC_make_top ( bs ) ;
1047 
	    } else {
1048 
		/* Encode 'a && b' */
1049 
		ENC_SEQ_SMALL ( bs, 1 ) ;
1050 
		bs = enc_condition ( bs, a, lab, nlab ) ;
1051 
		bs = enc_condition ( bs, b, lab, nlab ) ;
1052 
	    }
1053 
	    break ;
1054 
	}
1055 
 
1056 
	case exp_log_or_tag : {
1057 
	    /* Logical or conditions */
1058 
	    EXP a = DEREF_exp ( exp_log_or_arg1 ( e ) ) ;
1059 
	    EXP b = DEREF_exp ( exp_log_or_arg2 ( e ) ) ;
1060 
	    if ( nlab == LINK_NONE ) {
1061 
		/* Encode 'a || b' */
1062 
		ulong mlab = unit_no ( bs, NULL_id, VAR_label, 1 ) ;
1063 
		ENC_conditional ( bs ) ;
1064 
		ENC_make_label ( bs, mlab ) ;
1065 
		ENC_SEQ_SMALL ( bs, 1 ) ;
1066 
		bs = enc_condition ( bs, a, LINK_NONE, mlab ) ;
1067 
		bs = enc_condition ( bs, b, lab, LINK_NONE ) ;
1068 
		ENC_make_top ( bs ) ;
1069 
	    } else {
1070 
		/* '!( a || b )' equals '!a && !b' */
1071 
		ENC_SEQ_SMALL ( bs, 1 ) ;
1072 
		bs = enc_condition ( bs, a, lab, nlab ) ;
1073 
		bs = enc_condition ( bs, b, lab, nlab ) ;
1074 
	    }
1075 
	    break ;
1076 
	}
1077 
 
1078 
	case exp_test_tag : {
1079 
	    /* Test conditions */
1080 
	    NTEST tst = DEREF_ntest ( exp_test_tst ( e ) ) ;
1081 
	    EXP a = DEREF_exp ( exp_test_arg ( e ) ) ;
1082 
	    bs = enc_compare ( bs, a, NULL_exp, tst, lab, nlab ) ;
1083 
	    break ;
1084 
	}
1085 
 
1086 
	case exp_compare_tag : {
1087 
	    /* Comparison conditions */
1088 
	    NTEST tst = DEREF_ntest ( exp_compare_tst ( e ) ) ;
1089 
	    EXP a = DEREF_exp ( exp_compare_arg1 ( e ) ) ;
1090 
	    EXP b = DEREF_exp ( exp_compare_arg2 ( e ) ) ;
1091 
	    bs = enc_compare ( bs, a, b, tst, lab, nlab ) ;
1092 
	    break ;
1093 
	}
1094 
 
1095 
	case exp_comma_tag : {
1096 
	    /* Comma conditions */
1097 
	    EXP a ;
1098 
	    LIST ( EXP ) p = DEREF_list ( exp_comma_args ( e ) ) ;
1099 
	    bs = enc_stmt_exp ( bs, e, type_void, -1 ) ;
1100 
	    p = END_list ( p ) ;
1101 
	    a = DEREF_exp ( HEAD_list ( p ) ) ;
1102 
	    bs = enc_condition ( bs, a, lab, nlab ) ;
1103 
	    break ;
1104 
	}
1105 
 
1106 
	case exp_location_tag : {
1107 
	    /* Location marker */
1108 
	    PTR ( LOCATION ) loc = crt_enc_loc ;
1109 
	    EXP a = DEREF_exp ( exp_location_arg ( e ) ) ;
1110 
            BITSTREAM *ts = enc_diag_begin ( &bs ) ;
1111 
	    ts = enc_condition ( ts, a, lab, nlab ) ;
1112 
            crt_enc_loc = exp_location_end ( e ) ;
1113 
            bs = enc_diag_end ( bs, ts, a, 2 ) ;
1114 
            crt_enc_loc = loc ;
1115 
	    break ;
1116 
	}
1117 
 
1118 
	default :
1119 
	default_lab : {
1120 
	    /* Other conditions */
1121 
	    NTEST tst = ntest_not_eq ;
1122 
	    bs = enc_compare ( bs, e, NULL_exp, tst, lab, nlab ) ;
1123 
	    break ;
1124 
	}
1125 
    }
1126 
    return ( bs ) ;
1127 
}
1128 
 
1129 
 
1130 
/*
1131 
    ENCODE A LOGICAL EXPRESSION
1132 
 
1133 
    This routine adds the logical expression e of type t to the bitstream
1134 
    bs.  The code added is equivalent to '( e ? 1 : 0 )'.
1135 
*/
1136 
 
1137 
static BITSTREAM *enc_logical
1138 
    PROTO_N ( ( bs, e, t ) )
1139 
    PROTO_T ( BITSTREAM *bs X EXP e X TYPE t )
1140 
{
1141 
    int sw = 0 ;
1142 
    ulong nlab = LINK_NONE ;
1143 
    ulong n = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
1144 
    ulong lab = unit_no ( bs, NULL_id, VAR_label, 1 ) ;
1145 
    e = simplify_cond ( e, &sw ) ;
1146 
 
1147 
    /* Introduce variable for boolean value */
1148 
    ENC_variable ( bs ) ;
1149 
    bs = enc_access ( bs, dspec_none ) ;
1150 
    ENC_make_tag ( bs, n ) ;
1151 
    bs = enc_make_int ( bs, t, sw ) ;
1152 
    ENC_SEQ_SMALL ( bs, 1 ) ;
1153 
    ENC_conditional ( bs ) ;
1154 
    ENC_make_label ( bs, lab ) ;
1155 
    ENC_SEQ_SMALL ( bs, 1 ) ;
1156 
 
1157 
    /* Conditionally assign to boolean variable */
1158 
    if ( sw ) {
1159 
	nlab = lab ;
1160 
	lab = LINK_NONE ;
1161 
    }
1162 
    bs = enc_condition ( bs, e, lab, nlab ) ;
1163 
    ENC_assign ( bs ) ;
1164 
    ENC_obtain_tag ( bs ) ;
1165 
    ENC_make_tag ( bs, n ) ;
1166 
    bs = enc_make_int ( bs, t, !sw ) ;
1167 
    ENC_make_top ( bs ) ;
1168 
 
1169 
    /* Return the contents of the boolean */
1170 
    ENC_contents ( bs ) ;
1171 
    bs = enc_shape ( bs, t ) ;
1172 
    ENC_obtain_tag ( bs ) ;
1173 
    ENC_make_tag ( bs, n ) ;
1174 
    return ( bs ) ;
1175 
}
1176 
 
1177 
 
1178 
/*
1179 
    CHECK FOR CONSTANT POINTER TO MEMBERS
1180 
 
1181 
    This routine checks whether the expression e consists of a cast of the
1182 
    address of a member of some class.  If so it returns the corresponding
1183 
    member identifier.
1184 
*/
1185 
 
1186 
static IDENTIFIER is_const_ptr_mem
1187 
    PROTO_N ( ( e, rev ) )
1188 
    PROTO_T ( EXP e X int rev )
1189 
{
1190 
    if ( !IS_NULL_exp ( e ) ) {
1191 
	unsigned tag = TAG_exp ( e ) ;
1192 
	if ( tag == exp_address_mem_tag ) {
1193 
	    /* Allow for addresses of members */
1194 
	    EXP a = DEREF_exp ( exp_address_mem_arg ( e ) ) ;
1195 
	    IDENTIFIER id = DEREF_id ( exp_member_id ( a ) ) ;
1196 
	    return ( id ) ;
1197 
	} else if ( tag == exp_base_cast_tag ) {
1198 
	    /* Allow for base casts */
1199 
	    EXP a = DEREF_exp ( exp_base_cast_arg ( e ) ) ;
1200 
	    unsigned conv = DEREF_unsigned ( exp_base_cast_conv ( e ) ) ;
1201 
	    if ( rev || !( conv & CONV_REVERSE ) ) {
1202 
		IDENTIFIER id = is_const_ptr_mem ( a, rev ) ;
1203 
		return ( id ) ;
1204 
	    }
1205 
	} else if ( tag == exp_dummy_tag ) {
1206 
	    /* Allow for dummy expressions */
1207 
	    EXP a = DEREF_exp ( exp_dummy_value ( e ) ) ;
1208 
	    IDENTIFIER id = is_const_ptr_mem ( a, rev ) ;
1209 
	    return ( id ) ;
1210 
	}
1211 
    }
1212 
    return ( NULL_id ) ;
1213 
}
1214 
 
1215 
 
1216 
/*
1217 
    ENCODE A POINTER TO MEMBER
1218 
 
1219 
    This routine adds the address of the member id plus the base class
1220 
    offset gr, converted to type t, to the bitstream bs.
1221 
*/
1222 
 
1223 
static BITSTREAM *enc_ptr_mem
1224 
    PROTO_N ( ( bs, t, id, gr ) )
1225 
    PROTO_T ( BITSTREAM *bs X TYPE t X IDENTIFIER id X GRAPH gr )
1226 
{
1227 
    BITSTREAM *ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1228 
    if ( IS_id_mem_func ( id ) ) {
1229 
	DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
1230 
	CLASS_TYPE ct = DEREF_ctype ( type_ptr_mem_of ( t ) ) ;
1231 
	ASSERT ( !( ds & dspec_inherit ) ) ;
1232 
	if ( ds & dspec_virtual ) {
1233 
	    /* Virtual member function */
1234 
	    ulong m ;
1235 
	    ulong tok ;
1236 
	    VIRTUAL vt ;
1237 
	    OFFSET off ;
1238 
	    IGNORE compile_class ( ct ) ;
1239 
	    vt = DEREF_virt ( ctype_virt ( ct ) ) ;
1240 
	    off = DEREF_off ( virt_table_off ( vt ) ) ;
1241 
	    tok = DEREF_ulong ( virt_table_tok ( vt ) ) ;
1242 
	    if ( !IS_NULL_graph ( gr ) ) {
1243 
		/* Allow for overriding virtual functions */
1244 
		GRAPH gs = NULL_graph ;
1245 
		VIRTUAL at = find_overrider ( ct, id, gr, &gs ) ;
1246 
		if ( !IS_NULL_virt ( at ) ) {
1247 
		    id = DEREF_id ( virt_func ( at ) ) ;
1248 
		}
1249 
	    }
1250 
	    m = virtual_no ( id, vt ) ;
1251 
	    bs = enc_special ( bs, TOK_pmf_vmake ) ;
1252 
	    ts = enc_make_snat ( ts, ( int ) m ) ;
1253 
	    if ( !is_zero_offset ( off ) ) {
1254 
		ENC_offset_add ( ts ) ;
1255 
		ts = enc_offset ( ts, off ) ;
1256 
	    }
1257 
	    tok = link_no ( ts, tok, VAR_token ) ;
1258 
	    ENC_exp_apply_token ( ts ) ;
1259 
	    ENC_make_tok ( ts, tok ) ;
1260 
	    ENC_LEN_SMALL ( ts, 0 ) ;
1261 
	    ENC_offset_zero ( ts ) ;
1262 
	    ts = enc_al_ctype ( ts, ct ) ;
1263 
	    ENC_offset_zero ( ts ) ;
1264 
	    ts = enc_al_ctype ( ts, ct ) ;
1265 
	} else {
1266 
	    /* Member function */
1267 
	    bs = enc_special ( bs, TOK_pmf_make ) ;
1268 
	    ts = enc_member ( ts, id ) ;
1269 
	    if ( IS_NULL_graph ( gr ) ) {
1270 
		ENC_offset_zero ( ts ) ;
1271 
		ts = enc_al_ctype ( ts, ct ) ;
1272 
	    } else {
1273 
		ts = enc_base ( ts, gr, 0 ) ;
1274 
	    }
1275 
	    ENC_offset_zero ( ts ) ;
1276 
	    ts = enc_al_ctype ( ts, ct ) ;
1277 
	}
1278 
    } else {
1279 
	/* Data member */
1280 
	bs = enc_special ( bs, TOK_pm_make ) ;
1281 
	if ( !IS_NULL_graph ( gr ) ) {
1282 
	    DECL_SPEC acc = DEREF_dspec ( graph_access ( gr ) ) ;
1283 
	    if ( !( acc & dspec_ignore ) ) {
1284 
		ENC_offset_add ( ts ) ;
1285 
		ts = enc_base ( ts, gr, 0 ) ;
1286 
	    }
1287 
	}
1288 
	ts = enc_member ( ts, id ) ;
1289 
    }
1290 
    bs = enc_bitstream ( bs, ts ) ;
1291 
    return ( bs ) ;
1292 
}
1293 
 
1294 
 
1295 
/*
1296 
    ENCODE A CAST EXPRESSION
1297 
 
1298 
    This routine adds a TDF EXP to the bitstream bs representing a cast
1299 
    of the expression e to the type t.  conv represents the conversion
1300 
    type (see cast.c).
1301 
*/
1302 
 
1303 
static BITSTREAM *enc_cast_exp
1304 
    PROTO_N ( ( bs, t, e, conv ) )
1305 
    PROTO_T ( BITSTREAM *bs X TYPE t X EXP e X unsigned conv )
1306 
{
1307 
    BITSTREAM *ts ;
1308 
    switch ( conv ) {
1309 
 
1310 
	case CONV_EXACT :
1311 
	case CONV_FUNC :
1312 
	case CONV_STRING :
1313 
	case CONV_PTR_PTR_ALIGN :
1314 
	case CONV_PTR_MEM_PTR_MEM : {
1315 
	    /* Trivial conversions */
1316 
	    bs = enc_exp ( bs, e ) ;
1317 
	    break ;
1318 
	}
1319 
 
1320 
	case CONV_QUAL : {
1321 
	    /* Qualification conversions */
1322 
	    if ( IS_exp_address ( e ) ) {
1323 
		EXP a = DEREF_exp ( exp_address_arg ( e ) ) ;
1324 
		bs = enc_addr_exp ( bs, t, a ) ;
1325 
	    } else {
1326 
		bs = enc_exp ( bs, e ) ;
1327 
	    }
1328 
	    break ;
1329 
	}
1330 
 
1331 
	case CONV_ELLIPSIS : {
1332 
	    /* Discarded expression */
1333 
	    if ( overflow_exp ( e ) ) {
1334 
		bs = enc_stmt_exp ( bs, e, t, 0 ) ;
1335 
	    } else {
1336 
		bs = enc_null_exp ( bs, t ) ;
1337 
	    }
1338 
	    break ;
1339 
	}
1340 
 
1341 
	case CONV_INT_INT :
1342 
	case CONV_ENUM : {
1343 
	    /* Integer to integer conversion */
1344 
	    TYPE u = DEREF_type ( exp_type ( e ) ) ;
1345 
	    switch ( TAG_exp ( e ) ) {
1346 
		case exp_char_lit_tag : {
1347 
		    STRING s = DEREF_str ( exp_char_lit_str ( e ) ) ;
1348 
		    bs = enc_char ( bs, s, t, u ) ;
1349 
		    break ;
1350 
		}
1351 
		case exp_cast_tag : {
1352 
		    conv = DEREF_unsigned ( exp_cast_conv ( e ) ) ;
1353 
		    if ( conv == CONV_BITFIELD ) {
1354 
			/* Elide following bitfield conversion */
1355 
			e = DEREF_exp ( exp_cast_arg ( e ) ) ;
1356 
			ENC_change_bitfield_to_int ( bs ) ;
1357 
			bs = enc_variety ( bs, t ) ;
1358 
			bs = enc_exp ( bs, e ) ;
1359 
			break ;
1360 
		    }
1361 
		    goto int_int_label ;
1362 
		}
1363 
		case exp_not_tag :
1364 
		case exp_log_and_tag :
1365 
		case exp_log_or_tag :
1366 
		case exp_test_tag :
1367 
		case exp_compare_tag : {
1368 
		    /* Logical expressions */
1369 
		    bs = enc_logical ( bs, e, t ) ;
1370 
		    break ;
1371 
		}
1372 
		default :
1373 
		int_int_label : {
1374 
		    if ( !eq_type_rep ( u, t, 0 ) ) {
1375 
			ENC_change_variety ( bs ) ;
1376 
			bs = enc_error_treatment ( bs, t ) ;
1377 
			bs = enc_variety ( bs, t ) ;
1378 
		    }
1379 
		    bs = enc_exp ( bs, e ) ;
1380 
		    break ;
1381 
		}
1382 
	    }
1383 
	    break ;
1384 
	}
1385 
 
1386 
	case CONV_BITFIELD : {
1387 
	    /* Bitfield to integer conversion */
1388 
	    ENC_change_bitfield_to_int ( bs ) ;
1389 
	    bs = enc_variety ( bs, t ) ;
1390 
	    bs = enc_exp ( bs, e ) ;
1391 
	    break ;
1392 
	}
1393 
 
1394 
	case CONV_BITFIELD | CONV_REVERSE : {
1395 
	    /* Integer to bitfield conversion */
1396 
	    if ( IS_exp_cast ( e ) ) {
1397 
		conv = DEREF_unsigned ( exp_cast_conv ( e ) ) ;
1398 
		if ( conv == CONV_INT_INT ) {
1399 
		    /* Elide following integer conversion */
1400 
		    e = DEREF_exp ( exp_cast_arg ( e ) ) ;
1401 
		}
1402 
	    }
1403 
	    ENC_change_int_to_bitfield ( bs ) ;
1404 
	    bs = enc_bfvar ( bs, t ) ;
1405 
	    bs = enc_exp ( bs, e ) ;
1406 
	    break ;
1407 
	}
1408 
 
1409 
	case CONV_INT_FLT : {
1410 
	    /* Integer to float conversion */
1411 
	    if ( IS_exp_int_lit ( e ) ) {
1412 
		NAT n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
1413 
		unsigned long v = get_nat_value ( n ) ;
1414 
		if ( v < SMALL_FLOAT_CONST ) {
1415 
		    /* Small floating point constants */
1416 
		    bs = enc_float_int ( bs, ( int ) v, t ) ;
1417 
		    break ;
1418 
		}
1419 
	    }
1420 
	    ENC_float_int ( bs ) ;
1421 
	    ENC_impossible ( bs ) ;
1422 
	    bs = enc_flvar ( bs, t ) ;
1423 
	    bs = enc_exp ( bs, e ) ;
1424 
	    break ;
1425 
	}
1426 
 
1427 
	case CONV_FLT_INT : {
1428 
	    /* Float to integer conversion */
1429 
	    ENC_round_with_mode ( bs ) ;
1430 
	    ENC_impossible ( bs ) ;
1431 
	    ENC_RMODE ( bs, crt_round_mode ) ;
1432 
	    bs = enc_variety ( bs, t ) ;
1433 
	    bs = enc_exp ( bs, e ) ;
1434 
	    break ;
1435 
	}
1436 
 
1437 
	case CONV_FLT_FLT : {
1438 
	    /* Float to float conversion */
1439 
	    ENC_change_floating_variety ( bs ) ;
1440 
	    ENC_impossible ( bs ) ;
1441 
	    bs = enc_flvar ( bs, t ) ;
1442 
	    bs = enc_exp ( bs, e ) ;
1443 
	    break ;
1444 
	}
1445 
 
1446 
	case CONV_PTR_VOID :
1447 
	case CONV_PTR_VOID | CONV_REVERSE :
1448 
	pointer_void_label : {
1449 
	    /* Object pointer and 'void *' conversions */
1450 
	    if ( conv & CONV_REVERSE ) {
1451 
		bs = enc_special ( bs, TOK_from_ptr_void ) ;
1452 
	    } else {
1453 
		bs = enc_special ( bs, TOK_to_ptr_void ) ;
1454 
		t = DEREF_type ( exp_type ( e ) ) ;
1455 
	    }
1456 
	    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1457 
	    t = DEREF_type ( type_ptr_etc_sub ( t ) ) ;
1458 
	    ts = enc_alignment ( ts, t ) ;
1459 
	    ts = enc_exp ( ts, e ) ;
1460 
	    bs = enc_bitstream ( bs, ts ) ;
1461 
	    break ;
1462 
	}
1463 
 
1464 
	case CONV_PTR_PTR :
1465 
	case CONV_PTR_BASE :
1466 
	case CONV_PTR_PTR | CONV_REVERSE :
1467 
	case CONV_PTR_BASE | CONV_REVERSE : {
1468 
	    /* Pointer to pointer conversion */
1469 
	    TYPE s = DEREF_type ( exp_type ( e ) ) ;
1470 
	    TYPE ps = DEREF_type ( type_ptr_etc_sub ( s ) ) ;
1471 
	    TYPE pt = DEREF_type ( type_ptr_etc_sub ( t ) ) ;
1472 
	    switch ( TAG_type ( pt ) ) {
1473 
		case type_top_tag :
1474 
		case type_bottom_tag : {
1475 
		    switch ( TAG_type ( ps ) ) {
1476 
			case type_top_tag :
1477 
			case type_bottom_tag : {
1478 
			    /* 'void *' to 'void *' */
1479 
			    bs = enc_exp ( bs, e ) ;
1480 
			    break ;
1481 
			}
1482 
			case type_func_tag : {
1483 
			    /* Function to 'void *' */
1484 
			    bs = enc_special ( bs, TOK_f_to_pv ) ;
1485 
			    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1486 
			    ts = enc_exp ( ts, e ) ;
1487 
			    bs = enc_bitstream ( bs, ts ) ;
1488 
			    break ;
1489 
			}
1490 
			default : {
1491 
			    /* Object pointer to 'void *' */
1492 
			    conv = CONV_PTR_VOID ;
1493 
			    goto pointer_void_label ;
1494 
			}
1495 
		    }
1496 
		    break ;
1497 
		}
1498 
		case type_func_tag : {
1499 
		    switch ( TAG_type ( ps ) ) {
1500 
			case type_top_tag :
1501 
			case type_bottom_tag : {
1502 
			    /* 'void *' to function */
1503 
			    bs = enc_special ( bs, TOK_pv_to_f ) ;
1504 
			    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1505 
			    ts = enc_exp ( ts, e ) ;
1506 
			    bs = enc_bitstream ( bs, ts ) ;
1507 
			    break ;
1508 
			}
1509 
			case type_func_tag : {
1510 
			    /* Function to function */
1511 
			    bs = enc_exp ( bs, e ) ;
1512 
			    break ;
1513 
			}
1514 
			default : {
1515 
			    /* Object pointer to function */
1516 
			    BITSTREAM *us ;
1517 
			    bs = enc_special ( bs, TOK_pv_to_f ) ;
1518 
			    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1519 
			    ts = enc_special ( ts, TOK_to_ptr_void ) ;
1520 
			    us = start_bitstream ( NIL ( FILE ), ts->link ) ;
1521 
			    us = enc_alignment ( us, ps ) ;
1522 
			    us = enc_exp ( us, e ) ;
1523 
			    ts = enc_bitstream ( ts, us ) ;
1524 
			    bs = enc_bitstream ( bs, ts ) ;
1525 
			    break ;
1526 
			}
1527 
		    }
1528 
		    break ;
1529 
		}
1530 
		default : {
1531 
		    switch ( TAG_type ( ps ) ) {
1532 
			case type_top_tag :
1533 
			case type_bottom_tag : {
1534 
			    /* 'void *' to object pointer */
1535 
			    conv = ( CONV_PTR_VOID | CONV_REVERSE ) ;
1536 
			    goto pointer_void_label ;
1537 
			}
1538 
			case type_func_tag : {
1539 
			    /* Function to object pointer */
1540 
			    BITSTREAM *us ;
1541 
			    bs = enc_special ( bs, TOK_from_ptr_void ) ;
1542 
			    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1543 
			    ts = enc_alignment ( ts, pt ) ;
1544 
			    ts = enc_special ( ts, TOK_f_to_pv ) ;
1545 
			    us = start_bitstream ( NIL ( FILE ), ts->link ) ;
1546 
			    us = enc_exp ( us, e ) ;
1547 
			    ts = enc_bitstream ( ts, us ) ;
1548 
			    bs = enc_bitstream ( bs, ts ) ;
1549 
			    break ;
1550 
			}
1551 
			default : {
1552 
			    /* Object pointer to object pointer */
1553 
			    if ( conv & CONV_REVERSE ) {
1554 
				/* Force conversion in these cases */
1555 
				/* EMPTY */
1556 
			    } else {
1557 
				if ( eq_type_rep ( ps, pt, 1 ) ) {
1558 
				    bs = enc_exp ( bs, e ) ;
1559 
				    break ;
1560 
				}
1561 
			    }
1562 
			    bs = enc_special ( bs, TOK_ptr_to_ptr ) ;
1563 
			    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1564 
			    ts = enc_alignment ( ts, ps ) ;
1565 
			    ts = enc_alignment ( ts, pt ) ;
1566 
			    ts = enc_exp ( ts, e ) ;
1567 
			    bs = enc_bitstream ( bs, ts ) ;
1568 
			    break ;
1569 
			}
1570 
		    }
1571 
		    break ;
1572 
		}
1573 
	    }
1574 
	    break ;
1575 
	}
1576 
 
1577 
	case CONV_INT_PTR : {
1578 
	    /* Integer to pointer conversion */
1579 
	    TYPE s = DEREF_type ( exp_type ( e ) ) ;
1580 
	    TYPE pt = DEREF_type ( type_ptr_etc_sub ( t ) ) ;
1581 
	    switch ( TAG_type ( pt ) ) {
1582 
		case type_top_tag :
1583 
		case type_bottom_tag : {
1584 
		    /* Integer to 'void *' */
1585 
		    bs = enc_special ( bs, TOK_i_to_pv ) ;
1586 
		    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1587 
		    ts = enc_variety ( ts, s ) ;
1588 
		    ts = enc_exp ( ts, e ) ;
1589 
		    bs = enc_bitstream ( bs, ts ) ;
1590 
		    break ;
1591 
		}
1592 
		case type_func_tag : {
1593 
		    /* Integer to function */
1594 
		    BITSTREAM *us ;
1595 
		    bs = enc_special ( bs, TOK_pv_to_f ) ;
1596 
		    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1597 
		    ts = enc_special ( ts, TOK_i_to_pv ) ;
1598 
		    us = start_bitstream ( NIL ( FILE ), ts->link ) ;
1599 
		    us = enc_variety ( us, s ) ;
1600 
		    us = enc_exp ( us, e ) ;
1601 
		    ts = enc_bitstream ( ts, us ) ;
1602 
		    bs = enc_bitstream ( bs, ts ) ;
1603 
		    break ;
1604 
		}
1605 
		default : {
1606 
		    /* Integer to object pointer */
1607 
		    bs = enc_special ( bs, TOK_i_to_p ) ;
1608 
		    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1609 
		    ts = enc_variety ( ts, s ) ;
1610 
		    ts = enc_alignment ( ts, pt ) ;
1611 
		    ts = enc_exp ( ts, e ) ;
1612 
		    bs = enc_bitstream ( bs, ts ) ;
1613 
		    break ;
1614 
		}
1615 
	    }
1616 
	    break ;
1617 
	}
1618 
 
1619 
	case CONV_PTR_INT : {
1620 
	    /* Pointer to integer conversion */
1621 
	    TYPE s = DEREF_type ( exp_type ( e ) ) ;
1622 
	    TYPE ps = DEREF_type ( type_ptr_etc_sub ( s ) ) ;
1623 
	    switch ( TAG_type ( ps ) ) {
1624 
		case type_top_tag :
1625 
		case type_bottom_tag : {
1626 
		    /* 'void *' to integer */
1627 
		    bs = enc_special ( bs, TOK_pv_to_i ) ;
1628 
		    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1629 
		    ts = enc_variety ( ts, t ) ;
1630 
		    ts = enc_exp ( ts, e ) ;
1631 
		    bs = enc_bitstream ( bs, ts ) ;
1632 
		    break ;
1633 
		}
1634 
		case type_func_tag : {
1635 
		    /* Function to integer */
1636 
		    BITSTREAM *us ;
1637 
		    bs = enc_special ( bs, TOK_pv_to_i ) ;
1638 
		    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1639 
		    ts = enc_variety ( ts, t ) ;
1640 
		    ts = enc_special ( ts, TOK_f_to_pv ) ;
1641 
		    us = start_bitstream ( NIL ( FILE ), ts->link ) ;
1642 
		    us = enc_exp ( us, e ) ;
1643 
		    ts = enc_bitstream ( ts, us ) ;
1644 
		    bs = enc_bitstream ( bs, ts ) ;
1645 
		    break ;
1646 
		}
1647 
		default : {
1648 
		    /* Object pointer to integer */
1649 
		    bs = enc_special ( bs, TOK_p_to_i ) ;
1650 
		    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1651 
		    ts = enc_alignment ( ts, ps ) ;
1652 
		    ts = enc_variety ( ts, t ) ;
1653 
		    ts = enc_exp ( ts, e ) ;
1654 
		    bs = enc_bitstream ( bs, ts ) ;
1655 
		    break ;
1656 
		}
1657 
	    }
1658 
	    break ;
1659 
	}
1660 
 
1661 
	case CONV_NULL : {
1662 
	    /* Null pointer conversion */
1663 
	    bs = enc_null_exp ( bs, t ) ;
1664 
	    break ;
1665 
	}
1666 
 
1667 
	case CONV_PTR_MEM_FUNC : {
1668 
	    /* Pointer to member function to function conversion */
1669 
	    IDENTIFIER fn = is_const_ptr_mem ( e, 1 ) ;
1670 
	    if ( !IS_NULL_id ( fn ) ) {
1671 
		/* Constant function */
1672 
		ulong n = unit_no ( bs, fn, VAR_tag, 0 ) ;
1673 
		ENC_obtain_tag ( bs ) ;
1674 
		ENC_make_tag ( bs, n ) ;
1675 
	    } else {
1676 
		/* Non-constant function */
1677 
		ulong n = LINK_NONE ;
1678 
		bs = make_ptr_mem_func ( bs, e, &n, 0 ) ;
1679 
		bs = enc_special ( bs, TOK_pmf_func ) ;
1680 
		ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1681 
		ENC_obtain_tag ( ts ) ;
1682 
		ENC_make_tag ( ts, n ) ;
1683 
		bs = enc_bitstream ( bs, ts ) ;
1684 
	    }
1685 
	    break ;
1686 
	}
1687 
 
1688 
	default : {
1689 
	    /* Other conversions */
1690 
	    TYPE s = DEREF_type ( exp_type ( e ) ) ;
1691 
	    if ( eq_type_rep ( s, t, 0 ) ) {
1692 
		bs = enc_exp ( bs, e ) ;
1693 
	    } else {
1694 
		ENC_component ( bs ) ;
1695 
		bs = enc_shape ( bs, t ) ;
1696 
		ENC_make_compound ( bs ) ;
1697 
		ENC_offset_max ( bs ) ;
1698 
		ENC_shape_offset ( bs ) ;
1699 
		bs = enc_shape ( bs, s ) ;
1700 
		ENC_shape_offset ( bs ) ;
1701 
		bs = enc_shape ( bs, t ) ;
1702 
		ENC_LIST_SMALL ( bs, 2 ) ;
1703 
		ENC_offset_zero ( bs ) ;
1704 
		bs = enc_alignment ( bs, s ) ;
1705 
		bs = enc_exp ( bs, e ) ;
1706 
		ENC_offset_zero ( bs ) ;
1707 
		bs = enc_alignment ( bs, t ) ;
1708 
	    }
1709 
	    break ;
1710 
	}
1711 
    }
1712 
    return ( bs ) ;
1713 
}
1714 
 
1715 
 
1716 
/*
1717 
    ENCODE A BASE CLASS CONVERSION
1718 
 
1719 
    This routine adds the base class conversion of e using the base
1720 
    offset off to the bitstream bs.  conv represents the conversion type.
1721 
*/
1722 
 
1723 
static BITSTREAM *enc_base_cast_exp
1724 
    PROTO_N ( ( bs, e, off, conv ) )
1725 
    PROTO_T ( BITSTREAM *bs X EXP e X OFFSET off X unsigned conv )
1726 
{
1727 
    if ( is_zero_offset ( off ) ) {
1728 
	/* Single inheritance */
1729 
	bs = enc_exp ( bs, e ) ;
1730 
    } else {
1731 
	/* Multiple inheritance */
1732 
	int ctok ;
1733 
	ulong lab ;
1734 
	BITSTREAM *ts ;
1735 
	int non_null = 0 ;
1736 
	ulong n = LINK_NONE ;
1737 
	TYPE s = DEREF_type ( exp_type ( e ) ) ;
1738 
	EXP a = DEREF_exp ( exp_dummy_value ( e ) ) ;
1739 
 
1740 
	/* Check for pointers to member functions */
1741 
	if ( IS_type_ptr_mem ( s ) ) {
1742 
	    TYPE ps = DEREF_type ( type_ptr_mem_sub ( s ) ) ;
1743 
	    if ( IS_type_func ( ps ) ) {
1744 
		VIRTUAL vt ;
1745 
		CLASS_TYPE ct = DEREF_ctype ( type_ptr_mem_of ( s ) ) ;
1746 
		IGNORE compile_class ( ct ) ;
1747 
		vt = DEREF_virt ( ctype_virt ( ct ) ) ;
1748 
		bs = make_ptr_mem_func ( bs, a, &n, 1 ) ;
1749 
		ENC_SEQ_SMALL ( bs, 1 ) ;
1750 
		if ( conv & CONV_REVERSE ) {
1751 
		    bs = enc_special ( bs, TOK_pmf_uncast ) ;
1752 
		} else {
1753 
		    bs = enc_special ( bs, TOK_pmf_cast ) ;
1754 
		}
1755 
		ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1756 
		ENC_obtain_tag ( ts ) ;
1757 
		ENC_make_tag ( ts, n ) ;
1758 
		ts = enc_offset ( ts, off ) ;
1759 
		ENC_make_int ( ts ) ;
1760 
		ts = enc_variety ( ts, type_sint ) ;
1761 
		ENC_make_signed_nat ( ts ) ;
1762 
		ENC_OFF ( ts ) ;
1763 
		if ( IS_NULL_virt ( vt ) ) {
1764 
		    ENC_INT ( ts, 0 ) ;
1765 
		    ENC_offset_zero ( ts ) ;
1766 
		    ENC_alignment ( ts ) ;
1767 
		    ts = enc_special ( ts, TOK_vtab_diag ) ;
1768 
		} else {
1769 
		    ulong vs = 0 ;
1770 
		    OFFSET voff = DEREF_off ( virt_table_off ( vt ) ) ;
1771 
		    ulong tok = DEREF_ulong ( virt_table_tok ( vt ) ) ;
1772 
		    if ( IS_off_base ( off ) ) {
1773 
			GRAPH gs = DEREF_graph ( off_base_graph ( off ) ) ;
1774 
			vs = virtual_start ( gs ) ;
1775 
		    } else if ( IS_off_deriv ( off ) ) {
1776 
			GRAPH gs = DEREF_graph ( off_deriv_graph ( off ) ) ;
1777 
			vs = virtual_start ( gs ) ;
1778 
		    }
1779 
		    ENC_INT ( ts, vs ) ;
1780 
		    if ( !is_zero_offset ( voff ) ) {
1781 
			ENC_offset_add ( ts ) ;
1782 
			ts = enc_offset ( ts, voff ) ;
1783 
		    }
1784 
		    tok = link_no ( ts, tok, VAR_token ) ;
1785 
		    ENC_exp_apply_token ( ts ) ;
1786 
		    ENC_make_tok ( ts, tok ) ;
1787 
		    ENC_LEN_SMALL ( ts, 0 ) ;
1788 
		}
1789 
		bs = enc_bitstream ( bs, ts ) ;
1790 
		ENC_contents ( bs ) ;
1791 
		bs = enc_special ( bs, TOK_pmf_type ) ;
1792 
		ENC_obtain_tag ( bs ) ;
1793 
		ENC_make_tag ( bs, n ) ;
1794 
		return ( bs ) ;
1795 
	    }
1796 
	}
1797 
 
1798 
	/* Check for null pointers */
1799 
	switch ( TAG_exp ( a ) ) {
1800 
	    case exp_address_tag :
1801 
	    case exp_address_mem_tag : {
1802 
		/* These can't be null */
1803 
		non_null = 1 ;
1804 
		break ;
1805 
	    }
1806 
	}
1807 
	if ( !non_null ) {
1808 
	    /* Set up dummy variable */
1809 
	    COPY_exp ( exp_dummy_value ( e ), NULL_exp ) ;
1810 
	    n = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
1811 
	    COPY_ulong ( exp_dummy_no ( e ), n ) ;
1812 
 
1813 
	    /* Introduce variable */
1814 
	    ENC_variable ( bs ) ;
1815 
	    bs = enc_access ( bs, dspec_none ) ;
1816 
	    ENC_make_tag ( bs, n ) ;
1817 
	    bs = enc_exp ( bs, a ) ;
1818 
	    ENC_SEQ_SMALL ( bs, 1 ) ;
1819 
 
1820 
	    /* Check for null pointer */
1821 
	    ENC_conditional ( bs ) ;
1822 
	    lab = unit_no ( bs, NULL_id, VAR_label, 1 ) ;
1823 
	    ENC_make_label ( bs, lab ) ;
1824 
	    bs = enc_compare ( bs, e, NULL_exp, ntest_eq, lab, LINK_NONE ) ;
1825 
 
1826 
	    /* Assign to variable */
1827 
	    ENC_assign ( bs ) ;
1828 
	    ENC_obtain_tag ( bs ) ;
1829 
	    ENC_make_tag ( bs, n ) ;
1830 
	}
1831 
 
1832 
	/* Add base class offset */
1833 
	ctok = TOK_pm_uncast ;
1834 
	switch ( conv ) {
1835 
	    case CONV_PTR_MEM_BASE : {
1836 
		/* Pointer to data member conversions */
1837 
		ctok = TOK_pm_cast ;
1838 
		goto ptr_mem_label ;
1839 
	    }
1840 
	    ptr_mem_label :
1841 
	    case CONV_PTR_MEM_BASE | CONV_REVERSE : {
1842 
		/* Pointer to data member conversions */
1843 
		bs = enc_special ( bs, ctok ) ;
1844 
		ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1845 
		ts = enc_exp ( ts, e ) ;
1846 
		ts = enc_offset ( ts, off ) ;
1847 
		bs = enc_bitstream ( bs, ts ) ;
1848 
		break ;
1849 
	    }
1850 
	    default : {
1851 
		/* Pointer conversions */
1852 
		if ( conv & CONV_REVERSE ) {
1853 
		    TYPE ps = DEREF_type ( type_ptr_etc_sub ( s ) ) ;
1854 
		    bs = enc_special ( bs, TOK_down_cast ) ;
1855 
		    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1856 
		    ts = enc_alignment ( ts, ps ) ;
1857 
		    ts = enc_exp ( ts, e ) ;
1858 
		    ts = enc_offset ( ts, off ) ;
1859 
		    bs = enc_bitstream ( bs, ts ) ;
1860 
		} else {
1861 
		    bs = enc_add_ptr ( bs, e, LINK_NONE, off, 1 ) ;
1862 
		}
1863 
		break ;
1864 
	    }
1865 
	}
1866 
 
1867 
	/* Return variable contents */
1868 
	if ( !non_null ) {
1869 
	    bs = enc_exp ( bs, e ) ;
1870 
	    COPY_exp ( exp_dummy_value ( e ), a ) ;
1871 
	}
1872 
    }
1873 
    return ( bs ) ;
1874 
}
1875 
 
1876 
 
1877 
/*
1878 
    ENCODE A TDF ERROR TREATMENT
1879 
 
1880 
    This routine adds an error treatment corresponding to arithmetic
1881 
    operations on the arithmetic type t to the bitstream bs.
1882 
*/
1883 
 
1884 
BITSTREAM *enc_error_treatment
1885 
    PROTO_N ( ( bs, t ) )
1886 
    PROTO_T ( BITSTREAM *bs X TYPE t )
1887 
{
1888 
    if ( IS_type_floating ( t ) || check_int_type ( t, btype_signed ) ) {
1889 
	ENC_impossible ( bs ) ;
1890 
    } else {
1891 
	ENC_wrap ( bs ) ;
1892 
    }
1893 
    return ( bs ) ;
1894 
}
1895 
 
1896 
 
1897 
/*
1898 
    ENCODE A LIST OF VIRTUAL FUNCTION ARGUMENTS
1899 
 
1900 
    This routine adds the list of virtual function arguments p to the
1901 
    bitstream bs.  m is a tag number giving a pointer into the virtual
1902 
    function table and j gives the number of the argument corresponding
1903 
    to the object pointer.
1904 
*/
1905 
 
1906 
static BITSTREAM *enc_virt_args
1907 
    PROTO_N ( ( bs, p, m, j ) )
1908 
    PROTO_T ( BITSTREAM *bs X LIST ( EXP ) p X ulong m X unsigned j )
1909 
{
1910 
    unsigned i ;
1911 
    unsigned n = LENGTH_list ( p ) ;
1912 
    ENC_LIST ( bs, n ) ;
1913 
    for ( i = 0 ; i < n ; i++ ) {
1914 
	EXP e = DEREF_exp ( HEAD_list ( p ) ) ;
1915 
	if ( i == j ) {
1916 
	    TYPE t ;
1917 
	    BITSTREAM *ts ;
1918 
	    ENC_add_to_ptr ( bs ) ;
1919 
	    bs = enc_exp ( bs, e ) ;
1920 
	    bs = enc_special ( bs, TOK_pmf_delta ) ;
1921 
	    ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1922 
	    t = DEREF_type ( exp_type ( e ) ) ;
1923 
	    if ( IS_type_ptr_etc ( t ) ) {
1924 
		t = DEREF_type ( type_ptr_etc_sub ( t ) ) ;
1925 
	    }
1926 
	    ts = enc_alignment ( ts, t ) ;
1927 
	    ENC_obtain_tag ( ts ) ;
1928 
	    ENC_make_tag ( ts, m ) ;
1929 
	    bs = enc_bitstream ( bs, ts ) ;
1930 
	} else {
1931 
	    bs = enc_exp ( bs, e ) ;
1932 
	}
1933 
	p = TAIL_list ( p ) ;
1934 
    }
1935 
    return ( bs ) ;
1936 
}
1937 
 
1938 
 
1939 
/*
1940 
    ENCODE A NAMED FUNCTION CALL
1941 
 
1942 
    This routine outputs an apply_proc construct for the identifier
1943 
    function call given by e to the bitstream bs.  t gives the return
1944 
    type.
1945 
*/
1946 
 
1947 
static BITSTREAM *enc_func_id_call
1948 
    PROTO_N ( ( bs, t, e ) )
1949 
    PROTO_T ( BITSTREAM *bs X TYPE t X EXP e )
1950 
{
1951 
    IDENTIFIER id = DEREF_id ( exp_func_id_id ( e ) ) ;
1952 
    LIST ( EXP ) args = DEREF_list ( exp_func_id_args ( e ) ) ;
1953 
    EXP virt = DEREF_exp ( exp_func_id_virt ( e ) ) ;
1954 
 
1955 
    /* Check for static member functions */
1956 
    unsigned tag = TAG_id ( id ) ;
1957 
    if ( tag == id_stat_mem_func_tag ) {
1958 
	EXP a = DEREF_exp ( HEAD_list ( args ) ) ;
1959 
	if ( !IS_NULL_exp ( a ) ) {
1960 
	    ENC_SEQ_SMALL ( bs, 1 ) ;
1961 
	    bs = enc_exp ( bs, a ) ;
1962 
	}
1963 
	args = TAIL_list ( args ) ;
1964 
    }
1965 
 
1966 
    /* Output the procedure application */
1967 
    if ( tag == id_token_tag ) {
1968 
	/* Function token */
1969 
	ulong n ;
1970 
	IGNORE enc_tokdef ( id, 0 ) ;
1971 
	ENC_exp_apply_token ( bs ) ;
1972 
	n = unit_no ( bs, id, VAR_token, 0 ) ;
1973 
	ENC_make_tok ( bs, n ) ;
1974 
	if ( IS_NULL_list ( args ) ) {
1975 
	    ENC_LEN_SMALL ( bs, 0 ) ;
1976 
	} else {
1977 
	    BITSTREAM *ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
1978 
	    while ( !IS_NULL_list ( args ) ) {
1979 
		EXP a = DEREF_exp ( HEAD_list ( args ) ) ;
1980 
		ts = enc_exp ( ts, a ) ;
1981 
		args = TAIL_list ( args ) ;
1982 
	    }
1983 
	    bs = enc_bitstream ( bs, ts ) ;
1984 
	}
1985 
 
1986 
    } else if ( !IS_NULL_exp ( virt ) ) {
1987 
	/* Virtual function */
1988 
	EXP a ;
1989 
	ulong tok ;
1990 
	VIRTUAL vt ;
1991 
	unsigned i ;
1992 
	OFFSET off ;
1993 
	BITSTREAM *ts ;
1994 
	ulong n, m, p ;
1995 
 
1996 
	/* Find class information */
1997 
	CLASS_TYPE ct = parent_class ( id ) ;
1998 
	IGNORE compile_class ( ct ) ;
1999 
	vt = DEREF_virt ( ctype_virt ( ct ) ) ;
2000 
	off = DEREF_off ( virt_table_off ( vt ) ) ;
2001 
	tok = DEREF_ulong ( virt_table_tok ( vt ) ) ;
2002 
	m = virtual_no ( id, vt ) ;
2003 
 
2004 
	/* Introduce variable for argument */
2005 
	a = DEREF_exp ( exp_dummy_value ( virt ) ) ;
2006 
	bs = make_ptr_mem_func ( bs, a, &n, 0 ) ;
2007 
	COPY_exp ( exp_dummy_value ( virt ), NULL_exp ) ;
2008 
	COPY_ulong ( exp_dummy_no ( virt ), n ) ;
2009 
 
2010 
	/* Find pointer to member function */
2011 
	p = unit_no ( bs, NULL_id, VAR_tag, 1 ) ;
2012 
	ENC_identify ( bs ) ;
2013 
	bs = enc_access ( bs, dspec_none ) ;
2014 
	ENC_make_tag ( bs, p ) ;
2015 
	bs = enc_special ( bs, TOK_vtab_func ) ;
2016 
	ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
2017 
	ENC_add_to_ptr ( ts ) ;
2018 
	ts = enc_add_ptr ( ts, virt, LINK_NONE, off, 0 ) ;
2019 
	tok = link_no ( ts, tok, VAR_token ) ;
2020 
	ENC_exp_apply_token ( ts ) ;
2021 
	ENC_make_tok ( ts, tok ) ;
2022 
	ENC_LEN_SMALL ( ts, 0 ) ;
2023 
	ts = enc_make_snat ( ts, ( int ) m ) ;
2024 
	bs = enc_bitstream ( bs, ts ) ;
2025 
 
2026 
	/* Encode function call */
2027 
	ENC_apply_proc ( bs ) ;
2028 
	bs = enc_shape ( bs, t ) ;
2029 
	bs = enc_special ( bs, TOK_pmf_func ) ;
2030 
	ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
2031 
	ENC_obtain_tag ( ts ) ;
2032 
	ENC_make_tag ( ts, p ) ;
2033 
	bs = enc_bitstream ( bs, ts ) ;
2034 
	i = DEREF_unsigned ( exp_func_id_extra ( e ) ) ;
2035 
	bs = enc_virt_args ( bs, args, p, i ) ;
2036 
	ENC_OFF ( bs ) ;
2037 
	COPY_exp ( exp_dummy_value ( virt ), a ) ;
2038 
 
2039 
    } else {
2040 
	/* Simple function */
2041 
	ulong n ;
2042 
	DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
2043 
	if ( ( ds & dspec_inline ) && !( ds & dspec_temp ) ) {
2044 
	    /* Check for function inlining */
2045 
	    if ( output_inline ) {
2046 
		EXP a = check_inline ( id, args, t ) ;
2047 
		if ( !IS_NULL_exp ( a ) ) {
2048 
		    COPY_dspec ( id_storage ( id ), ( ds | dspec_temp ) ) ;
2049 
		    bs = enc_exp ( bs, a ) ;
2050 
		    free_exp ( a, 1 ) ;
2051 
		    COPY_dspec ( id_storage ( id ), ds ) ;
2052 
		    return ( bs ) ;
2053 
		}
2054 
	    }
2055 
	}
2056 
	ENC_apply_proc ( bs ) ;
2057 
	bs = enc_shape ( bs, t ) ;
2058 
	IGNORE capsule_id ( id, VAR_tag ) ;
2059 
	n = unit_no ( bs, id, VAR_tag, 0 ) ;
2060 
	ENC_obtain_tag ( bs ) ;
2061 
	ENC_make_tag ( bs, n ) ;
2062 
	bs = enc_exp_list ( bs, args ) ;
2063 
	ENC_OFF ( bs ) ;
2064 
    }
2065 
    return ( bs ) ;
2066 
}
2067 
 
2068 
 
2069 
/*
2070 
    ENCODE A FUNCTION CALL
2071 
 
2072 
    This routine outputs an apply_proc construct for the expression
2073 
    function call given by e to the bitstream bs.  t gives the return
2074 
    type.
2075 
*/
2076 
 
2077 
static BITSTREAM *enc_func_call
2078 
    PROTO_N ( ( bs, t, e ) )
2079 
    PROTO_T ( BITSTREAM *bs X TYPE t X EXP e )
2080 
{
2081 
    EXP a = DEREF_exp ( exp_func_fn ( e ) ) ;
2082 
    LIST ( EXP ) args = DEREF_list ( exp_func_args ( e ) ) ;
2083 
    if ( IS_exp_call ( a ) ) {
2084 
	/* Pointer to member function call */
2085 
	EXP b ;
2086 
	EXP b1 ;
2087 
	TYPE s ;
2088 
	ulong n ;
2089 
	unsigned i ;
2090 
	BITSTREAM *ts ;
2091 
	CLASS_TYPE ct ;
2092 
	ulong m = LINK_NONE ;
2093 
 
2094 
	/* Decompose pointer to member */
2095 
	b = DEREF_exp ( exp_call_arg ( a ) ) ;
2096 
	b1 = DEREF_exp ( exp_dummy_value ( b ) ) ;
2097 
	a = DEREF_exp ( exp_call_ptr ( a ) ) ;
2098 
	s = DEREF_type ( exp_type ( a ) ) ;
2099 
	ct = DEREF_ctype ( type_ptr_mem_of ( s ) ) ;
2100 
 
2101 
	/* Introduce variable for argument */
2102 
	bs = make_ptr_mem_func ( bs, b1, &m, 0 ) ;
2103 
	COPY_exp ( exp_dummy_value ( b ), NULL_exp ) ;
2104 
	COPY_ulong ( exp_dummy_no ( b ), m ) ;
2105 
	IGNORE compile_class ( ct ) ;
2106 
 
2107 
	/* Allow for virtual functions */
2108 
	bs = make_ptr_mem_func ( bs, a, &n, 1 ) ;
2109 
	ENC_SEQ_SMALL ( bs, 1 ) ;
2110 
	bs = enc_special ( bs, TOK_pmf_virt ) ;
2111 
	ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
2112 
	ENC_obtain_tag ( ts ) ;
2113 
	ENC_make_tag ( ts, n ) ;
2114 
	ts = enc_exp ( ts, b ) ;
2115 
	ts = enc_al_ctype ( ts, ct ) ;
2116 
	bs = enc_bitstream ( bs, ts ) ;
2117 
 
2118 
	/* Encode call */
2119 
	ENC_apply_proc ( bs ) ;
2120 
	bs = enc_shape ( bs, t ) ;
2121 
	bs = enc_special ( bs, TOK_pmf_func ) ;
2122 
	ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
2123 
	ENC_obtain_tag ( ts ) ;
2124 
	ENC_make_tag ( ts, n ) ;
2125 
	bs = enc_bitstream ( bs, ts ) ;
2126 
	i = DEREF_unsigned ( exp_func_extra ( e ) ) ;
2127 
	bs = enc_virt_args ( bs, args, n, i ) ;
2128 
	ENC_OFF ( bs ) ;
2129 
	COPY_exp ( exp_dummy_value ( b ), b1 ) ;
2130 
 
2131 
    } else {
2132 
	/* Simple function call */
2133 
	ENC_apply_proc ( bs ) ;
2134 
	bs = enc_shape ( bs, t ) ;
2135 
	bs = enc_exp ( bs, a ) ;
2136 
	bs = enc_exp_list ( bs, args ) ;
2137 
	ENC_OFF ( bs ) ;
2138 
    }
2139 
    return ( bs ) ;
2140 
}
2141 
 
2142 
 
2143 
/*
2144 
    ENCODE A DUMMY EXPRESSION
2145 
 
2146 
    This routine adds the dummy expression given by the tag n plus the
2147 
    offset off to the bitstream bs.  cnt gives the expression type.
2148 
*/
2149 
 
2150 
BITSTREAM *enc_dummy_exp
2151 
    PROTO_N ( ( bs, t, n, off, cnt, virt ) )
2152 
    PROTO_T ( BITSTREAM *bs X TYPE t X ulong n X OFFSET off X
2153 
	      int cnt X int virt )
2154 
{
2155 
    int bf = 0 ;
2156 
    OFFSET off1 = NULL_off ;
2157 
    if ( cnt > 2 ) {
2158 
	/* Special tag */
2159 
	n = last_params [ cnt ] ;
2160 
	cnt = last_conts [ cnt ] ;
2161 
    }
2162 
    if ( n == LINK_NONE ) {
2163 
	/* This shouldn't happen */
2164 
	n = capsule_no ( NULL_string, VAR_tag ) ;
2165 
    }
2166 
    if ( n & LINK_EXTERN ) {
2167 
	/* Allow for global tags */
2168 
	n = link_no ( bs, n, VAR_tag ) ;
2169 
    }
2170 
    if ( cnt == 1 ) {
2171 
	/* Contents */
2172 
	bs = enc_cont_op ( bs, t, &bf ) ;
2173 
	if ( bf ) {
2174 
	    off1 = decons_bitf_off ( &off ) ;
2175 
	    bs = enc_bfvar ( bs, t ) ;
2176 
	} else {
2177 
	    bs = enc_shape ( bs, t ) ;
2178 
	}
2179 
    } else if ( cnt == 2 ) {
2180 
	/* Contents of pointer */
2181 
	ENC_contents ( bs ) ;
2182 
	ENC_pointer ( bs ) ;
2183 
	bs = enc_alignment ( bs, t ) ;
2184 
    }
2185 
    if ( is_zero_offset ( off ) ) {
2186 
	/* Zero offset */
2187 
	ENC_obtain_tag ( bs ) ;
2188 
	ENC_make_tag ( bs, n ) ;
2189 
    } else if ( virt ) {
2190 
	/* Virtual base offset */
2191 
	EXP e ;
2192 
	MAKE_exp_dummy ( t, NULL_exp, n, NULL_off, 0, e ) ;
2193 
	bs = enc_add_ptr ( bs, e, LINK_NONE, off, 1 ) ;
2194 
	free_exp ( e, 1 ) ;
2195 
    } else {
2196 
	/* Non-virtual base offset */
2197 
	ENC_add_to_ptr ( bs ) ;
2198 
	ENC_obtain_tag ( bs ) ;
2199 
	ENC_make_tag ( bs, n ) ;
2200 
	bs = enc_offset ( bs, off ) ;
2201 
    }
2202 
    if ( bf ) {
2203 
	/* End of bitfield contents */
2204 
	bs = enc_offset ( bs, off1 ) ;
2205 
    }
2206 
    return ( bs ) ;
2207 
}
2208 
 
2209 
 
2210 
/*
2211 
    ENCODE AN ASSIGNMENT EXPRESSION
2212 
 
2213 
    This routine adds the assignment or initialisation expression 'a = b'
2214 
    to the bitstream bs.
2215 
*/
2216 
 
2217 
static BITSTREAM *enc_assign_exp
2218 
    PROTO_N ( ( bs, a, b ) )
2219 
    PROTO_T ( BITSTREAM *bs X EXP a X EXP b )
2220 
{
2221 
    TYPE s = DEREF_type ( exp_type ( a ) ) ;
2222 
    if ( IS_exp_dummy ( a ) ) {
2223 
	/* Check for dummy expressions */
2224 
	EXP c = DEREF_exp ( exp_dummy_value ( a ) ) ;
2225 
	if ( IS_NULL_exp ( c ) ) {
2226 
	    ulong n = DEREF_ulong ( exp_dummy_no ( a ) ) ;
2227 
	    OFFSET off = DEREF_off ( exp_dummy_off ( a ) ) ;
2228 
	    int cnt = DEREF_int ( exp_dummy_cont ( a ) ) ;
2229 
	    bs = enc_init_tag ( bs, n, off, cnt, s, b, NULL_exp, 0 ) ;
2230 
	    return ( bs ) ;
2231 
	}
2232 
    }
2233 
    if ( is_init_complex ( b ) ) {
2234 
	/* Introduce identity for complex assignment */
2235 
	ulong n ;
2236 
	bs = make_identity ( bs, a, &n, 0, 0 ) ;
2237 
	bs = enc_init_tag ( bs, n, NULL_off, 0, s, b, NULL_exp, 0 ) ;
2238 
    } else {
2239 
	/* Simple assignment */
2240 
	int bf = 0 ;
2241 
	bs = enc_assign_op ( bs, s, &bf ) ;
2242 
	if ( bf ) {
2243 
	    /* Bitfield assignment */
2244 
	    OFFSET off = decons_bitf_exp ( &a ) ;
2245 
	    bs = enc_addr_exp ( bs, s, a ) ;
2246 
	    bs = enc_offset ( bs, off ) ;
2247 
	} else {
2248 
	    /* Non-bitfield assignment */
2249 
	    bs = enc_addr_exp ( bs, s, a ) ;
2250 
	}
2251 
	bs = enc_exp ( bs, b ) ;
2252 
    }
2253 
    return ( bs ) ;
2254 
}
2255 
 
2256 
 
2257 
/*
2258 
    ENCODE A TDF EXP
2259 
 
2260 
    This routine adds the expression e to the bitstream bs as a TDF EXP.
2261 
*/
2262 
 
2263 
BITSTREAM *enc_exp
2264 
    PROTO_N ( ( bs, e ) )
2265 
    PROTO_T ( BITSTREAM *bs X EXP e )
2266 
{
2267 
    TYPE t ;
2268 
    if ( IS_NULL_exp ( e ) ) {
2269 
	/* Deal with null expressions */
2270 
	ENC_make_top ( bs ) ;
2271 
	return ( bs ) ;
2272 
    }
2273 
 
2274 
    /* Examine expression cases */
2275 
    t = DEREF_type ( exp_type ( e ) ) ;
2276 
    ASSERT ( ORDER_exp == 88 ) ;
2277 
    switch ( TAG_exp ( e ) ) {
2278 
 
2279 
	case exp_identifier_tag : {
2280 
	    /* Identifier lvalue expressions */
2281 
	    bs = enc_addr_exp ( bs, t, e ) ;
2282 
	    break ;
2283 
	}
2284 
 
2285 
	case exp_int_lit_tag : {
2286 
	    /* Integer literals */
2287 
	    NAT n = DEREF_nat ( exp_int_lit_nat ( e ) ) ;
2288 
	    unsigned etag = DEREF_unsigned ( exp_int_lit_etag ( e ) ) ;
2289 
	    bs = enc_int_lit ( bs, n, t, etag ) ;
2290 
	    break ;
2291 
	}
2292 
 
2293 
	case exp_float_lit_tag : {
2294 
	    /* Floating literals */
2295 
	    FLOAT f = DEREF_flt ( exp_float_lit_flt ( e ) ) ;
2296 
	    bs = enc_float ( bs, f, t ) ;
2297 
	    break ;
2298 
	}
2299 
 
2300 
	case exp_char_lit_tag : {
2301 
	    /* Character literals */
2302 
	    STRING s = DEREF_str ( exp_char_lit_str ( e ) ) ;
2303 
	    bs = enc_char ( bs, s, t, t ) ;
2304 
	    break ;
2305 
	}
2306 
 
2307 
	case exp_string_lit_tag : {
2308 
	    /* String literals */
2309 
	    STRING s = DEREF_str ( exp_string_lit_str ( e ) ) ;
2310 
	    bs = enc_string ( bs, s, t ) ;
2311 
	    break ;
2312 
	}
2313 
 
2314 
	case exp_value_tag : {
2315 
	    /* Undefined values */
2316 
	    if ( IS_type_top ( t ) ) {
2317 
		ENC_make_top ( bs ) ;
2318 
	    } else {
2319 
		ENC_make_value ( bs ) ;
2320 
		bs = enc_shape ( bs, t ) ;
2321 
	    }
2322 
	    break ;
2323 
	}
2324 
 
2325 
	case exp_null_tag :
2326 
	case exp_zero_tag : {
2327 
	    /* Null expressions */
2328 
	    bs = enc_null_exp ( bs, t ) ;
2329 
	    break ;
2330 
	}
2331 
 
2332 
	case exp_paren_tag :
2333 
	case exp_copy_tag : {
2334 
	    /* Parenthesised expressions */
2335 
	    EXP a = DEREF_exp ( exp_paren_etc_arg ( e ) ) ;
2336 
	    bs = enc_exp ( bs, a ) ;
2337 
	    break ;
2338 
	}
2339 
 
2340 
	case exp_assign_tag : {
2341 
	    /* Assignment expressions */
2342 
	    EXP a = DEREF_exp ( exp_assign_ref ( e ) ) ;
2343 
	    EXP b = DEREF_exp ( exp_assign_arg ( e ) ) ;
2344 
	    bs = enc_assign_exp ( bs, a, b ) ;
2345 
	    break ;
2346 
	}
2347 
 
2348 
	case exp_init_tag : {
2349 
	    /* Initialisation expressions */
2350 
	    ulong n ;
2351 
	    int context = 1 ;
2352 
	    IDENTIFIER id = DEREF_id ( exp_init_id ( e ) ) ;
2353 
	    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
2354 
	    EXP a = DEREF_exp ( exp_init_arg ( e ) ) ;
2355 
	    EXP d = DEREF_exp ( id_variable_etc_term ( id ) ) ;
2356 
	    if ( !IS_NULL_exp ( d ) ) {
2357 
		while ( IS_exp_nof ( d ) ) {
2358 
		    d = DEREF_exp ( exp_nof_pad ( d ) ) ;
2359 
		}
2360 
		ENC_SEQ_SMALL ( bs, 1 ) ;
2361 
	    }
2362 
	    if ( !( ds & dspec_auto ) ) {
2363 
		/* Allow for external variables */
2364 
		if ( capsule_id ( id, VAR_tag ) ) {
2365 
		    make_term_global ( t, &d ) ;
2366 
		}
2367 
		context = 2 ;
2368 
	    }
2369 
	    n = unit_no ( bs, id, VAR_tag, 0 ) ;
2370 
	    bs = enc_init_tag ( bs, n, NULL_off, 0, t, a, d, context ) ;
2371 
	    break ;
2372 
	}
2373 
 
2374 
	case exp_preinc_tag : {
2375 
	    /* Pre-increment expressions */
2376 
	    int bf = 0 ;
2377 
	    ulong n = LINK_NONE ;
2378 
	    EXP a = DEREF_exp ( exp_preinc_ref ( e ) ) ;
2379 
	    EXP b = DEREF_exp ( exp_preinc_op ( e ) ) ;
2380 
	    EXP a1 = DEREF_exp ( exp_dummy_value ( a ) ) ;
2381 
	    TYPE s = DEREF_type ( exp_type ( a ) ) ;
2382 
	    int op = DEREF_int ( exp_preinc_becomes ( e ) ) ;
2383 
 
2384 
	    /* Declare identity for complex operations */
2385 
	    if ( op != lex_assign ) {
2386 
		COPY_exp ( exp_dummy_value ( a ), NULL_exp ) ;
2387 
		bs = make_identity ( bs, a1, &n, 0, 0 ) ;
2388 
		COPY_ulong ( exp_dummy_no ( a ), n ) ;
2389 
	    }
2390 
 
2391 
	    /* Encode the result */
2392 
	    bs = enc_assign_op ( bs, s, &bf ) ;
2393 
	    if ( n == LINK_NONE ) {
2394 
		bs = enc_exp ( bs, a1 ) ;
2395 
	    } else {
2396 
		ENC_obtain_tag ( bs ) ;
2397 
		ENC_make_tag ( bs, n ) ;
2398 
	    }
2399 
	    if ( bf ) {
2400 
		OFFSET off = DEREF_off ( exp_dummy_off ( a ) ) ;
2401 
		bs = enc_offset ( bs, off ) ;
2402 
	    }
2403 
	    bs = enc_exp ( bs, b ) ;
2404 
	    COPY_exp ( exp_dummy_value ( a ), a1 ) ;
2405 
	    break ;
2406 
	}
2407 
 
2408 
	case exp_postinc_tag : {
2409 
	    /* Post-increment expressions */
2410 
	    ulong n ;
2411 
	    int bf = 0 ;
2412 
	    EXP a = DEREF_exp ( exp_postinc_ref ( e ) ) ;
2413 
	    EXP b = DEREF_exp ( exp_postinc_value ( e ) ) ;
2414 
	    EXP c = DEREF_exp ( exp_postinc_op ( e ) ) ;
2415 
	    EXP a1 = DEREF_exp ( exp_dummy_value ( a ) ) ;
2416 
	    EXP b1 = NULL_exp ;
2417 
	    TYPE s = DEREF_type ( exp_type ( a ) ) ;
2418 
 
2419 
	    /* Declare outer identity */
2420 
	    COPY_exp ( exp_dummy_value ( a ), NULL_exp ) ;
2421 
	    bs = make_identity ( bs, a1, &n, 0, 0 ) ;
2422 
	    COPY_ulong ( exp_dummy_no ( a ), n ) ;
2423 
 
2424 
	    /* Declare inner identity if necessary */
2425 
	    if ( !IS_NULL_exp ( b ) ) {
2426 
		ulong m ;
2427 
		b1 = DEREF_exp ( exp_dummy_value ( b ) ) ;
2428 
		COPY_exp ( exp_dummy_value ( b ), NULL_exp ) ;
2429 
		bs = make_identity ( bs, b1, &m, 1, 1 ) ;
2430 
		COPY_ulong ( exp_dummy_no ( b ), m ) ;
2431 
	    }
2432 
 
2433 
	    /* Encode the result */
2434 
	    bs = enc_assign_op ( bs, s, &bf ) ;
2435 
	    ENC_obtain_tag ( bs ) ;
2436 
	    ENC_make_tag ( bs, n ) ;
2437 
	    if ( bf ) {
2438 
		OFFSET off = DEREF_off ( exp_dummy_off ( a ) ) ;
2439 
		bs = enc_offset ( bs, off ) ;
2440 
	    }
2441 
	    bs = enc_exp ( bs, c ) ;
2442 
	    if ( !IS_NULL_exp ( b ) ) {
2443 
		bs = enc_exp ( bs, b ) ;
2444 
		COPY_exp ( exp_dummy_value ( b ), b1 ) ;
2445 
	    }
2446 
	    COPY_exp ( exp_dummy_value ( a ), a1 ) ;
2447 
	    break ;
2448 
	}
2449 
 
2450 
	case exp_indir_tag : {
2451 
	    /* Indirection expressions */
2452 
	    EXP a = DEREF_exp ( exp_indir_ptr ( e ) ) ;
2453 
	    bs = enc_exp ( bs, a ) ;
2454 
	    break ;
2455 
	}
2456 
 
2457 
	case exp_contents_tag : {
2458 
	    /* Contents expressions */
2459 
	    EXP a = DEREF_exp ( exp_contents_ptr ( e ) ) ;
2460 
	    bs = enc_cont_exp ( bs, t, a ) ;
2461 
	    break ;
2462 
	}
2463 
 
2464 
	case exp_address_tag : {
2465 
	    /* Address expressions */
2466 
	    EXP a = DEREF_exp ( exp_address_arg ( e ) ) ;
2467 
	    bs = enc_addr_exp ( bs, t, a ) ;
2468 
	    break ;
2469 
	}
2470 
 
2471 
	case exp_address_mem_tag : {
2472 
	    /* Member address expressions */
2473 
	    EXP a = DEREF_exp ( exp_address_mem_arg ( e ) ) ;
2474 
	    IDENTIFIER id = DEREF_id ( exp_member_id ( a ) ) ;
2475 
	    bs = enc_ptr_mem ( bs, t, id, NULL_graph ) ;
2476 
	    break ;
2477 
	}
2478 
 
2479 
	case exp_func_tag : {
2480 
	    /* Function applications */
2481 
	    bs = enc_func_call ( bs, t, e ) ;
2482 
	    break ;
2483 
	}
2484 
 
2485 
	case exp_func_id_tag : {
2486 
	    /* Function identifier applications */
2487 
	    bs = enc_func_id_call ( bs, t, e ) ;
2488 
	    break ;
2489 
	}
2490 
 
2491 
	case exp_negate_tag : {
2492 
	    /* Negation expressions */
2493 
	    if ( IS_type_floating ( t ) ) {
2494 
		ENC_floating_negate ( bs ) ;
2495 
	    } else {
2496 
		ENC_negate ( bs ) ;
2497 
	    }
2498 
	    goto unary_err_label ;
2499 
	}
2500 
 
2501 
	case exp_compl_tag : {
2502 
	    /* Complement expressions */
2503 
	    ENC_not ( bs ) ;
2504 
	    goto unary_label ;
2505 
	}
2506 
 
2507 
	case exp_abs_tag : {
2508 
	    /* Absolute expressions */
2509 
	    if ( IS_type_floating ( t ) ) {
2510 
		ENC_floating_abs ( bs ) ;
2511 
	    } else {
2512 
		ENC_abs ( bs ) ;
2513 
	    }
2514 
	    goto unary_err_label ;
2515 
	}
2516 
 
2517 
	unary_err_label : {
2518 
	    /* Unary operands with error treatment */
2519 
	    bs = enc_error_treatment ( bs, t ) ;
2520 
	    goto unary_label ;
2521 
	}
2522 
 
2523 
	unary_label : {
2524 
	    /* Unary operands */
2525 
	    EXP a = DEREF_exp ( exp_negate_etc_arg ( e ) ) ;
2526 
	    bs = enc_exp ( bs, a ) ;
2527 
	    break ;
2528 
	}
2529 
 
2530 
	case exp_plus_tag : {
2531 
	    /* Addition expressions */
2532 
	    unsigned tag = TAG_type ( t ) ;
2533 
	    if ( tag == type_floating_tag ) {
2534 
		ENC_floating_plus ( bs ) ;
2535 
		ENC_impossible ( bs ) ;
2536 
		ENC_LIST_SMALL ( bs, 2 ) ;
2537 
	    } else {
2538 
		if ( tag == type_enumerate_tag ) {
2539 
		    /* Special case for enumerators */
2540 
		    t = promote_type ( t ) ;
2541 
		}
2542 
		ENC_plus ( bs ) ;
2543 
		bs = enc_error_treatment ( bs, t ) ;
2544 
	    }
2545 
	    goto binary_label ;
2546 
	}
2547 
 
2548 
	case exp_minus_tag : {
2549 
	    /* Subtraction expressions */
2550 
	    if ( IS_type_floating ( t ) ) {
2551 
		ENC_floating_minus ( bs ) ;
2552 
	    } else {
2553 
		ENC_minus ( bs ) ;
2554 
	    }
2555 
	    goto binary_err_label ;
2556 
	}
2557 
 
2558 
	case exp_mult_tag : {
2559 
	    /* Multiplication expressions */
2560 
	    if ( IS_type_floating ( t ) ) {
2561 
		ENC_floating_mult ( bs ) ;
2562 
		ENC_impossible ( bs ) ;
2563 
		ENC_LIST_SMALL ( bs, 2 ) ;
2564 
	    } else {
2565 
		ENC_mult ( bs ) ;
2566 
		bs = enc_error_treatment ( bs, t ) ;
2567 
	    }
2568 
	    goto binary_label ;
2569 
	}
2570 
 
2571 
	case exp_div_tag : {
2572 
	    /* Division expressions */
2573 
	    if ( IS_type_floating ( t ) ) {
2574 
		ENC_floating_div ( bs ) ;
2575 
	    } else {
2576 
		int div_mode = division_mode ;
2577 
		if ( div_mode == 3 ) {
2578 
		    /* Tokenised division */
2579 
		    bs = enc_special ( bs, TOK_div ) ;
2580 
		    goto division_label ;
2581 
		}
2582 
		switch ( div_mode ) {
2583 
		    case 0 : ENC_div0 ( bs ) ; break ;
2584 
		    case 1 : ENC_div1 ( bs ) ; break ;
2585 
		    case 2 : ENC_div2 ( bs ) ; break ;
2586 
		}
2587 
		ENC_impossible ( bs ) ;
2588 
	    }
2589 
	    goto binary_err_label ;
2590 
	}
2591 
 
2592 
	case exp_rem_tag : {
2593 
	    /* Remainder expressions */
2594 
	    int div_mode = division_mode ;
2595 
	    if ( div_mode == 3 ) {
2596 
		/* Tokenised division */
2597 
		bs = enc_special ( bs, TOK_rem ) ;
2598 
		goto division_label ;
2599 
	    }
2600 
	    switch ( div_mode ) {
2601 
		case 0 : ENC_rem0 ( bs ) ; break ;
2602 
		case 1 : ENC_rem1 ( bs ) ; break ;
2603 
		case 2 : ENC_rem2 ( bs ) ; break ;
2604 
	    }
2605 
	    ENC_impossible ( bs ) ;
2606 
	    goto binary_err_label ;
2607 
	}
2608 
 
2609 
	division_label : {
2610 
	    /* Division operands */
2611 
	    EXP a = DEREF_exp ( exp_plus_etc_arg1 ( e ) ) ;
2612 
	    EXP b = DEREF_exp ( exp_plus_etc_arg2 ( e ) ) ;
2613 
	    BITSTREAM *ts = start_bitstream ( NIL ( FILE ), bs->link ) ;
2614 
	    ts = enc_exp ( ts, a ) ;
2615 
	    ts = enc_exp ( ts, b ) ;
2616 
	    bs = enc_bitstream ( bs, ts ) ;
2617 
	    break ;
2618 
	}
2619 
 
2620 
	case exp_and_tag : {
2621 
	    /* Bitwise and expressions */
2622 
	    ENC_and ( bs ) ;
2623 
	    goto binary_label ; ;
2624 
	}
2625 
 
2626 
	case exp_or_tag : {
2627 
	    /* Bitwise or expressions */
2628 
	    ENC_or ( bs ) ;
2629 
	    goto binary_label ; ;
2630 
	}
2631 
 
2632 
	case exp_xor_tag : {
2633 
	    /* Bitwise xor expressions */
2634 
	    ENC_xor ( bs ) ;
2635 
	    goto binary_label ; ;
2636 
	}
2637 
 
2638 
	case exp_lshift_tag : {
2639 
	    /* Left shift expressions */
2640 
	    ENC_shift_left ( bs ) ;
2641 
	    goto binary_err_label ; ;
2642 
	}
2643 
 
2644 
	case exp_rshift_tag : {
2645 
	    /* Right shift expressions */
2646 
	    ENC_shift_right ( bs ) ;
2647 
	    goto binary_label ;
2648 
	}
2649 
 
2650 
	case exp_max_tag : {
2651 
	    /* Maximum expressions */
2652 
	    if ( IS_type_floating ( t ) ) {
2653 
		ENC_floating_maximum ( bs ) ;
2654 
#if ( TDF_major >= 4 )
2655 
		ENC_impossible ( bs ) ;
2656 
#endif
2657 
	    } else {
2658 
		ENC_maximum ( bs ) ;
2659 
	    }
2660 
	    goto binary_label ;
2661 
	}
2662 
 
2663 
	case exp_min_tag : {
2664 
	    /* Minimum expressions */
2665 
	    if ( IS_type_floating ( t ) ) {
2666 
		ENC_floating_minimum ( bs ) ;
2667 
#if ( TDF_major >= 4 )
2668 
		ENC_impossible ( bs ) ;
2669 
#endif
2670 
	    } else {
2671 
		ENC_minimum ( bs ) ;
2672 
	    }
2673 
	    goto binary_label ;
2674 
	}
2675 
 
2676 
	binary_err_label : {
2677 
	    /* Binary operands with error treatment */
2678 
	    bs = enc_error_treatment ( bs, t ) ;
2679 
	    goto binary_label ;
2680 
	}
2681 
 
2682 
	binary_label : {
2683 
	    /* Binary operands */
2684 
	    EXP a = DEREF_exp ( exp_plus_etc_arg1 ( e ) ) ;
2685 
	    EXP b = DEREF_exp ( exp_plus_etc_arg2 ( e ) ) ;
2686 
	    bs = enc_exp ( bs, a ) ;
2687 
	    bs = enc_exp ( bs, b ) ;
2688 
	    break ;
2689 
	}
2690 
 
2691 
	case exp_cast_tag : {
2692 
	    /* Cast expressions */
2693 
	    EXP a = DEREF_exp ( exp_cast_arg ( e ) ) ;
2694 
	    unsigned conv = DEREF_unsigned ( exp_cast_conv ( e ) ) ;
2695 
	    bs = enc_cast_exp ( bs, t, a, conv ) ;
2696 
	    break ;
2697 
	}
2698 
 
2699 
	case exp_base_cast_tag : {
2700 
	    /* Base class cast expressions */
2701 
	    EXP a = DEREF_exp ( exp_base_cast_arg ( e ) ) ;
2702 
	    OFFSET off = DEREF_off ( exp_base_cast_off ( e ) ) ;
2703 
	    unsigned conv = DEREF_unsigned ( exp_base_cast_conv ( e ) ) ;
2704 
	    if ( conv == CONV_PTR_MEM_BASE ) {
2705 
		/* Check for constant pointer to members */
2706 
		IDENTIFIER fn = is_const_ptr_mem ( a, 0 ) ;
2707 
		if ( !IS_NULL_id ( fn ) ) {
2708 
		    CLASS_TYPE cs = parent_class ( fn ) ;
2709 
		    CLASS_TYPE ct = DEREF_ctype ( type_ptr_mem_of ( t ) ) ;
2710 
		    GRAPH gr = find_base_class ( ct, cs, 0 ) ;
2711 
		    bs = enc_ptr_mem ( bs, t, fn, gr ) ;
2712 
		    break ;
2713 
		}
2714 
	    }
2715 
	    bs = enc_base_cast_exp ( bs, a, off, conv ) ;
2716 
	    break ;
2717 
	}
2718 
 
2719 
	case exp_add_ptr_tag : {
2720 
	    /* Pointer additions */
2721 
	    EXP a = DEREF_exp ( exp_add_ptr_ptr ( e ) ) ;
2722 
	    OFFSET off = DEREF_off ( exp_add_ptr_off ( e ) ) ;
2723 
	    int virt = DEREF_int ( exp_add_ptr_virt ( e ) ) ;
2724 
	    bs = enc_add_ptr ( bs, a, LINK_NONE, off, virt ) ;
2725 
	    break ;
2726 
	}
2727 
 
2728 
	case exp_offset_size_tag : {
2729 
	    /* Size of offset */
2730 
	    OFFSET off = DEREF_off ( exp_offset_size_off ( e ) ) ;
2731 
	    TYPE s = DEREF_type ( exp_offset_size_step ( e ) ) ;
2732 
	    ENC_offset_div ( bs ) ;
2733 
	    bs = enc_variety ( bs, t ) ;
2734 
	    bs = enc_offset ( bs, off ) ;
2735 
	    bs = enc_shape_offset ( bs, s ) ;
2736 
	    break ;
2737 
	}
2738 
 
2739 
	case exp_constr_tag : {
2740 
	    /* Constructor calls */
2741 
	    EXP a = DEREF_exp ( exp_constr_call ( e ) ) ;
2742 
	    bs = enc_exp ( bs, a ) ;
2743 
	    break ;
2744 
	}
2745 
 
2746 
	case exp_destr_tag : {
2747 
	    /* Destructor calls */
2748 
	    EXP a = DEREF_exp ( exp_destr_call ( e ) ) ;
2749 
	    bs = enc_exp ( bs, a ) ;
2750 
	    break ;
2751 
	}
2752 
 
2753 
	case exp_rtti_no_tag : {
2754 
	    /* Link-time type information */
2755 
	    TYPE s = DEREF_type ( exp_rtti_no_arg ( e ) ) ;
2756 
	    ENC_make_int ( bs ) ;
2757 
	    bs = enc_variety ( bs, t ) ;
2758 
	    bs = enc_arith ( bs, s, 0 ) ;
2759 
	    break ;
2760 
	}
2761 
 
2762 
	case exp_dynamic_tag : {
2763 
	    /* Dynamic initialisers */
2764 
	    EXP a = DEREF_exp ( exp_dynamic_arg ( e ) ) ;
2765 
	    bs = enc_exp ( bs, a ) ;
2766 
	    break ;
2767 
	}
2768 
 
2769 
	case exp_aggregate_tag : {
2770 
	    /* Aggregate initialisers */
2771 
	    unsigned tt = TAG_type ( t ) ;
2772 
	    if ( tt == type_array_tag ) {
2773 
		bs = enc_init_array ( bs, e, NULL_nat, t ) ;
2774 
	    } else if ( tt == type_compound_tag ) {
2775 
		CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
2776 
		bs = enc_init_class ( bs, e, ct ) ;
2777 
	    }
2778 
	    break ;
2779 
	}
2780 
 
2781 
	case exp_nof_tag : {
2782 
	    /* Array initialisers */
2783 
	    int pad = 1 ;
2784 
	    EXP a = DEREF_exp ( exp_nof_start ( e ) ) ;
2785 
	    NAT n = DEREF_nat ( exp_nof_size ( e ) ) ;
2786 
	    EXP b = DEREF_exp ( exp_nof_pad ( e ) ) ;
2787 
	    EXP c = DEREF_exp ( exp_nof_end ( e ) ) ;
2788 
	    if ( !IS_NULL_exp ( c ) ) ENC_concat_nof ( bs ) ;
2789 
	    if ( !IS_NULL_exp ( a ) ) {
2790 
		/* Encode initial component */
2791 
		if ( IS_exp_aggregate ( a ) && is_zero_exp ( b ) ) {
2792 
		    /* Deal with integral arrays */
2793 
		    bs = enc_init_array ( bs, a, n, t ) ;
2794 
		    break ;
2795 
		}
2796 
		if ( is_zero_nat ( n ) ) {
2797 
		    pad = 0 ;
2798 
		} else {
2799 
		    ENC_concat_nof ( bs ) ;
2800 
		}
2801 
		bs = enc_exp ( bs, a ) ;
2802 
	    }
2803 
	    if ( pad ) {
2804 
		ENC_n_copies ( bs ) ;
2805 
		bs = enc_nat ( bs, n, 1 ) ;
2806 
		if ( IS_NULL_exp ( b ) ) {
2807 
		    TYPE s = DEREF_type ( type_array_sub ( t ) ) ;
2808 
		    bs = enc_null_exp ( bs, s ) ;
2809 
		} else {
2810 
		    bs = enc_exp ( bs, b ) ;
2811 
		}
2812 
	    }
2813 
	    if ( !IS_NULL_exp ( c ) ) bs = enc_exp ( bs, c ) ;
2814 
	    break ;
2815 
	}
2816 
 
2817 
	case exp_call_tag : {
2818 
	    /* Shouldn't happen */
2819 
	    EXP a = DEREF_exp ( exp_call_ptr ( e ) ) ;
2820 
	    EXP b = DEREF_exp ( exp_call_arg ( e ) ) ;
2821 
	    ENC_SEQ_SMALL ( bs, 1 ) ;
2822 
	    bs = enc_exp ( bs, a ) ;
2823 
	    bs = enc_exp ( bs, b ) ;
2824 
	    break ;
2825 
	}
2826 
 
2827 
	case exp_not_tag :
2828 
	case exp_log_and_tag :
2829 
	case exp_log_or_tag :
2830 
	case exp_test_tag :
2831 
	case exp_compare_tag : {
2832 
	    /* Logical expressions */
2833 
	    bs = enc_logical ( bs, e, t ) ;
2834 
	    break ;
2835 
	}
2836 
 
2837 
	case exp_assembler_tag : {
2838 
	    /* Assembler expression */
2839 
	    bs = enc_asm ( bs, e ) ;
2840 
	    break ;
2841 
	}
2842 
 
2843 
	case exp_fail_tag : {
2844 
	    /* Install-time failure expression */
2845 
	    string s = DEREF_string ( exp_fail_msg ( e ) ) ;
2846 
	    ENC_fail_installer ( bs ) ;
2847 
	    ENC_make_string ( bs ) ;
2848 
	    bs = enc_ustring ( bs, s ) ;
2849 
	    break ;
2850 
	}
2851 
 
2852 
	case exp_token_tag : {
2853 
	    /* Token applications */
2854 
	    IDENTIFIER tok = DEREF_id ( exp_token_tok ( e ) ) ;
2855 
	    LIST ( TOKEN ) args = DEREF_list ( exp_token_args ( e ) ) ;
2856 
	    bs = enc_token ( bs, tok, args ) ;
2857 
	    break ;
2858 
	}
2859 
 
2860 
	case exp_dummy_tag : {
2861 
	    /* Dummy identifier tag */
2862 
	    EXP a = DEREF_exp ( exp_dummy_value ( e ) ) ;
2863 
	    if ( IS_NULL_exp ( a ) ) {
2864 
		ulong n = DEREF_ulong ( exp_dummy_no ( e ) ) ;
2865 
		OFFSET off = DEREF_off ( exp_dummy_off ( e ) ) ;
2866 
		int cnt = DEREF_int ( exp_dummy_cont ( e ) ) ;
2867 
		int virt = DEREF_int ( exp_dummy_virt ( e ) ) ;
2868 
		bs = enc_dummy_exp ( bs, t, n, off, cnt, virt ) ;
2869 
	    } else {
2870 
		bs = enc_exp ( bs, a ) ;
2871 
	    }
2872 
	    break ;
2873 
	}
2874 
 
2875 
#if LANGUAGE_CPP
2876 
	case exp_alloc_tag : {
2877 
	    /* Allocator calls */
2878 
	    bs = enc_alloc ( bs, e ) ;
2879 
	    break ;
2880 
	}
2881 
 
2882 
	case exp_dealloc_tag : {
2883 
	    /* Deallocator calls */
2884 
	    bs = enc_dealloc ( bs, e, LINK_NONE ) ;
2885 
	    break ;
2886 
	}
2887 
 
2888 
	case exp_rtti_tag : {
2889 
	    /* Run-time type information */
2890 
	    if ( IS_type_compound ( t ) ) {
2891 
		/* Make sure that 'type_info' is completed */
2892 
		CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
2893 
		IGNORE compile_class ( ct ) ;
2894 
	    }
2895 
	    bs = enc_rtti_exp ( bs, e ) ;
2896 
	    break ;
2897 
	}
2898 
 
2899 
	case exp_rtti_type_tag : {
2900 
	    /* Run-time type information */
2901 
	    TYPE s = DEREF_type ( exp_rtti_type_arg ( e ) ) ;
2902 
	    int op = DEREF_int ( exp_rtti_type_op ( e ) ) ;
2903 
	    if ( IS_type_compound ( t ) ) {
2904 
		/* Make sure that 'type_info' is completed */
2905 
		CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
2906 
		IGNORE compile_class ( ct ) ;
2907 
	    }
2908 
	    bs = enc_rtti_type ( bs, s, op ) ;
2909 
	    break ;
2910 
	}
2911 
 
2912 
	case exp_dyn_cast_tag : {
2913 
	    /* Dynamic cast expressions */
2914 
	    bs = enc_dyn_cast ( bs, e ) ;
2915 
	    break ;
2916 
	}
2917 
 
2918 
	case exp_initialiser_tag : {
2919 
	    /* Constructor initialisers */
2920 
	    bs = enc_ctor_init ( bs, e ) ;
2921 
	    break ;
2922 
	}
2923 
 
2924 
	case exp_exception_tag : {
2925 
	    /* Throw expression */
2926 
	    EXP a = DEREF_exp ( exp_exception_arg ( e ) ) ;
2927 
	    EXP b = DEREF_exp ( exp_exception_size ( e ) ) ;
2928 
	    EXP d = DEREF_exp ( exp_exception_destr ( e ) ) ;
2929 
	    bs = enc_throw ( bs, a, b, d ) ;
2930 
	    break ;
2931 
	}
2932 
 
2933 
	case exp_thrown_tag : {
2934 
	    /* Thrown expression */
2935 
	    int done = DEREF_int ( exp_thrown_done ( e ) ) ;
2936 
	    if ( done ) {
2937 
		bs = enc_special ( bs, TOK_except_caught ) ;
2938 
	    } else {
2939 
		bs = enc_thrown ( bs, t ) ;
2940 
	    }
2941 
	    break ;
2942 
	}
2943 
#endif
2944 
 
2945 
	case exp_comma_tag :
2946 
	case exp_if_stmt_tag :
2947 
	case exp_hash_if_tag :
2948 
	case exp_location_tag : {
2949 
	    /* Statement-like expressions */
2950 
	    bs = enc_stmt_exp ( bs, e, t, 1 ) ;
2951 
	    break ;
2952 
	}
2953 
 
2954 
	case exp_reach_tag :
2955 
	case exp_unreach_tag :
2956 
	case exp_sequence_tag :
2957 
	case exp_solve_stmt_tag :
2958 
	case exp_decl_stmt_tag :
2959 
	case exp_while_stmt_tag :
2960 
	case exp_do_stmt_tag :
2961 
	case exp_switch_stmt_tag :
2962 
	case exp_return_stmt_tag :
2963 
	case exp_goto_stmt_tag :
2964 
	case exp_label_stmt_tag :
2965 
	case exp_try_block_tag :
2966 
	case exp_handler_tag : {
2967 
	    /* Statements */
2968 
	    bs = enc_stmt ( bs, e ) ;
2969 
	    break ;
2970 
	}
2971 
 
2972 
	case exp_member_tag :
2973 
	case exp_ambiguous_tag :
2974 
	case exp_undeclared_tag :
2975 
	case exp_set_tag :
2976 
	case exp_unused_tag :
2977 
	case exp_op_tag :
2978 
	case exp_opn_tag :
2979 
	case exp_uncompiled_tag :
2980 
	default : {
2981 
	    /* Illegal expressions */
2982 
	    ENC_make_top ( bs ) ;
2983 
	    break ;
2984 
	}
2985 
    }
2986 
    return ( bs ) ;
2987 
}
2988 
 
2989 
 
2990 
#endif /* TDF_OUTPUT */