Subversion Repositories tendra.SVN

Rev

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

Rev 5 Rev 6
Line -... Line 1...
-
 
1
/*
-
 
2
 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
-
 
3
 * All rights reserved.
-
 
4
 *
-
 
5
 * Redistribution and use in source and binary forms, with or without
-
 
6
 * modification, are permitted provided that the following conditions are met:
-
 
7
 *
-
 
8
 * 1. Redistributions of source code must retain the above copyright notice,
-
 
9
 *    this list of conditions and the following disclaimer.
-
 
10
 * 2. Redistributions in binary form must reproduce the above copyright notice,
-
 
11
 *    this list of conditions and the following disclaimer in the documentation
-
 
12
 *    and/or other materials provided with the distribution.
-
 
13
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
-
 
14
 *    may be used to endorse or promote products derived from this software
-
 
15
 *    without specific, prior written permission.
-
 
16
 *
-
 
17
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
-
 
18
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
-
 
19
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-
 
20
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
-
 
21
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-
 
22
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-
 
23
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-
 
24
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-
 
25
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-
 
26
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-
 
27
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
 
28
 *
-
 
29
 * $Id$
-
 
30
 */
1
/*
31
/*
2
    		 Crown Copyright (c) 1997
32
    		 Crown Copyright (c) 1997
3
   
33
 
4
    This TenDRA(r) Computer Program is subject to Copyright
34
    This TenDRA(r) Computer Program is subject to Copyright
5
    owned by the United Kingdom Secretary of State for Defence
35
    owned by the United Kingdom Secretary of State for Defence
6
    acting through the Defence Evaluation and Research Agency
36
    acting through the Defence Evaluation and Research Agency
7
    (DERA).  It is made available to Recipients with a
37
    (DERA).  It is made available to Recipients with a
8
    royalty-free licence for its use, reproduction, transfer
38
    royalty-free licence for its use, reproduction, transfer
9
    to other parties and amendment for any purpose not excluding
39
    to other parties and amendment for any purpose not excluding
10
    product development provided that any such use et cetera
40
    product development provided that any such use et cetera
11
    shall be deemed to be acceptance of the following conditions:-
41
    shall be deemed to be acceptance of the following conditions:-
12
   
42
 
13
        (1) Its Recipients shall ensure that this Notice is
43
        (1) Its Recipients shall ensure that this Notice is
14
        reproduced upon any copies or amended versions of it;
44
        reproduced upon any copies or amended versions of it;
15
   
45
 
16
        (2) Any amended version of it shall be clearly marked to
46
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
47
        show both the nature of and the organisation responsible
18
        for the relevant amendment or amendments;
48
        for the relevant amendment or amendments;
19
   
49
 
20
        (3) Its onward transfer from a recipient to another
50
        (3) Its onward transfer from a recipient to another
21
        party shall be deemed to be that party's acceptance of
51
        party shall be deemed to be that party's acceptance of
22
        these conditions;
52
        these conditions;
23
   
53
 
24
        (4) DERA gives no warranty or assurance as to its
54
        (4) DERA gives no warranty or assurance as to its
25
        quality or suitability for any purpose and DERA accepts
55
        quality or suitability for any purpose and DERA accepts
26
        no liability whatsoever in relation to any use to which
56
        no liability whatsoever in relation to any use to which
27
        it may be put.
57
        it may be put.
28
*/
58
*/
Line 34... Line 64...
34
    This file contains the definitions for the shape checking macros
64
    This file contains the definitions for the shape checking macros
35
    generated in check_exp.h.
65
    generated in check_exp.h.
36
*/
66
*/
37
 
67
 
38
#if FS_TENDRA
68
#if FS_TENDRA
39
#define UNUSED_ARG( A )			UNUSED ( A )
69
#define UNUSED_ARG(A)			UNUSED(A)
40
#else
70
#else
41
#define UNUSED_ARG( A )			( ( void ) ( A ) )
71
#define UNUSED_ARG(A)			((void)(A))
42
#endif
72
#endif
43
 
73
 
44
#define CHECK_exp_apply_token		chk_token ( exp ) ;
74
#define CHECK_exp_apply_token		chk_token(exp);
45
 
75
 
46
#define CHECK_exp_cond\
76
#define CHECK_exp_cond\
47
	IGNORE check1 ( ENC_integer, control ) ;\
77
	IGNORE check1(ENC_integer, control);\
48
	chk_cond ( exp ) ;
78
	chk_cond(exp);
49
 
79
 
50
#define CHECK_abs			CHECK_negate
80
#define CHECK_abs			CHECK_negate
51
 
81
 
52
#define CHECK_add_to_ptr\
82
#define CHECK_add_to_ptr\
53
	node *sh1 = check1 ( ENC_pointer, arg1 ) ;\
83
	node *sh1 = check1(ENC_pointer, arg1);\
54
	node *sh2 = check1 ( ENC_offset, arg2 ) ;\
84
	node *sh2 = check1(ENC_offset, arg2);\
55
	al_includes ( ptr_to ( sh1 ), offset_from ( sh2 ) ) ;\
85
	al_includes(ptr_to(sh1), offset_from(sh2));\
