Rev 5 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed
/*
Crown Copyright (c) 1997
This TenDRA(r) Computer Program is subject to Copyright
owned by the United Kingdom Secretary of State for Defence
acting through the Defence Evaluation and Research Agency
(DERA). It is made available to Recipients with a
royalty-free licence for its use, reproduction, transfer
to other parties and amendment for any purpose not excluding
product development provided that any such use et cetera
shall be deemed to be acceptance of the following conditions:-
(1) Its Recipients shall ensure that this Notice is
reproduced upon any copies or amended versions of it;
(2) Any amended version of it shall be clearly marked to
show both the nature of and the organisation responsible
for the relevant amendment or amendments;
(3) Its onward transfer from a recipient to another
party shall be deemed to be that party's acceptance of
these conditions;
(4) DERA gives no warranty or assurance as to its
quality or suitability for any purpose and DERA accepts
no liability whatsoever in relation to any use to which
it may be put.
*/
/* AUTOMATICALLY GENERATED BY make_tdf VERSION 2.0 FROM TDF 4.1 */
#define sub0( X ) ( ( X )->son )
#define sub1( X ) ( ( X )->son->bro )
#define sub2( X ) ( ( X )->son->bro->bro )
#define sub3( X ) ( ( X )->son->bro->bro->bro )
#define sub4( X ) ( ( X )->son->bro->bro->bro->bro )
#define sub5( X ) ( ( X )->son->bro->bro->bro->bro->bro )
#define sub6( X ) ( ( X )->son->bro->bro->bro->bro->bro->bro )
#define sub7( X ) ( ( X )->son->bro->bro->bro->bro->bro->bro->bro )
/*
SET THE SHAPE OF AN EXPRESSION
The shape of the expression exp is calculated and assigned. Most of
the work is done by the check routines above, as selected by an
automatically generated switch statement.
*/
void check_exp_fn
PROTO_N ( ( exp ) )
PROTO_T ( node *exp )
{
long m ;
if ( exp == null ) return ;
m = exp->cons->encoding ;
if ( m == ENC_labelled ) {
node *placelabs_intro = sub0 ( exp ) ;
node *places = sub2 ( exp ) ;
if ( placelabs_intro->cons->encoding != places->cons->encoding ) {
input_error ( "Labels don't match exps in labelled" ) ;
}
}
if ( do_check ) {
if ( exp->shape ) return ;
checking = exp->cons->name ;
switch ( m ) {
case ENC_exp_apply_token : {
CHECK_exp_apply_token
break ;
}
case ENC_exp_cond : {
node *control = sub0 ( exp ) ;
CHECK_exp_cond
break ;
}
case ENC_abs : {
node *arg1 = sub1 ( exp ) ;
CHECK_abs
break ;
}
case ENC_add_to_ptr : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_add_to_ptr
break ;
}
case ENC_and : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_and
break ;
}
case ENC_apply_proc : {
node *result_shape = sub0 ( exp ) ;
node *p = sub1 ( exp ) ;
node *params = sub2 ( exp ) ;
node *var_param = sub3 ( exp ) ;
CHECK_apply_proc
break ;
}
case ENC_apply_general_proc : {
node *result_shape = sub0 ( exp ) ;
node *p = sub2 ( exp ) ;
node *postlude = sub5 ( exp ) ;
CHECK_apply_general_proc
break ;
}
case ENC_assign : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_assign
break ;
}
case ENC_assign_with_mode : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_assign_with_mode
break ;
}
case ENC_bitfield_assign : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
node *arg3 = sub2 ( exp ) ;
CHECK_bitfield_assign
break ;
}
case ENC_bitfield_assign_with_mode : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
node *arg3 = sub3 ( exp ) ;
CHECK_bitfield_assign_with_mode
break ;
}
case ENC_bitfield_contents : {
node *v = sub0 ( exp ) ;
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_bitfield_contents
break ;
}
case ENC_bitfield_contents_with_mode : {
node *v = sub1 ( exp ) ;
node *arg1 = sub2 ( exp ) ;
node *arg2 = sub3 ( exp ) ;
CHECK_bitfield_contents_with_mo
break ;
}
case ENC_case : {
node *exhaustive = sub0 ( exp ) ;
node *control = sub1 ( exp ) ;
CHECK_case
break ;
}
case ENC_change_bitfield_to_int : {
node *v = sub0 ( exp ) ;
node *arg1 = sub1 ( exp ) ;
CHECK_change_bitfield_to_int
break ;
}
case ENC_change_floating_variety : {
node *r = sub1 ( exp ) ;
node *arg1 = sub2 ( exp ) ;
CHECK_change_floating_variety
break ;
}
case ENC_change_variety : {
node *r = sub1 ( exp ) ;
node *arg1 = sub2 ( exp ) ;
CHECK_change_variety
break ;
}
case ENC_change_int_to_bitfield : {
node *bv = sub0 ( exp ) ;
node *arg1 = sub1 ( exp ) ;
CHECK_change_int_to_bitfield
break ;
}
case ENC_complex_conjugate : {
node *c = sub0 ( exp ) ;
CHECK_complex_conjugate
break ;
}
case ENC_component : {
node *sha = sub0 ( exp ) ;
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_component
break ;
}
case ENC_concat_nof : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_concat_nof
break ;
}
case ENC_conditional : {
node *first = sub1 ( exp ) ;
node *alt = sub2 ( exp ) ;
CHECK_conditional
break ;
}
case ENC_contents : {
node *s = sub0 ( exp ) ;
node *arg1 = sub1 ( exp ) ;
CHECK_contents
break ;
}
case ENC_contents_with_mode : {
node *s = sub1 ( exp ) ;
node *arg1 = sub2 ( exp ) ;
CHECK_contents_with_mode
break ;
}
case ENC_current_env : {
CHECK_current_env
break ;
}
case ENC_div0 : {
node *arg1 = sub2 ( exp ) ;
node *arg2 = sub3 ( exp ) ;
CHECK_div0
break ;
}
case ENC_div1 : {
node *arg1 = sub2 ( exp ) ;
node *arg2 = sub3 ( exp ) ;
CHECK_div1
break ;
}
case ENC_div2 : {
node *arg1 = sub2 ( exp ) ;
node *arg2 = sub3 ( exp ) ;
CHECK_div2
break ;
}
case ENC_env_offset : {
node *fa = sub0 ( exp ) ;
node *y = sub1 ( exp ) ;
node *t = sub2 ( exp ) ;
CHECK_env_offset
break ;
}
case ENC_env_size : {
node *proctag = sub0 ( exp ) ;
CHECK_env_size
break ;
}
case ENC_fail_installer : {
node *message = sub0 ( exp ) ;
CHECK_fail_installer
break ;
}
case ENC_float_int : {
node *f = sub1 ( exp ) ;
node *arg1 = sub2 ( exp ) ;
CHECK_float_int
break ;
}
case ENC_floating_abs : {
node *arg1 = sub1 ( exp ) ;
CHECK_floating_abs
break ;
}
case ENC_floating_div : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_floating_div
break ;
}
case ENC_floating_minus : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_floating_minus
break ;
}
case ENC_floating_maximum : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_floating_maximum
break ;
}
case ENC_floating_minimum : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_floating_minimum
break ;
}
case ENC_floating_mult : {
node *arg1 = sub1 ( exp ) ;
CHECK_floating_mult
break ;
}
case ENC_floating_negate : {
node *arg1 = sub1 ( exp ) ;
CHECK_floating_negate
break ;
}
case ENC_floating_plus : {
node *arg1 = sub1 ( exp ) ;
CHECK_floating_plus
break ;
}
case ENC_floating_power : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_floating_power
break ;
}
case ENC_floating_test : {
node *arg1 = sub4 ( exp ) ;
node *arg2 = sub5 ( exp ) ;
CHECK_floating_test
break ;
}
case ENC_goto : {
CHECK_goto
break ;
}
case ENC_goto_local_lv : {
node *arg1 = sub0 ( exp ) ;
CHECK_goto_local_lv
break ;
}
case ENC_identify : {
node *name_intro = sub1 ( exp ) ;
node *definition = sub2 ( exp ) ;
node *body = sub3 ( exp ) ;
CHECK_identify
break ;
}
case ENC_ignorable : {
node *arg1 = sub0 ( exp ) ;
CHECK_ignorable
break ;
}
case ENC_imaginary_part : {
node *arg1 = sub0 ( exp ) ;
CHECK_imaginary_part
break ;
}
case ENC_initial_value : {
node *init = sub0 ( exp ) ;
CHECK_initial_value
break ;
}
case ENC_integer_test : {
node *arg1 = sub3 ( exp ) ;
node *arg2 = sub4 ( exp ) ;
CHECK_integer_test
break ;
}
case ENC_labelled : {
node *starter = sub1 ( exp ) ;
node *places = sub2 ( exp ) ;
CHECK_labelled
break ;
}
case ENC_last_local : {
node *x = sub0 ( exp ) ;
CHECK_last_local
break ;
}
case ENC_local_alloc : {
node *arg1 = sub0 ( exp ) ;
CHECK_local_alloc
break ;
}
case ENC_local_alloc_check : {
node *arg1 = sub0 ( exp ) ;
CHECK_local_alloc_check
break ;
}
case ENC_local_free : {
node *a = sub0 ( exp ) ;
node *p = sub1 ( exp ) ;
CHECK_local_free
break ;
}
case ENC_local_free_all : {
CHECK_local_free_all
break ;
}
case ENC_long_jump : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_long_jump
break ;
}
case ENC_make_complex : {
node *c = sub0 ( exp ) ;
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_make_complex
break ;
}
case ENC_make_compound : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_make_compound
break ;
}
case ENC_make_floating : {
node *f = sub0 ( exp ) ;
node *negative = sub2 ( exp ) ;
node *mantissa = sub3 ( exp ) ;
node *base = sub4 ( exp ) ;
CHECK_make_floating
break ;
}
case ENC_make_general_proc : {
node *result_shape = sub0 ( exp ) ;
node *body = sub4 ( exp ) ;
CHECK_make_general_proc
break ;
}
case ENC_make_int : {
node *v = sub0 ( exp ) ;
CHECK_make_int
break ;
}
case ENC_make_local_lv : {
CHECK_make_local_lv
break ;
}
case ENC_make_nof : {
node *arg1 = sub0 ( exp ) ;
CHECK_make_nof
break ;
}
case ENC_make_nof_int : {
node *v = sub0 ( exp ) ;
node *str = sub1 ( exp ) ;
CHECK_make_nof_int
break ;
}
case ENC_make_null_local_lv : {
CHECK_make_null_local_lv
break ;
}
case ENC_make_null_proc : {
CHECK_make_null_proc
break ;
}
case ENC_make_null_ptr : {
node *a = sub0 ( exp ) ;
CHECK_make_null_ptr
break ;
}
case ENC_make_proc : {
node *result_shape = sub0 ( exp ) ;
node *body = sub3 ( exp ) ;
CHECK_make_proc
break ;
}
case ENC_make_stack_limit : {
node *stack_base = sub0 ( exp ) ;
node *frame_size = sub1 ( exp ) ;
node *alloc_size = sub2 ( exp ) ;
CHECK_make_stack_limit
break ;
}
case ENC_make_top : {
CHECK_make_top
break ;
}
case ENC_make_value : {
node *s = sub0 ( exp ) ;
CHECK_make_value
break ;
}
case ENC_maximum : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_maximum
break ;
}
case ENC_minimum : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_minimum
break ;
}
case ENC_minus : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_minus
break ;
}
case ENC_move_some : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
node *arg3 = sub3 ( exp ) ;
CHECK_move_some
break ;
}
case ENC_mult : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_mult
break ;
}
case ENC_n_copies : {
node *n = sub0 ( exp ) ;
node *arg1 = sub1 ( exp ) ;
CHECK_n_copies
break ;
}
case ENC_negate : {
node *arg1 = sub1 ( exp ) ;
CHECK_negate
break ;
}
case ENC_not : {
node *arg1 = sub0 ( exp ) ;
CHECK_not
break ;
}
case ENC_obtain_tag : {
node *t = sub0 ( exp ) ;
CHECK_obtain_tag
break ;
}
case ENC_offset_add : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_offset_add
break ;
}
case ENC_offset_div : {
node *v = sub0 ( exp ) ;
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_offset_div
break ;
}
case ENC_offset_div_by_int : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_offset_div_by_int
break ;
}
case ENC_offset_max : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_offset_max
break ;
}
case ENC_offset_mult : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_offset_mult
break ;
}
case ENC_offset_negate : {
node *arg1 = sub0 ( exp ) ;
CHECK_offset_negate
break ;
}
case ENC_offset_pad : {
node *a = sub0 ( exp ) ;
node *arg1 = sub1 ( exp ) ;
CHECK_offset_pad
break ;
}
case ENC_offset_subtract : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_offset_subtract
break ;
}
case ENC_offset_test : {
node *arg1 = sub3 ( exp ) ;
node *arg2 = sub4 ( exp ) ;
CHECK_offset_test
break ;
}
case ENC_offset_zero : {
node *a = sub0 ( exp ) ;
CHECK_offset_zero
break ;
}
case ENC_or : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_or
break ;
}
case ENC_plus : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_plus
break ;
}
case ENC_pointer_test : {
node *arg1 = sub3 ( exp ) ;
node *arg2 = sub4 ( exp ) ;
CHECK_pointer_test
break ;
}
case ENC_power : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_power
break ;
}
case ENC_proc_test : {
node *arg1 = sub3 ( exp ) ;
node *arg2 = sub4 ( exp ) ;
CHECK_proc_test
break ;
}
case ENC_profile : {
node *uses = sub0 ( exp ) ;
CHECK_profile
break ;
}
case ENC_real_part : {
node *arg1 = sub0 ( exp ) ;
CHECK_real_part
break ;
}
case ENC_rem0 : {
node *arg1 = sub2 ( exp ) ;
node *arg2 = sub3 ( exp ) ;
CHECK_rem0
break ;
}
case ENC_rem1 : {
node *arg1 = sub2 ( exp ) ;
node *arg2 = sub3 ( exp ) ;
CHECK_rem1
break ;
}
case ENC_rem2 : {
node *arg1 = sub2 ( exp ) ;
node *arg2 = sub3 ( exp ) ;
CHECK_rem2
break ;
}
case ENC_repeat : {
node *start = sub1 ( exp ) ;
node *body = sub2 ( exp ) ;
CHECK_repeat
break ;
}
case ENC_return : {
node *arg1 = sub0 ( exp ) ;
CHECK_return
break ;
}
case ENC_return_to_label : {
node *lab_val = sub0 ( exp ) ;
CHECK_return_to_label
break ;
}
case ENC_round_with_mode : {
node *r = sub2 ( exp ) ;
node *arg1 = sub3 ( exp ) ;
CHECK_round_with_mode
break ;
}
case ENC_rotate_left : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_rotate_left
break ;
}
case ENC_rotate_right : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_rotate_right
break ;
}
case ENC_sequence : {
node *statements = sub0 ( exp ) ;
node *result = sub1 ( exp ) ;
CHECK_sequence
break ;
}
case ENC_set_stack_limit : {
node *lim = sub0 ( exp ) ;
CHECK_set_stack_limit
break ;
}
case ENC_shape_offset : {
node *s = sub0 ( exp ) ;
CHECK_shape_offset
break ;
}
case ENC_shift_left : {
node *arg1 = sub1 ( exp ) ;
node *arg2 = sub2 ( exp ) ;
CHECK_shift_left
break ;
}
case ENC_shift_right : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_shift_right
break ;
}
case ENC_subtract_ptrs : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_subtract_ptrs
break ;
}
case ENC_tail_call : {
node *p = sub1 ( exp ) ;
CHECK_tail_call
break ;
}
case ENC_untidy_return : {
node *arg1 = sub0 ( exp ) ;
CHECK_untidy_return
break ;
}
case ENC_variable : {
node *name_intro = sub1 ( exp ) ;
node *init = sub2 ( exp ) ;
node *body = sub3 ( exp ) ;
CHECK_variable
break ;
}
case ENC_xor : {
node *arg1 = sub0 ( exp ) ;
node *arg2 = sub1 ( exp ) ;
CHECK_xor
break ;
}
}
exp->shape = expand_fully ( exp->shape ) ;
}
return ;
}