Subversion Repositories tendra.SVN

Rev

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

Rev Author Line No. Line
2 7u83 1 
/*
6 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
6 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:-
6 7u83 42 
 
2 7u83 43 
        (1) Its Recipients shall ensure that this Notice is
44 
        reproduced upon any copies or amended versions of it;
6 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;
6 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;
6 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 "check.h"
64 
#include "de_types.h"
65 
#include "de_capsule.h"
66 
#include "de_unit.h"
67 
#include "decode.h"
68 
#include "eval.h"
69 
#include "fetch.h"
70 
#include "high.h"
71 
#include "node.h"
72 
#include "shape.h"
73 
#include "table.h"
74 
#include "tdf.h"
75 
#include "utility.h"
76 
 
77 
 
78 
/*
79 
    DECODE AN EXTENDED VALUE
80 
 
81 
    An extended n bit encoding is decoded.
82 
*/
83 
 
6 7u83 84 
long
85 
fetch_extn(int n)
2 7u83 86 
{
6 7u83 87 
    long r = 0, s;
88 
    while (s = fetch(n), s == 0)r += ((1 << n) - 1);
89 
    return(r + s);
2 7u83 90 
}
91 
 
92 
 
93 
/*
94 
    DECODE A TDF INTEGER
95 
 
96 
    A TDF integer is decoded and returned as a long (no overflow checks).
97 
*/
98 
 
6 7u83 99 
long
100 
tdf_int(void)
2 7u83 101 
{
6 7u83 102 
    long d, n = 0;
2 7u83 103 
    do {
6 7u83 104 
	d = fetch(4);
105 
	n = 8 * n + (d & 7);
106 
    } while (!(d & 8));
107 
    return(n);
2 7u83 108 
}
109 
 
110 
 
111 
/*
112 
    DECODE A TOKEN APPLICATION
113 
 
114 
    A token application returning sort s is appended to p.  If s is
115 
    SORT_unknown a simple token (rather than a token application) is
116 
    read.
117 
*/
118 
 