56
	exp->shape = sh_pointer ( offset_to ( sh2 ) ) ;
86
	exp->shape = sh_pointer(offset_to(sh2));
57
 
87
 
58
#define CHECK_and\
88
#define CHECK_and\
59
	exp->shape = normalize ( check2 ( ENC_integer, arg1, arg2 ) ) ;
89
	exp->shape = normalize(check2(ENC_integer, arg1, arg2));
60
 
90
 
61
#define CHECK_apply_proc\
91
#define CHECK_apply_proc\
62
	exp->shape = normalize ( result_shape ) ;\
92
	exp->shape = normalize(result_shape);\
63
	IGNORE check1 ( ENC_proc, p ) ;\
93
	IGNORE check1(ENC_proc, p);\
64
	UNUSED_ARG ( params ) ;\
94
	UNUSED_ARG(params);\
65
	UNUSED_ARG ( var_param ) ;
95
	UNUSED_ARG(var_param);
66
 
96
 
67
#define CHECK_apply_general_proc\
97
#define CHECK_apply_general_proc\
68
	exp->shape = normalize ( result_shape ) ;\
98
	exp->shape = normalize(result_shape);\
69
	IGNORE check1 ( ENC_proc, p ) ;\
99
	IGNORE check1(ENC_proc, p);\
70
	UNUSED_ARG ( postlude ) ;
100
	UNUSED_ARG(postlude);
71
 
101
 
72
#define CHECK_assign\
102
#define CHECK_assign\
73
	node *sh1 = check1 ( ENC_pointer, arg1 ) ;\
103
	node *sh1 = check1(ENC_pointer, arg1);\
74
	al_includes ( ptr_to ( sh1 ), al_shape ( arg2 ) ) ;\
104
	al_includes(ptr_to(sh1), al_shape(arg2));\
75
	exp->shape = sh_top ;
105
	exp->shape = sh_top;
76
 
106
 
77
#define CHECK_assign_with_mode		CHECK_assign
107
#define CHECK_assign_with_mode		CHECK_assign
78
 
108
 
79
#define CHECK_bitfield_assign\
109
#define CHECK_bitfield_assign\
80
	node *sh1 = check1 ( ENC_pointer, arg1 ) ;\
110
	node *sh1 = check1(ENC_pointer, arg1);\
81
	node *sh2 = check1 ( ENC_offset, arg2 ) ;\
111
	node *sh2 = check1(ENC_offset, arg2);\
82
	node *sh3 = check1 ( ENC_bitfield, arg3 ) ;\
112
	node *sh3 = check1(ENC_bitfield, arg3);\
83
	al_includes ( ptr_to ( sh1 ), offset_from ( sh2 ) ) ;\
113
	al_includes(ptr_to(sh1), offset_from(sh2));\
84
	al_includes ( offset_to ( sh2 ), al_shape ( sh3 ) ) ;\
114
	al_includes(offset_to(sh2), al_shape(sh3));\
85
	exp->shape = sh_top ;
115
	exp->shape = sh_top;
86
 
116
 
87
#define CHECK_bitfield_assign_with_mode	CHECK_bitfield_assign
117
#define CHECK_bitfield_assign_with_mode	CHECK_bitfield_assign
88
 
118
 
89
#define CHECK_bitfield_contents\
119
#define CHECK_bitfield_contents\
90
	node *sh = sh_bitfield ( v ) ;\
120
	node *sh = sh_bitfield(v);\
91
	node *sh1 = check1 ( ENC_pointer, arg1 ) ;\
121
	node *sh1 = check1(ENC_pointer, arg1);\
92
	node *sh2 = check1 ( ENC_offset, arg2 ) ;\
122
	node *sh2 = check1(ENC_offset, arg2);\
93
	al_includes ( ptr_to ( sh1 ), offset_from ( sh2 ) ) ;\
123
	al_includes(ptr_to(sh1), offset_from(sh2));\
94
	al_includes ( offset_to ( sh2 ), al_shape ( sh ) ) ;\
124
	al_includes(offset_to(sh2), al_shape(sh));\
95
	exp->shape = sh ;
125
	exp->shape = sh;
96
 
126
 
97
#define CHECK_bitfield_contents_with_mo	CHECK_bitfield_contents
127
#define CHECK_bitfield_contents_with_mo	CHECK_bitfield_contents
98
 
128
 
99
#define CHECK_case\
129
#define CHECK_case\
100
	IGNORE check1 ( ENC_integer, control ) ;\
130
	IGNORE check1(ENC_integer, control);\
101
	if ( exhaustive && exhaustive->cons->encoding == ENC_true ) {\
131
	if (exhaustive && exhaustive->cons->encoding == ENC_true) {\
102
	    exp->shape = sh_bottom ;\
132
	    exp->shape = sh_bottom ;\
103
	} else {\
133
	} else {\
104
	    exp->shape = sh_top ;\
134
	    exp->shape = sh_top ;\
105
	}
135
	}
106
 
136
 
107
#define CHECK_change_bitfield_to_int\
137
#define CHECK_change_bitfield_to_int\
108
	exp->shape = sh_integer ( v ) ;\
138
	exp->shape = sh_integer(v);\
109
	IGNORE check1 ( ENC_bitfield, arg1 ) ;
