Subversion Repositories tendra.SVN

Rev

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

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