6 7u83 119 
construct *
120 
de_token(node *p, sortname s)
2 7u83 121 
{
6 7u83 122 
    long bits;
123 
    construct *t;
124 
    tok_info *info;
125 
    construct dummy;
2 7u83 126 
 
127 
    /* Find token type */
6 7u83 128 
    long n = de_token_bits();
129 
    if (n == ENC_make_tok) {
130 
	long m = tdf_int();
131 
	t = find_binding(crt_binding, tok_var, m);
132 
	info = get_tok_info(t);
133 
	p->son = new_node();
134 
	p->son->cons = t;
135 
    } else if (n == ENC_use_tokdef) {
136 
	char *nm;
137 
	t = make_construct(SORT_token);
138 
	nm = alloc_nof(char, 32);
139 
	IGNORE sprintf(nm, "~~token_%ld", t->encoding);
140 
	t->name = nm;
141 
	if (add_to_var_hash(t, SORT_token)) {
142 
	    input_error("%s has already been defined", nm);
2 7u83 143 
	}
6 7u83 144 
	de_token_defn(t,(node *)null);
145 
	info = get_tok_info(t);
146 
	p->son = new_node();
147 
	p->son->cons = t;
2 7u83 148 
    } else {
6 7u83 149 
	high_sort *h;
150 
	construct *tt;
151 
	tt = de_token(p, SORT_token);
152 
	info = get_tok_info(tt);
153 
	h = high_sorts + high_no(info->res);
154 
	dummy.name = "high level token";
155 
	dummy.u.tok_u.res = h->res;
156 
	dummy.u.tok_u.args = find_decode_string(h);
157 
	t = &dummy;
158 
	info = &dummy.u.tok_u;
2 7u83 159 
    }
160 
 
161 
    /* Quit here if only reading token */
6 7u83 162 
    if (s == SORT_unknown) {
163 
	if (!text_output) {
164 
	    p->son->son = new_node();
165 
	    p->son->son->cons = &token_cons;
2 7u83 166 
	}
6 7u83 167 
	return(null);
2 7u83 168 
    }
169 
 
170 
    /* Find the length of the arguments */
6 7u83 171 
    bits = tdf_int();
2 7u83 172 
 
6 7u83 173 
    if (info->res == SORT_unknown) {
2 7u83 174 
	/* Unknown token */
6 7u83 175 
	if (bits) {
2 7u83 176 
	    /* Step over arguments */
6 7u83 177 
	    char *args;
178 
	    if (streq(t->name, "~dg_exp")) {
179 
		args = "xFF";
180 
	    } else if (streq(t->name, "~exp_to_source")) {
181 
		args = "xFF";
182 
	    } else if (streq(t->name, "~diag_id_scope")) {
183 
		args = "x$xF";
184 
	    } else if (streq(t->name, "~diag_type_scope")) {
185 
		args = "x$F";
186 
	    } else if (streq(t->name, "~diag_tag_scope")) {
187 
		args = "x$F";
2 7u83 188 
	    } else {
6 7u83 189 
		warning("Token %s undeclared", t->name);
190 
		args = "F";
2 7u83 191 
	    }
6 7u83 192 
	    bits += input_posn();
193 
	    p->son->son = de_node(args);
194 
	    bits -= input_posn();
195 
	    if (bits < 0) {
196 
		input_error("Token %s, arguments length wrong", t->name);
197 
		return(t);
2 7u83 198 
	    }
6 7u83 199 
	    input_skip(bits);
2 7u83 200 
	} else {
201 
	    /* No argument - can deduce token sort */
6 7u83 202 
	    info->res = s;
203 
	    info->dec = 1;
2 7u83 204 
	}
205 
    } else {
206 
	/* Known token */
6 7u83 207 
	if (s == SORT_token) {
2 7u83 208 
	    /* Must be high level */
6 7u83 209 
	    if (!is_high(info->res)) {
210 
		input_error("Sort error in token %s", t->name);
2 7u83 211 
	    }
6 7u83 212 
	} else if (info->res != s) {
2 7u83 213 
	    /* Result sort must match */
6 7u83 214 
	    input_error("Sort error in token %s", t->name);
2 7u83 215 
	}
6 7u83 216 
	if (info->args) {
2 7u83 217 
	    /* Decode arguments */
6 7u83 218 
	    long end_posn = input_posn() + bits;
219 
	    p->son->son = de_node(info->args);
220 
	    if (input_posn()!= end_posn) {
221 
		input_error("Token %s, arguments length wrong", t->name);
222 
		return(t);
2 7u83 223 
	    }
224 
	} else {
225 
	    /* No arguments */
6 7u83 226 
	    if (bits) {
227 
		input_error("Token %s, arguments length wrong", t->name);
228 
		return(t);
2 7u83 229 
	    }
230 
	}
6 7u83 231 
	info->dec = 1;
2 7u83 232 
    }
233 
 
234 
    /* Mark used tokens */
6 7u83 235 
    if (info->dec)adjust_token(t);
236 
    return(t);
2 7u83 237 
}
238 
 
239 
 
240 
/*
241 
    DECODE A VARIABLE SORT
242 
 
243 
    A construct of the vth variable sort is decoded.
244 
*/
245 
 
6 7u83 246 
node *
247 
de_var_sort(long v)
2 7u83 248 
{
6 7u83 249 
    long n = tdf_int();
250 
    node *p = new_node();
251 
    p->cons = find_binding(crt_binding, v, n);
252 
    return(p);
2 7u83 253 
}
254 
 
255 
 
256 
/*
257 
    DECODE A LABEL
258 
 
259 
    A label construct is decoded.
260 
*/
261 
 
6 7u83 262 
static void
263 
de_make_label(node *p)
2 7u83 264 
{
6 7u83 265 
    long n = tdf_int();
266 
    p->son = new_node();
267 
    p->son->cons = find_label(n);
268 
    return;
2 7u83 269 
}
270 
 
271 
 
272 
/*
273 
    DECODE A STRING OF DECODE CHARACTERS
274 
 
275 
    The string of decode character str is decoded.
276 
*/
277 
 