139
	IGNORE check1(ENC_bitfield, arg1);
110
 
140
 
111
#define CHECK_change_floating_variety\
141
#define CHECK_change_floating_variety\
112
	exp->shape = sh_floating ( r ) ;\
142
	exp->shape = sh_floating(r);\
113
	IGNORE check1 ( ENC_floating, arg1 ) ;
143
	IGNORE check1(ENC_floating, arg1);
114
 
144
 
115
#define CHECK_change_variety\
145
#define CHECK_change_variety\
116
	exp->shape = sh_integer ( r ) ;\
146
	exp->shape = sh_integer(r);\
117
	IGNORE check1 ( ENC_integer, arg1 ) ;
147
	IGNORE check1(ENC_integer, arg1);
118
 
148
 
119
#define CHECK_change_int_to_bitfield\
149
#define CHECK_change_int_to_bitfield\
120
	exp->shape = sh_bitfield ( bv ) ;\
150
	exp->shape = sh_bitfield(bv);\
121
	IGNORE check1 ( ENC_integer, arg1 ) ;
151
	IGNORE check1(ENC_integer, arg1);
122
 
152
 
123
#define CHECK_complex_conjugate\
153
#define CHECK_complex_conjugate\
124
	exp->shape = normalize ( c->shape ) ;
154
	exp->shape = normalize(c->shape);
125
 
155
 
126
#define CHECK_component\
156
#define CHECK_component\
127
	exp->shape = normalize ( sha ) ;\
157
	exp->shape = normalize(sha);\
128
	IGNORE check1 ( ENC_compound, arg1 ) ;\
158
	IGNORE check1(ENC_compound, arg1);\
129
	IGNORE check1 ( ENC_offset, arg2 ) ;
159
	IGNORE check1(ENC_offset, arg2);
130
 
160
 
131
#define CHECK_concat_nof\
161
#define CHECK_concat_nof\
132
	exp->shape = normalize ( check2 ( ENC_nof, arg1, arg2 ) ) ;
162
	exp->shape = normalize(check2(ENC_nof, arg1, arg2));
133
 
163
 
134
#define CHECK_conditional\
164
#define CHECK_conditional\
135
	exp->shape = normalize ( lub ( first->shape, alt->shape ) ) ;
165
	exp->shape = normalize(lub(first->shape, alt->shape));
136
 
166
 
137
#define CHECK_contents\
167
#define CHECK_contents\
138
	node *sh1 = check1 ( ENC_pointer, arg1 ) ;\
168
	node *sh1 = check1(ENC_pointer, arg1);\
139
	al_includes ( ptr_to ( sh1 ), al_shape ( s ) ) ;\
169
	al_includes(ptr_to(sh1), al_shape(s));\
140
	exp->shape = normalize ( s ) ;
170
	exp->shape = normalize(s);
141
 
171
 
142
#define CHECK_contents_with_mode	CHECK_contents
172
#define CHECK_contents_with_mode	CHECK_contents
143
 
173
 
144
#define CHECK_current_env\
174
#define CHECK_current_env\
145
	exp->shape = sh_pointer ( al_frame ) ;
175
	exp->shape = sh_pointer(al_frame);
146
 
176
 
147
#define CHECK_div0			CHECK_and
177
#define CHECK_div0			CHECK_and
148
 
178
 
149
#define CHECK_div1			CHECK_and
179
#define CHECK_div1			CHECK_and
150
 
180
 
151
#define CHECK_div2			CHECK_and
181
#define CHECK_div2			CHECK_and
152
 
182
 
153
#define CHECK_env_offset\
183
#define CHECK_env_offset\
154
	exp->shape = sh_offset ( fa, y ) ;\
184
	exp->shape = sh_offset(fa, y);\
155
	chk_tag ( exp, t, 0 ) ;
185
	chk_tag(exp, t, 0);
156
 
186
 
157
#define CHECK_env_size\
187
#define CHECK_env_size\
158
	exp->shape = sh_offset ( al_frame, al_top ) ;\
188
	exp->shape = sh_offset(al_frame, al_top);\
159
	IGNORE check1 ( ENC_proc, proctag ) ;
189
	IGNORE check1(ENC_proc, proctag);
160
 
190
 
161
#define CHECK_fail_installer\
191
#define CHECK_fail_installer\
162
	exp->shape = sh_bottom ;\
192
	exp->shape = sh_bottom ;\
163
	UNUSED_ARG ( message ) ;
193
	UNUSED_ARG(message);
164
 
194
 
165
#define CHECK_float_int\
195
#define CHECK_float_int\
166
	exp->shape = sh_floating ( f ) ;\
196
	exp->shape = sh_floating(f);\
167
	IGNORE check1 ( ENC_integer, arg1 ) ;
197
	IGNORE check1(ENC_integer, arg1);
168
 
198
 
169
#define CHECK_floating_abs\
199
#define CHECK_floating_abs\
170
	exp->shape = normalize ( check1 ( ENC_floating, arg1 ) ) ;
200
	exp->shape = normalize(check1(ENC_floating, arg1));
171
 
201
 
172
#define CHECK_floating_div\
202
#define CHECK_floating_div\
173
	exp->shape = normalize ( check2 ( ENC_floating, arg1, arg2 ) ) ;
