Subversion Repositories tendra.SVN

Rev

Rev 7 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1
/*
7 7u83 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
 */
31
/*
2 7u83 32
    		 Crown Copyright (c) 1997
7 7u83 33
 
2 7u83 34
    This TenDRA(r) Computer Program is subject to Copyright
35
    owned by the United Kingdom Secretary of State for Defence
36
    acting through the Defence Evaluation and Research Agency
37
    (DERA).  It is made available to Recipients with a
38
    royalty-free licence for its use, reproduction, transfer
39
    to other parties and amendment for any purpose not excluding
40
    product development provided that any such use et cetera
41
    shall be deemed to be acceptance of the following conditions:-
7 7u83 42
 
2 7u83 43
        (1) Its Recipients shall ensure that this Notice is
44
        reproduced upon any copies or amended versions of it;
7 7u83 45
 
2 7u83 46
        (2) Any amended version of it shall be clearly marked to
47
        show both the nature of and the organisation responsible
48
        for the relevant amendment or amendments;
7 7u83 49
 
2 7u83 50
        (3) Its onward transfer from a recipient to another
51
        party shall be deemed to be that party's acceptance of
52
        these conditions;
7 7u83 53
 
2 7u83 54
        (4) DERA gives no warranty or assurance as to its
55
        quality or suitability for any purpose and DERA accepts
56
        no liability whatsoever in relation to any use to which
57
        it may be put.
58
*/
59
 
60
 
61
#include "config.h"
62
#include "types.h"
63
#include "alignment.h"
7 7u83 64
#include "check.h"
2 7u83 65
#include "eval.h"
66
#include "node.h"
67
#include "read.h"
68
#include "shape.h"
69
#include "table.h"
70
#include "tdf.h"
71
#include "utility.h"
72
 
73
 
74
/*
75
    SHAPE CHECKING FLAG
76
 
77
    This flag is true to indicate that shape checking should be applied.
78
*/
79
 
7 7u83 80
boolean do_check = 0;
2 7u83 81
 
82
 
83
/*
84
    THE NAME OF THE CURRENT EXPRESSION BEING CHECKED
85
 
86
    The shape checking does not always take place immediately.  By
87
    printing the name of the expression being checked it is easier
88
    to find any errors.
89
*/
90
 
7 7u83 91
char *checking = "????";
2 7u83 92
 
93
 
94
/*
95
    SHAPE CHECKING FOR EXP_APPLY_TOKEN
96
 
97
    The shape checking for the exp_apply_token construct p is implemented
98
    by this routine.
99
*/
100
 
7 7u83 101
static void
102
chk_token(node *p)
2 7u83 103
{
7 7u83 104
    tok_info *info = get_tok_info(p->son->cons);
105
    node *d = info->def;
106
    if (d) {
107
	if (d->cons->sortnum == SORT_completion)d = d->son;
108
	p->shape = normalize(d->shape);
2 7u83 109
    } else {
7 7u83 110
	p->shape = new_node();
111
	p->shape->cons = &shape_of;
112
	p->shape->son = copy_node(p->son);
2 7u83 113
    }
7 7u83 114
    return;
2 7u83 115
}
116
 
117
 
118
/*
119
    SHAPE CHECKING FOR EXP_COND
120
 
121
    The shape checking for the exp_cond construct p is implemented by
122
    this routine.  Checking that the control argument is an integer is
123
    carried out for all _cond constructs as part of the main reading
124
    and decoding routines for the decode letter '@'.
125
*/
126
 
7 7u83 127
static void
128
chk_cond(node *p)
2 7u83 129
{
7 7u83 130
    node *s;
131
    node *q1 = p->son->bro->son;
132
    node *q2 = p->son->bro->bro->son;
133
    node *s1 = q1->shape;
134
    node *s2 = q2->shape;
135
    if (q1->cons->encoding == ENC_fail_installer) {
136
	p->shape = normalize(s2);
137
	return;
2 7u83 138
    }
7 7u83 139
    if (q2->cons->encoding == ENC_fail_installer) {
140
	p->shape = normalize(s1);
141
	return;
2 7u83 142
    }
7 7u83 143
    s = lub(s1, s2);
144
    if (s == null) {
145
	p->shape = null;
2 7u83 146
    } else {
7 7u83 147
	long n = s->cons->encoding;
148
	if (n == ENC_bottom || n == ENC_top) {
149
	    p->shape = null;
2 7u83 150
	} else {
7 7u83 151
	    p->shape = normalize(s);
2 7u83 152
	}
153
    }
7 7u83 154
    return;
2 7u83 155
}
156
 
157
 
158
/*
159
    SHAPE CHECKING FOR OBTAIN_TAG
160
 
161
    The shape checking for the obtain_tag construct p is implemented by
162
    this routine.  a gives the actual tag.
163
*/
164
 
7 7u83 165
static void
166
chk_tag(node *p, node *a, int intro)
2 7u83 167
{
7 7u83 168
    if (!intro && a->cons->encoding == ENC_make_tag) {
169
	tag_info *info = get_tag_info(a->son->cons);
170
	node *d = info->dec;
171
	if (d && d->cons->sortnum == SORT_completion)d = d->son;
172
	if (d)d = d->bro;
173
	if (d)d = d->bro;
174
	switch (info->var) {
175
	    case 0: {
176
		p->shape = normalize(d);
177
		break;
2 7u83 178
	    }
7 7u83 179
	    case 1:
180
	    case 2: {
181
		p->shape = sh_pointer(d);
182
		break;
2 7u83 183
	    }
184
	    default : {
7 7u83 185
		if (text_input) {
186
		    char *nm = a->son->cons->name;
187
		    is_fatal = 0;
188
		    input_error("Tag %s used but not declared", nm);
2 7u83 189
		}
7 7u83 190
		p->shape = null;
191
		break;
2 7u83 192
	    }
193
	}
194
    } else {
7 7u83 195
	p->shape = null;
2 7u83 196
    }
7 7u83 197
    return;
2 7u83 198
}
199
 