6 7u83 278 
node *
279 
de_node(char *str)
2 7u83 280 
{
6 7u83 281 
    char c;
282 
    node *p, *q = null, *qe = null;
283 
    while (c = *str, c != 0 && c != ']') {
284 
	switch (c) {
2 7u83 285 
 
6 7u83 286 
	    case '[':
287 
	    case '{':
288 
	    case '}':
289 
	    case '&':
290 
	    case '^': {
2 7u83 291 
		/* Ignore these cases */
6 7u83 292 
		p = null;
293 
		break;
2 7u83 294 
	    }
295 
 
6 7u83 296 
	    case '|': {
2 7u83 297 
		/* Align input stream */
6 7u83 298 
		byte_align();
299 
		p = null;
300 
		break;
2 7u83 301 
	    }
302 
 
6 7u83 303 
	    case 'i': {
2 7u83 304 
		/* Decode an integer as a string of octal digits */
6 7u83 305 
		long d, n = 0;
306 
		char buff[1000];
2 7u83 307 
		do {
6 7u83 308 
		    d = fetch(4);
309 
		    buff[n] = (char)('0' + (d & 7));
310 
		    n++;
311 
		} while (!(d & 8));
312 
		buff[n] = 0;
313 
		p = new_node();
314 
		p->cons = new_construct();
315 
		if (fits_ulong(buff, 1)) {
316 
		    p->cons->sortnum = SORT_small_tdfint;
317 
		    p->cons->encoding = (long)octal_to_ulong(buff);
2 7u83 318 
		} else {
6 7u83 319 
		    p->cons->sortnum = SORT_tdfint;
320 
		    p->cons->name = string_copy_aux(buff);
2 7u83 321 
		}
6 7u83 322 
		break;
2 7u83 323 
	    }
324 
 
6 7u83 325 
	    case 'j': {
2 7u83 326 
		/* Decode a bit */
6 7u83 327 
		p = new_node();
328 
		p->cons = (tdf_bool()? &true_cons : &false_cons);
329 
		break;
2 7u83 330 
	    }
331 
 
6 7u83 332 
	    case '$': {
2 7u83 333 
		/* Decode a string */
6 7u83 334 
		long i, n = tdf_int();
335 
		if (n == 8) {
336 
		    char *s;
337 
		    n = tdf_int();
338 
		    s = alloc_nof(char, n + 1);
339 
		    p = new_node();
340 
		    p->cons = new_construct();
341 
		    p->cons->sortnum = SORT_tdfstring;
342 
		    p->cons->encoding = n;
343 
		    p->cons->name = s;
344 
		    p->cons->next = null;
345 
		    for (i = 0; i < n; i++) {
2 7u83 346 
			s [i] = ( char ) fetch ( 8 ) ; /* LINT */
347 
		    }
6 7u83 348 
		    s[n] = 0;
2 7u83 349 
		} else {
6 7u83 350 
		    long m;
351 
		    node *px;
352 
		    p = new_node();
353 
		    p->cons = &string_cons;
354 
		    p->son = make_int(n);
355 
		    m = tdf_int();
356 
		    px = new_node();
357 
		    px->cons = new_construct();
358 
		    px->cons->sortnum = SORT_repeat;
359 
		    px->cons->encoding = m;
360 
		    p->son->bro->bro = px;
361 
		    for (i = 0; i < m; i++) {
362 
			long v = fetch((int)n);
363 
			if (i == 0) {
364 
			    px->son = make_int(v);
365 
			    px = px->son;
2 7u83 366 
			} else {
6 7u83 367 
			    px->bro->bro = make_int(v);
368 
			    px = px->bro->bro;
2 7u83 369 
			}
370 
		    }
371 
		}
6 7u83 372 
		break;
2 7u83 373 
	    }
374 
 
6 7u83 375 
	    case '=': {
2 7u83 376 
		/* Decode an aligned string */
6 7u83 377 
		char *s;
378 
		long i, n = tdf_int();
379 
		if (n != 8)input_error("Only 8-bit strings allowed");
380 
		n = tdf_int();
381 
		byte_align();
382 
		s = alloc_nof(char, n + 1);
383 
		p = new_node();
384 
		p->cons = new_construct();
385 
		p->cons->sortnum = SORT_tdfstring;
386 
		p->cons->encoding = n;
387 
		p->cons->name = s;
388 
		p->cons->next = null;
389 
		for (i = 0; i < n; i++) {
2 7u83 390 
		    s [i] = ( char ) fetch ( 8 ) ; /* LINT */
391 
		}
6 7u83 392 
		s[n] = 0;
393 
		byte_align();
394 
		break;
2 7u83 395 
	    }
396 
 
6 7u83 397 
	    case '*': {
2 7u83 398 
		/* The following text is repeated n times */
6 7u83 399 
		de_list_start();
400 
		goto percent_case;
2 7u83 401 
	    }
402 
 
6 7u83 403 
	    case '%':
2 7u83 404 
	    percent_case : {
405 
		/* The following text is repeated n times */
6 7u83 406 
		node *pe = null;
407 
		long i, n = tdf_int();
408 
		p = new_node();
409 
		p->cons = new_construct();
410 
		p->cons->sortnum = SORT_repeat;
411 
		p->cons->encoding = n;
412 
		str += 2;
413 
		for (i = 0; i < n; i++) {
414 
		    node *pi = de_node(str);
415 
		    if (pe == null) {
416 
			p->son = pi;
2 7u83 417 
		    } else {
6 7u83 418 
			pe->bro = pi;
2 7u83 419 
		    }
6 7u83 420 
		    pe = pi;
421 
		    while (pe->bro)pe = pe->bro;
2 7u83 422 
		}
6 7u83 423 
		str = skip_text(str);
424 
		break;
2 7u83 425 
	    }
426 
 
6 7u83 427 
	    case '?': {
2 7u83 428 
		/* The following text is optional */
6 7u83 429 
		p = new_node();
430 
		p->cons = &optional_cons;
431 
		str += 2;
432 
		if (tdf_bool()) {
433 
		    p->son = de_node(str);
434 
		    if (*str == '*' && p->son->cons->encoding == 0) {
2 7u83 435 
			/* Get rid of optional empty lists */
6 7u83 436 
			p->son = null;
2 7u83 437 
		    }
438 
		}
6 7u83 439 
		str = skip_text(str);
440 
		break;
2 7u83 441 
	    }
442 
 
6 7u83 443 
	    case '@': {
2 7u83 444 
		/* The following text is a bitstream */
6 7u83 445 
		long len, pos;
446 
		str += 2;
447 
		len = tdf_int();
448 
		pos = input_posn();
449 
		p = new_node();
450 
		p->cons = &bytestream_cons;
451 
		p->son = de_node(str);
452 
		if (len + pos != input_posn()) {
453 
		    input_error("Conditional length wrong");
2 7u83 454 
		}
6 7u83 455 
		str = skip_text(str);
456 
		break;
2 7u83 457 
	    }
458 
 
6 7u83 459 
	    case 'T': {
460 
		node dummy;
461 
		str = find_sortname(str,(sortname *)null);
462 
		IGNORE de_token(&dummy, SORT_unknown);
463 
		p = dummy.son;
464 
		break;
2 7u83 465 
	    }
466 
 
6 7u83 467 
	    case 'F': {
2 7u83 468 
		/* Unknown sort */
6 7u83 469 
		p = new_node();
470 
		p->cons = &unknown_cons;
471 
		break;
2 7u83 472 
	    }
473 
 
474 
	    default : {
475 
		/* Basic sorts */
6 7u83 476 
		sortname s = find_sort(c);
477 
		p = (sort_decode[s])();
478 
		break;
2 7u83 479 
	    }
480 
	}
6 7u83 481 
	if (p) {
482 
	    if (qe == null) {
483 
		q = p;
2 7u83 484 
	    } else {
6 7u83 485 
		qe->bro = p;
2 7u83 486 
	    }
6 7u83 487 
	    qe = p;
488 
	    while (qe->bro)qe = qe->bro;
2 7u83 489 
	}
6 7u83 490 
	str++;
2 7u83 491 
    }
6 7u83 492 
    return(q);
2 7u83 493 
}