203
	exp->shape = normalize(check2(ENC_floating, arg1, arg2));
174
 
204
 
175
#define CHECK_floating_minus		CHECK_floating_div
205
#define CHECK_floating_minus		CHECK_floating_div
176
 
206
 
177
#define CHECK_floating_maximum		CHECK_floating_div
207
#define CHECK_floating_maximum		CHECK_floating_div
178
 
208
 
179
#define CHECK_floating_minimum		CHECK_floating_div
209
#define CHECK_floating_minimum		CHECK_floating_div
180
 
210
 
181
#define CHECK_floating_mult\
211
#define CHECK_floating_mult\
182
	exp->shape = normalize ( checkn ( ENC_floating, arg1, 1 ) ) ;
212
	exp->shape = normalize(checkn(ENC_floating, arg1, 1));
183
 
213
 
184
#define CHECK_floating_negate		CHECK_floating_abs
214
#define CHECK_floating_negate		CHECK_floating_abs
185
 
215
 
186
#define CHECK_floating_plus		CHECK_floating_mult
216
#define CHECK_floating_plus		CHECK_floating_mult
187
 
217
 
188
#define CHECK_floating_power\
218
#define CHECK_floating_power\
189
	exp->shape = normalize ( check1 ( ENC_floating, arg1 ) ) ;\
219
	exp->shape = normalize(check1(ENC_floating, arg1));\
190
	IGNORE check1 ( ENC_integer, arg2 ) ;
220
	IGNORE check1(ENC_integer, arg2);
191
 
221
 
192
#define CHECK_floating_test\
222
#define CHECK_floating_test\
193
	exp->shape = sh_top ;\
223
	exp->shape = sh_top ;\
194
	IGNORE check2 ( ENC_floating, arg1, arg2 ) ;
224
	IGNORE check2(ENC_floating, arg1, arg2);
195
 
225
 
196
#define CHECK_goto			exp->shape = sh_bottom ;
226
#define CHECK_goto			exp->shape = sh_bottom;
197
 
227
 
198
#define CHECK_goto_local_lv\
228
#define CHECK_goto_local_lv\
199
	exp->shape = sh_bottom ;\
229
	exp->shape = sh_bottom ;\
200
	IGNORE check1 ( ENC_pointer, arg1 ) ;
230
	IGNORE check1(ENC_pointer, arg1);
201
 
231
 
202
#define CHECK_identify\
232
#define CHECK_identify\
203
	exp->shape = normalize ( body->shape ) ;\
233
	exp->shape = normalize(body->shape);\
204
	chk_tag ( exp, name_intro, 1 ) ;\
234
	chk_tag(exp, name_intro, 1);\
205
	UNUSED_ARG ( definition ) ;
235
	UNUSED_ARG(definition);
206
 
236
 
207
#define CHECK_ignorable\
237
#define CHECK_ignorable\
208
	exp->shape = normalize ( arg1->shape ) ;
238
	exp->shape = normalize(arg1->shape);
209
 
239
 
210
#define CHECK_imaginary_part\
240
#define CHECK_imaginary_part\
211
	exp->shape = null ;\
241
	exp->shape = null ;\
212
	UNUSED_ARG ( arg1 ) ;
242
	UNUSED_ARG(arg1);
213
 
243
 
214
#define CHECK_initial_value\
244
#define CHECK_initial_value\
215
	exp->shape = normalize ( init->shape ) ;
245
	exp->shape = normalize(init->shape);
216
 
246
 
217
#define CHECK_integer_test\
247
#define CHECK_integer_test\
218
	exp->shape = sh_top ;\
248
	exp->shape = sh_top ;\
219
	IGNORE check2 ( ENC_integer, arg1, arg2 ) ;
249
	IGNORE check2(ENC_integer, arg1, arg2);
220
 
250
 
221
#define CHECK_labelled\
251
#define CHECK_labelled\
222
	node *sh = starter->shape ;\
252
	node *sh = starter->shape ;\
223
	node *place = places->son ;\
253
	node *place = places->son ;\
224
	while ( place ) {\
254
	while (place) {\
225
	    sh = lub ( sh, place->shape ) ;\
255
	    sh = lub(sh, place->shape);\
226
	    place = place->bro ;\
256
	    place = place->bro ;\
227
	}\
257
	}\
228
	exp->shape = normalize ( sh ) ;
258
	exp->shape = normalize(sh);
229
 
259
 
230
#define CHECK_last_local\
260
#define CHECK_last_local\
231
	exp->shape = sh_pointer ( al_alloca ) ;\
261
	exp->shape = sh_pointer(al_alloca);\
232
	IGNORE check1 ( ENC_offset, x ) ;
262
	IGNORE check1(ENC_offset, x);
233
 
263
 
234
#define CHECK_local_alloc\
264
#define CHECK_local_alloc\
235
	exp->shape = sh_pointer ( al_alloca ) ;\
265
	exp->shape = sh_pointer(al_alloca);\
236
	IGNORE check1 ( ENC_offset, arg1 ) ;
266
	IGNORE check1(ENC_offset, arg1);
237
 
267
 