200
 
201
/*
202
    SHAPE CHECKING MACRO DEFINITIONS
203
 
204
    The main body of the shape checking for expressions is in the
205
    automatically generated file check_exp.h.  This calls a macro of
206
    the form check_<cons> for each construct <cons>.  The actual
207
    definitions of these macros (which vary between TDF specification
208
    releases) are in check_def.h.
209
*/
210
 
211
#include "check_def.h"
212
#include "check_exp.h"
213
 
214
 
215
/*
216
    SHAPE CHECK A SHAPE
217
 
218
    The construct compound has an exp argument which needs to be
219
    shape checked.
220
*/
221
 
7 7u83 222
void
223
check_shape_fn(node *p)
2 7u83 224
{
7 7u83 225
    if (p && p->cons->encoding == ENC_compound) {
226
	if (do_check) {
227
	    checking = p->cons->name;
228
	    IGNORE check1(ENC_offset, p->son);
2 7u83 229
	}
230
    }
7 7u83 231
    return;
2 7u83 232
}
233
 
234
 
235
/*
236
    SHAPE CHECK A NAT
237
 
238
    The construct computed_nat has an exp argument which needs to be
239
    shape checked.
240
*/
241
 
7 7u83 242
void
243
check_nat_fn(node *p)
2 7u83 244
{
7 7u83 245
    if (p && p->cons->encoding == ENC_computed_nat) {
246
	if (do_check) {
247
	    checking = p->cons->name;
248
	    IGNORE check1(ENC_integer, p->son);
2 7u83 249
	}
250
    }
7 7u83 251
    return;
2 7u83 252
}
253
 
254
 
255
/*
256
    SHAPE CHECK A SIGNED NAT
257
 
258
    The construct computed_signed_nat has an exp argument which needs
259
    to be shape checked.
260
*/
261
 
7 7u83 262
void
263
check_snat_fn(node *p)
2 7u83 264
{
7 7u83 265
    if (p && p->cons->encoding == ENC_computed_signed_nat) {
266
	if (do_check) {
267
	    checking = p->cons->name;
268
	    IGNORE check1(ENC_integer, p->son);
2 7u83 269
	}
270
    }
7 7u83 271
    return;
2 7u83 272
}
273
 
274
 
275
/*
276
    SHAPE CHECK AN ACCESS
277
 
278
    The flag intro_visible is set whenever a visible construct is
279
    encountered.
280
*/
281
 
7 7u83 282
void
283
check_access_fn(node *p)
2 7u83 284
{
7 7u83 285
    if (p && p->cons->encoding == ENC_visible)intro_visible = 1;
286
    return;
2 7u83 287
}
288
 
289
 
290
/*
291
    IS A SHAPE COMPLETELY KNOWN?
292
 
293
    This routine returns true if p is not null and does not contain
294
    any unknown constructs.  In encode mode we can't have any constructs
295
    which introduce local tags or tokens either.
296
*/
297
 
7 7u83 298
static boolean
299
is_known(node *p)
2 7u83 300
{
7 7u83 301
    if (p == null) return(0);
302
    while (p) {
303
	sortname s = p->cons->sortnum;
304
	if (s == SORT_unknown) return(0);
305
	if (!text_output && s == SORT_exp) {
306
	    switch (p->cons->encoding) {
307
		case ENC_conditional: return(0);
308
		case ENC_identify: return(0);
309
		case ENC_labelled: return(0);
310
		case ENC_make_proc: return(0);
311
		case ENC_repeat: return(0);
312
		case ENC_variable: return(0);
2 7u83 313
	    }
314
	}
7 7u83 315
	if (p->son && !is_known(p->son)) return(0);
316
	p = p->bro;
2 7u83 317
    }
7 7u83 318
    return(1);
2 7u83 319
}
320
 
321
 
322
/*
323
    CHECK THAT A TAG DECLARATION AND DEFINITION MATCH
324
 
325
    The construct p, representing a declared and defined tag, is checked
326
    for shape correctness.
327
*/
328
 
7 7u83 329
void
330
check_tagdef(construct *p)
2 7u83 331
{
7 7u83 332
    char *nm = p->name;
333
    tag_info *info = get_tag_info(p);
334
    node *dc = info->dec;
335
    node *df = info->def;
336
    if (df == null) return;
337
    if (df->cons->sortnum == SORT_completion)df = df->son;
338
    if (info->var)df = df->bro;
339
    if (dc == null) {
340
	if (is_known(df->shape)) {
2 7u83 341
	    /* Declaration = ?[u]?[X]S (from 4.0) */
7 7u83 342
	    node *q = new_node();
343
	    q->cons = &false_cons;
344
	    q->bro = new_node();
345
	    q->bro->cons = &false_cons;
346
	    q->bro->bro = df->shape;
347
	    info->dec->bro = completion(q);
2 7u83 348
	} else {
7 7u83 349
	    is_fatal = 0;
350
	    input_error("Can't deduce shape of %s from definition", nm);
2 7u83 351
	}
352
    } else {
7 7u83 353
	if (dc->cons->sortnum == SORT_completion)dc = dc->son;
2 7u83 354
	/* Declaration = ?[u]?[X]S (from 4.0) */
7 7u83 355
	dc = dc->bro->bro;
356
	checking = nm;
357
	IGNORE check_shapes(dc, df->shape, 1);
2 7u83 358
    }
7 7u83 359
    return;
2 7u83 360
}