238
#define CHECK_local_alloc_check		CHECK_local_alloc
268
#define CHECK_local_alloc_check		CHECK_local_alloc
239
 
269
 
240
#define CHECK_local_free\
270
#define CHECK_local_free\
241
	exp->shape = sh_top ;\
271
	exp->shape = sh_top ;\
242
	IGNORE check1 ( ENC_offset, a ) ;\
272
	IGNORE check1(ENC_offset, a);\
243
	IGNORE check1 ( ENC_pointer, p ) ;
273
	IGNORE check1(ENC_pointer, p);
244
 
274
 
245
#define CHECK_local_free_all		exp->shape = sh_top ;
275
#define CHECK_local_free_all		exp->shape = sh_top;
246
 
276
 
247
#define CHECK_long_jump\
277
#define CHECK_long_jump\
248
	exp->shape = sh_bottom ;\
278
	exp->shape = sh_bottom ;\
249
	IGNORE check1 ( ENC_pointer, arg1 ) ;\
279
	IGNORE check1(ENC_pointer, arg1);\
250
	IGNORE check1 ( ENC_pointer, arg2 ) ;
280
	IGNORE check1(ENC_pointer, arg2);
251
 
281
 
252
#define CHECK_make_complex\
282
#define CHECK_make_complex\
253
	exp->shape = sh_floating ( c ) ;\
283
	exp->shape = sh_floating(c);\
254
	IGNORE check1 ( ENC_floating, arg1 ) ;\
284
	IGNORE check1(ENC_floating, arg1);\
255
	IGNORE check1 ( ENC_floating, arg2 ) ;
285
	IGNORE check1(ENC_floating, arg2);
256
 
286
 
257
#define CHECK_make_compound\
287
#define CHECK_make_compound\
258
	exp->shape = sh_compound ( arg1 ) ;\
288
	exp->shape = sh_compound(arg1);\
259
	IGNORE check1 ( ENC_offset, arg1 ) ;\
289
	IGNORE check1(ENC_offset, arg1);\
260
	UNUSED_ARG ( arg2 ) ;
290
	UNUSED_ARG(arg2);
261
 
291
 
262
#define CHECK_make_floating\
292
#define CHECK_make_floating\
263
	exp->shape = sh_floating ( f ) ;\
293
	exp->shape = sh_floating(f);\
264
	UNUSED_ARG ( base ) ;\
294
	UNUSED_ARG(base);\
265
	UNUSED_ARG ( mantissa ) ;\
295
	UNUSED_ARG(mantissa);\
266
	UNUSED_ARG ( negative ) ;
296
	UNUSED_ARG(negative);
267
 
297
 
268
#define CHECK_make_general_proc\
298
#define CHECK_make_general_proc\
269
	exp->shape = sh_proc ;\
299
	exp->shape = sh_proc ;\
270
	IGNORE check1 ( ENC_bottom, body ) ;\
300
	IGNORE check1(ENC_bottom, body);\
271
	UNUSED_ARG ( result_shape ) ;
301
	UNUSED_ARG(result_shape);
272
 
302
 
273
#define CHECK_make_int			exp->shape = sh_integer ( v ) ;
303
#define CHECK_make_int			exp->shape = sh_integer(v);
274
 
304
 
275
#define CHECK_make_local_lv		exp->shape = sh_pointer ( al_code ) ;
305
#define CHECK_make_local_lv		exp->shape = sh_pointer(al_code);
276
 
306
 
277
#define CHECK_make_nof\
307
#define CHECK_make_nof\
278
	long ns = arg1->cons->encoding ;\
308
	long ns = arg1->cons->encoding ;\
279
	node *sh = checkn ( ENC_shape_none, arg1, 0 ) ;\
309
	node *sh = checkn(ENC_shape_none, arg1, 0);\
280
	if ( sh ) exp->shape = sh_nof ( make_nat ( ns ), sh ) ;
310
	if (sh)exp->shape = sh_nof(make_nat(ns), sh);
281
 
311
 
282
#define CHECK_make_nof_int\
312
#define CHECK_make_nof_int\
283
	node *sh = sh_integer ( v ) ;\
313
	node *sh = sh_integer(v);\
284
	exp->shape = sh_nof ( string_length ( str ), sh ) ;
314
	exp->shape = sh_nof(string_length(str), sh);
285
 
315
 
286
#define CHECK_make_null_local_lv	exp->shape = sh_pointer ( al_code ) ;
316
#define CHECK_make_null_local_lv	exp->shape = sh_pointer(al_code);
287
 
317
 
288
#define CHECK_make_null_proc		exp->shape = sh_proc ;
318
#define CHECK_make_null_proc		exp->shape = sh_proc;
289
 
319
 
290
#define CHECK_make_null_ptr		exp->shape = sh_pointer ( a ) ;
320
#define CHECK_make_null_ptr		exp->shape = sh_pointer(a);
291
 
321
 
292
#define CHECK_make_proc\
322
#define CHECK_make_proc\
293
	exp->shape = sh_proc ;\
323
	exp->shape = sh_proc ;\
294
	IGNORE check1 ( ENC_bottom, body ) ;\
324
	IGNORE check1(ENC_bottom, body);\
295
	UNUSED_ARG ( result_shape ) ;
325
	UNUSED_ARG(result_shape);
296
 
326
 
297
#define CHECK_make_stack_limit\
327
#define CHECK_make_stack_limit\
298
	exp->shape = null ;\
328
	exp->shape = null ;\
299
	UNUSED_ARG ( stack_base ) ;\
329
	UNUSED_ARG(stack_base);\
300
	UNUSED_ARG ( frame_size ) ;\
330
	UNUSED_ARG(frame_size);\
301
	UNUSED_ARG ( alloc_size ) ;
331
	UNUSED_ARG(alloc_size);
302
 
332
 
303
#define CHECK_make_top			exp->shape = sh_top ;
333
#define CHECK_make_top			exp->shape = sh_top;
304
 
334
 
305
#define CHECK_make_value		exp->shape = normalize ( s ) ;
335
#define CHECK_make_value		exp->shape = normalize(s);
306
 
336
 
307
#define CHECK_maximum			CHECK_and
337
#define CHECK_maximum			CHECK_and
308
 
338
 
309
#define CHECK_minimum			CHECK_and
339
#define CHECK_minimum			CHECK_and
310
 
340
 
311
#define CHECK_minus			CHECK_and
341
#define CHECK_minus			CHECK_and
312
 
342
 
313
#define CHECK_move_some\
343
#define CHECK_move_some\
314
	node *sh1 = check1 ( ENC_pointer, arg1 ) ;\
344
	node *sh1 = check1(ENC_pointer, arg1);\
315
	node *sh2 = check1 ( ENC_pointer, arg2 ) ;\
345
	node *sh2 = check1(ENC_pointer, arg2);\
316
	node *sh3 = check1 ( ENC_offset, arg3 ) ;\
346
	node *sh3 = check1(ENC_offset, arg3);\
317
	al_includes ( ptr_to ( sh1 ), offset_from ( sh3 ) ) ;\
347
	al_includes(ptr_to(sh1), offset_from(sh3));\
318
	al_includes ( ptr_to ( sh2 ), offset_to ( sh3 ) ) ;\
348
	al_includes(ptr_to(sh2), offset_to(sh3));\
319
	exp->shape = sh_top ;
349
	exp->shape = sh_top;
320
 
350
 
321
#define CHECK_mult			CHECK_and
351
#define CHECK_mult			CHECK_and
322
 
352
 
323
#define CHECK_n_copies\
353
#define CHECK_n_copies\
324
	exp->shape = sh_nof ( n, arg1->shape ) ;
354
	exp->shape = sh_nof(n, arg1->shape);
325
 
355
 
326
#define CHECK_negate\
356
#define CHECK_negate\
327
	exp->shape = normalize ( check1 ( ENC_integer, arg1 ) ) ;
357
	exp->shape = normalize(check1(ENC_integer, arg1));
328
 
358
 
329
#define CHECK_not			CHECK_negate
359
#define CHECK_not			CHECK_negate
330
 
360
 
331
#define CHECK_obtain_tag		chk_tag ( exp, t, 0 ) ;
361
#define CHECK_obtain_tag		chk_tag(exp, t, 0);
332
 
362
 
333
#define CHECK_offset_add\
363
#define CHECK_offset_add\
334
	node *sh1 = check1 ( ENC_offset, arg1 ) ;\
364
	node *sh1 = check1(ENC_offset, arg1);\
335
	node *sh2 = check1 ( ENC_offset, arg2 ) ;\
365
	node *sh2 = check1(ENC_offset, arg2);\
336
	al_includes ( offset_to ( sh1 ), offset_from ( sh2 ) ) ;\
366
	al_includes(offset_to(sh1), offset_from(sh2));\
337
	exp->shape = sh_offset ( offset_from ( sh1 ), offset_to ( sh2 ) ) ;
367
	exp->shape = sh_offset(offset_from(sh1), offset_to(sh2));
338
 
368
 
339
#define CHECK_offset_div\
369
#define CHECK_offset_div\
340
	node *sh = check2 ( ENC_offset, arg1, arg2 ) ;\
370
	node *sh = check2(ENC_offset, arg1, arg2);\
341
	al_equals ( offset_from ( sh ), offset_to ( sh ) ) ;\
371
	al_equals(offset_from(sh), offset_to(sh));\
342
	exp->shape = sh_integer ( v ) ;
372
	exp->shape = sh_integer(v);
343
 
373
 
344
#define CHECK_offset_div_by_int\
374
#define CHECK_offset_div_by_int\
345
	node *sh1 = check1 ( ENC_offset, arg1 ) ;\
375
	node *sh1 = check1(ENC_offset, arg1);\
346
	al_equals ( offset_from ( sh1 ), offset_to ( sh1 ) ) ;\
376
	al_equals(offset_from(sh1), offset_to(sh1));\
347
	IGNORE check1 ( ENC_integer, arg2 ) ;\
377
	IGNORE check1(ENC_integer, arg2);\
348
	exp->shape = normalize ( sh1 ) ;
378
	exp->shape = normalize(sh1);
349
 
379
 
350
#define CHECK_offset_max\
380
#define CHECK_offset_max\
351
	node *sh1 = check1 ( ENC_offset, arg1 ) ;\
381
	node *sh1 = check1(ENC_offset, arg1);\
352
	node *sh2 = check1 ( ENC_offset, arg2 ) ;\
382
	node *sh2 = check1(ENC_offset, arg2);\
353
	node *al1 = al_union ( offset_from ( sh1 ), offset_from ( sh2 ) ) ;\
383
	node *al1 = al_union(offset_from(sh1), offset_from(sh2));\
354
	node *al2 = offset_to ( sh1 ) ;\
384
	node *al2 = offset_to(sh1);\
355
	al_equals ( al2, offset_to ( sh2 ) ) ;\
385
	al_equals(al2, offset_to(sh2));\
356
	exp->shape = sh_offset ( al1, al2 ) ;
386
	exp->shape = sh_offset(al1, al2);
357
 
387
 
358
#define CHECK_offset_mult\
388
#define CHECK_offset_mult\
359
	node *sh1 = check1 ( ENC_offset, arg1 ) ;\
389
	node *sh1 = check1(ENC_offset, arg1);\
360
	al_equals ( offset_from ( sh1 ), offset_to ( sh1 ) ) ;\
390
	al_equals(offset_from(sh1), offset_to(sh1));\
361
	IGNORE check1 ( ENC_integer, arg2 ) ;\
391
	IGNORE check1(ENC_integer, arg2);\
362
	exp->shape = normalize ( sh1 ) ;
392
	exp->shape = normalize(sh1);
363
 
393
 
364
#define CHECK_offset_negate\
394
#define CHECK_offset_negate\
365
	node *sh1 = check1 ( ENC_offset, arg1 ) ;\
395
	node *sh1 = check1(ENC_offset, arg1);\
366
	al_equals ( offset_from ( sh1 ), offset_to ( sh1 ) ) ;\
396
	al_equals(offset_from(sh1), offset_to(sh1));\
367
	exp->shape = normalize ( sh1 ) ;
397
	exp->shape = normalize(sh1);
368
 
398
 
369
#define CHECK_offset_pad\
399
#define CHECK_offset_pad\
370
	node *sh1 = check1 ( ENC_offset, arg1 ) ;\
400
	node *sh1 = check1(ENC_offset, arg1);\
371
	node *al1 = al_union ( offset_from ( sh1 ), a ) ;\
401
	node *al1 = al_union(offset_from(sh1), a);\
372
	exp->shape = sh_offset ( al1, offset_to ( sh1 ) ) ;
402
	exp->shape = sh_offset(al1, offset_to(sh1));
373
 
403
 
374
#define CHECK_offset_subtract\
404
#define CHECK_offset_subtract\
375
	node *sh1 = check1 ( ENC_offset, arg1 ) ;\
405
	node *sh1 = check1(ENC_offset, arg1);\
376
	node *sh2 = check1 ( ENC_offset, arg2 ) ;\
406
	node *sh2 = check1(ENC_offset, arg2);\
377
	al_equals ( offset_from ( sh1 ), offset_from ( sh2 ) ) ;\
407
	al_equals(offset_from(sh1), offset_from(sh2));\
378
	exp->shape = sh_offset ( offset_to ( sh1 ), offset_to ( sh2 ) ) ;
408
	exp->shape = sh_offset(offset_to(sh1), offset_to(sh2));
379
 
409
 
380
#define CHECK_offset_test\
410
#define CHECK_offset_test\
381
	exp->shape = sh_top ;\
411
	exp->shape = sh_top ;\
382
	IGNORE check2 ( ENC_offset, arg1, arg2 ) ;
412
	IGNORE check2(ENC_offset, arg1, arg2);
383
 
413
 
384
#define CHECK_offset_zero		exp->shape = sh_offset ( a, a ) ;
414
#define CHECK_offset_zero		exp->shape = sh_offset(a, a);
385
 
415
 
386
#define CHECK_or			CHECK_and
416
#define CHECK_or			CHECK_and
387
 
417
 
388
#define CHECK_plus			CHECK_and
418
#define CHECK_plus			CHECK_and
389
 
419
 
390
#define CHECK_pointer_test\
420
#define CHECK_pointer_test\
391
	exp->shape = sh_top ;\
421
	exp->shape = sh_top ;\
392
	IGNORE check2 ( ENC_pointer, arg1, arg2 ) ;
422
	IGNORE check2(ENC_pointer, arg1, arg2);
393
 
423
 
394
#define CHECK_power			CHECK_shift_left
424
#define CHECK_power			CHECK_shift_left
395
 
425
 
396
#define CHECK_proc_test\
426
#define CHECK_proc_test\
397
	exp->shape = sh_top ;\
427
	exp->shape = sh_top ;\
398
	IGNORE check2 ( ENC_proc, arg1, arg2 ) ;
428
	IGNORE check2(ENC_proc, arg1, arg2);
399
 
429
 
400
#define CHECK_profile\
430
#define CHECK_profile\
401
	exp->shape = sh_top ;\
431
	exp->shape = sh_top ;\
402
	UNUSED_ARG ( uses ) ;
432
	UNUSED_ARG(uses);
403
 
433
 
404
#define CHECK_real_part\
434
#define CHECK_real_part\
405
	exp->shape = null ;\
435
	exp->shape = null ;\
406
	UNUSED_ARG ( arg1 ) ;
436
	UNUSED_ARG(arg1);
407
 
437
 
408
#define CHECK_rem0			CHECK_and
438
#define CHECK_rem0			CHECK_and
409
 
439
 
410
#define CHECK_rem1			CHECK_and
440
#define CHECK_rem1			CHECK_and
411
 
441
 
412
#define CHECK_rem2			CHECK_and
442
#define CHECK_rem2			CHECK_and
413
 
443
 
414
#define CHECK_repeat\
444
#define CHECK_repeat\
415
	exp->shape = normalize ( body->shape ) ;\
445
	exp->shape = normalize(body->shape);\
416
	IGNORE check1 ( ENC_top, start ) ;
446
	IGNORE check1(ENC_top, start);
417
 
447
 
418
#define CHECK_return\
448
#define CHECK_return\
419
	exp->shape = sh_bottom ;\
449
	exp->shape = sh_bottom ;\
420
	UNUSED_ARG ( arg1 ) ;
450
	UNUSED_ARG(arg1);
421
 
451
 
422
#define CHECK_return_to_label\
452
#define CHECK_return_to_label\
423
	exp->shape = sh_bottom ;\
453
	exp->shape = sh_bottom ;\
424
	UNUSED_ARG ( lab_val ) ;
454
	UNUSED_ARG(lab_val);
425
 
455
 
426
#define CHECK_round_with_mode\
456
#define CHECK_round_with_mode\
427
	exp->shape = sh_integer ( r ) ;\
457
	exp->shape = sh_integer(r);\
428
	IGNORE check1 ( ENC_floating, arg1 ) ;
458
	IGNORE check1(ENC_floating, arg1);
429
 
459
 
430
#define CHECK_rotate_left		CHECK_shift_left
460
#define CHECK_rotate_left		CHECK_shift_left
431
 
461
 
432
#define CHECK_rotate_right		CHECK_shift_left
462
#define CHECK_rotate_right		CHECK_shift_left
433
 
463
 
434
#define CHECK_sequence\
464
#define CHECK_sequence\
435
	exp->shape = normalize ( result->shape ) ;\
465
	exp->shape = normalize(result->shape);\
436
	UNUSED_ARG ( statements ) ;
466
	UNUSED_ARG(statements);
437
 
467
 
438
#define CHECK_set_stack_limit\
468
#define CHECK_set_stack_limit\
439
	exp->shape = sh_top ;\
469
	exp->shape = sh_top ;\
440
	UNUSED_ARG ( lim ) ;
470
	UNUSED_ARG(lim);
441
 
471
 
442
#define CHECK_shape_offset\
472
#define CHECK_shape_offset\
443
	exp->shape = sh_offset ( al_shape ( s ), al_top ) ;
473
	exp->shape = sh_offset(al_shape(s), al_top);
444
 
474
 
445
#define CHECK_shift_left\
475
#define CHECK_shift_left\
446
	exp->shape = normalize ( check1 ( ENC_integer, arg1 ) ) ;\
476
	exp->shape = normalize(check1(ENC_integer, arg1));\
447
	IGNORE check1 ( ENC_integer, arg2 ) ;
477
	IGNORE check1(ENC_integer, arg2);
448
 
478
 
449
#define CHECK_shift_right		CHECK_shift_left
479
#define CHECK_shift_right		CHECK_shift_left
450
 
480
 
451
#define CHECK_subtract_ptrs\
481
#define CHECK_subtract_ptrs\
452
	node *sh1 = check1 ( ENC_pointer, arg1 ) ;\
482
	node *sh1 = check1(ENC_pointer, arg1);\
453
	node *sh2 = check1 ( ENC_pointer, arg2 ) ;\
483
	node *sh2 = check1(ENC_pointer, arg2);\
454
	exp->shape = sh_offset ( ptr_to ( sh2 ), ptr_to ( sh1 ) ) ;
484
	exp->shape = sh_offset(ptr_to(sh2), ptr_to(sh1));
455
 
485
 
456
#define CHECK_tail_call\
486
#define CHECK_tail_call\
457
	exp->shape = sh_bottom ;\
487
	exp->shape = sh_bottom ;\
458
	IGNORE check1 ( ENC_proc, p ) ;
488
	IGNORE check1(ENC_proc, p);
459
 
489
 
460
#define CHECK_untidy_return\
490
#define CHECK_untidy_return\
461
	exp->shape = sh_bottom ;\
491
	exp->shape = sh_bottom ;\
462
	UNUSED_ARG ( arg1 ) ;
492
	UNUSED_ARG(arg1);
463
 
493
 
464
#define CHECK_variable\
494
#define CHECK_variable\
465
	exp->shape = normalize ( body->shape ) ;\
495
	exp->shape = normalize(body->shape);\
466
	chk_tag ( exp, name_intro, 1 ) ;\
496
	chk_tag(exp, name_intro, 1);\
467
	UNUSED_ARG ( init ) ;
497
	UNUSED_ARG(init);
468
 
498
 
469
#define CHECK_xor			CHECK_and
499
#define CHECK_xor			CHECK_and