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 
@use all
62 
@special external
63 
@special sortname
64 
@special token
65 
@special tokdec
66 
@special tokdef
67 
@special tagdec
68 
@special tagdef
69 
@special al_tagdef
70 
@special diag_tagdef
71 
@special token_defn
72 
@special exp case
73 
@special exp labelled
74 
@special exp make_proc
75 
@special exp sequence
76 
@special nat make_nat
77 
@special signed_nat make_signed_nat
78 
@special string make_string
79 
@special version make_version
80 
/* AUTOMATICALLY GENERATED BY %ZX VERSION %ZV FROM TDF %VA.%VB */
81 
 
82 
#include "config.h"
83 
#include "types.h"
84 
#include "basic.h"
85 
#include "binding.h"
86 
#include "file.h"
87 
#include "sort.h"
88 
#include "tdf.h"
89 
#include "tree.h"
90 
#include "unit.h"
91 
#include "utility.h"
92 
@loop sort
93 
@if sort.basic
94 
 
95 
 
96 
/* DECODE A %ST */
97 
 
6 7u83 98 
long
99 
de_%SN(void)
2 7u83 100 
{
101 
@if sort.extends
6 7u83 102 
    long n = fetch_extn(%SB%1u);
2 7u83 103 
@else
6 7u83 104 
    long n = fetch(%SB%0u);
2 7u83 105 
@endif
106 
@if sort.special
6 7u83 107 
    if (n < %u || n > %SM) {
108 
	out("<error>");
109 
	input_error("Illegal %ST value, %%ld", n);
110 
	n = -1;
2 7u83 111 
    }
112 
@else
6 7u83 113 
    switch (n) {
2 7u83 114 
@loop sort.cons
6 7u83 115 
	case %CE: {
2 7u83 116 
@if cons.simple
117 
@if cons.params
6 7u83 118 
	    format(VERT_BRACKETS, "%CN", "%CX");
2 7u83 119 
@else
6 7u83 120 
	    out("%CN");
2 7u83 121 
@endif
122 
@else
123 
@if cons.cond
6 7u83 124 
	    format(VERT_BRACKETS, "%CN", "%CX");
2 7u83 125 
@else
126 
@if cons.token
127 
@if sort.name.foreign
6 7u83 128 
	    sortname sn = find_sortname('%SX');
129 
	    IGNORE de_token_aux(sn, "%SN");
2 7u83 130 
@else
6 7u83 131 
	    IGNORE de_token_aux(sort_%20SN, "%SN");
2 7u83 132 
@endif
133 
@else
134 
@if cons.edge
6 7u83 135 
	    long t = tdf_int();
2 7u83 136 
@if sort.link
6 7u83 137 
	    out_object(t,(object *)null, var_%SN);
2 7u83 138 
@else
6 7u83 139 
	    de_%CN(t);
2 7u83 140 
@endif
141 
@else
142 
	    /* Decode string "%CX" */
6 7u83 143 
	    de_%CN("%CN");
2 7u83 144 
@endif
145 
@endif
146 
@endif
147 
@endif
6 7u83 148 
	    break;
2 7u83 149 
	}
150 
@end
151 
	default : {
6 7u83 152 
	    out("<error>");
153 
	    input_error("Illegal %ST value, %%ld", n);
154 
	    n = -1;
155 
	    break;
2 7u83 156 
	}
157 
    }
158 
@endif
6 7u83 159 
    return(n);
2 7u83 160 
}
161 
@endif
162 
@end
163 
 
164 
 
165 
/*
166 
    SKIP TEXT ENCLOSED IN [...]
167 
 
168 
    On input, s, points to the character '['.  The routine returns a
169 
    pointer to the character following the corresponding ']'.
170 
*/
171 
 
6 7u83 172 
static char *
173 
skip_sub(char *s)
2 7u83 174 
{
6 7u83 175 
    char c = *(s++);
176 
    if (c == '[') {
177 
	int n = 0;
178 
	while (c = *(s++), c != 0) {
179 
	    if (c == '[')n++;
180 
	    if (c == ']') {
181 
		if (n == 0) return(s);
182 
		n--;
2 7u83 183 
	    }
184 
	}
185 
    }
6 7u83 186 
    input_error("Illegal decoding string");
187 
    return("");
2 7u83 188 
}
189 
 
190 
 
191 
/*
192 
    DECODE A STRING OF DECODE CHARACTERS
193 
 
194 
    This routine takes a string of characters, reads it one character
195 
    at a time, and, according to what it is, calls a particular TDF
196 
    decoding routine (the character is vaguely mnemonic).  For example,
197 
    decode ( "Sn*[x]" ) means, decode a SHAPE and a NAT, then read a
198 
    TDF integer and decode that number of EXPs.
199 
*/
200 
 
6 7u83 201 
void
202 
decode(char *str)
2 7u83 203 
{
6 7u83 204 
    char c;
205 
    while (c = *(str++), c != 0) {
206 
	switch (c) {
207 
	    case '[':
208 
	    case '{':
209 
	    case '}':
210 
	    case '&': {
2 7u83 211 
		/* Ignore these cases */
6 7u83 212 
		break;
2 7u83 213 
	    }
6 7u83 214 
	    case ']': {
2 7u83 215 
		/* Marks the end of a group */
6 7u83 216 
		return;
2 7u83 217 
	    }
6 7u83 218 
	    case 'i': {
2 7u83 219 
		/* Decode an integer */
6 7u83 220 
		long n = tdf_int();
221 
		out_int(n);
222 
		break;
2 7u83 223 
	    }
6 7u83 224 
	    case '$': {
2 7u83 225 
		/* Decode a string */
6 7u83 226 
		de_tdfstring_format();
227 
		break;
2 7u83 228 
	    }
6 7u83 229 
	    case 'T': {
2 7u83 230 
		/* Decode a token */
6 7u83 231 
		IGNORE de_token_aux(sort_unknown, "token");
232 
		break;
2 7u83 233 
	    }
6 7u83 234 
	    case 'F': {
2 7u83 235 
		/* Decode an unknown foreign sort */
6 7u83 236 
		input_error("Unknown foreign sort");
237 
		break;
2 7u83 238 
	    }
6 7u83 239 
	    case '*': {
2 7u83 240 
		/* The following text is repeated n times */
6 7u83 241 
		long i, n;
242 
		check_list();
243 
		n = tdf_int();
244 
		if (n == 0) {
245 
		    out("empty");
2 7u83 246 
		} else {
6 7u83 247 
		    for (i = 0; i < n; i++)decode(str + 1);
2 7u83 248 
		}
6 7u83 249 
		str = skip_sub(str);
250 
		break;
2 7u83 251 
	    }
6 7u83 252 
	    case '+': {
2 7u83 253 
		/* The following text is repeated n + 1 times */
6 7u83 254 
		long i, n;
255 
		check_list();
256 
		n = tdf_int();
257 
		for (i = 0; i <= n; i++)decode(str + 1);
258 
		str = skip_sub(str);
259 
		break;
2 7u83 260 
	    }
6 7u83 261 
	    case '?': {
2 7u83 262 
		/* The following text is optional */
6 7u83 263 
		if (tdf_bool()) {
264 
		    decode(str + 1);
2 7u83 265 
		} else {
6 7u83 266 
		    out("-");
2 7u83 267 
		}
6 7u83 268 
		str = skip_sub(str);
269 
		break;
2 7u83 270 
	    }
6 7u83 271 
	    case '@': {
2 7u83 272 
		/* The following text is a bitstream */
6 7u83 273 
		long p = tdf_int();
274 
		p += posn(here);
275 
		decode(str + 1);
276 
		if (p != posn(here)) {
277 
		    input_error("Bitstream length wrong");
2 7u83 278 
		}
6 7u83 279 
		str = skip_sub(str);
280 
		break;
2 7u83 281 
	    }
6 7u83 282 
	    case '|': {
2 7u83 283 
		/* Align input stream */
6 7u83 284 
		byte_align();
285 
		break;
2 7u83 286 
	    }
287 
@loop sort
288 
@if sort.basic
289 
@if !sort.special
6 7u83 290 
	    case '%SX': IGNORE de_%SN(); break;
2 7u83 291 
@endif
292 
@endif
293 
@end
294 
	    default : {
6 7u83 295 
		input_error("Illegal decode letter, %%c", c);
296 
		break;
2 7u83 297 
	    }
298 
	}
299 
    }
6 7u83 300 
    return;
2 7u83 301 
}
302 
 
303 
 
304 
/*
305 
    FIND THE NAME AND DECODE LETTER ASSOCIATED WITH A SORT
306 
 
307 
    This routine returns a sortid structure corresponding to the sort
308 
    number n.
309 
*/
310 
 
6 7u83 311 
sortid
312 
find_sort(sortname n)
2 7u83 313 
{
6 7u83 314 
    sortid s;
315 
    switch (n) {
2 7u83 316 
@loop sort
317 
@if sort.name.simple
318 
@if !sort.special
6 7u83 319 
	case sort_%20SN: {
320 
	    s.name = "%ST";
321 
	    s.decode = '%SX';
322 
	    break;
2 7u83 323 
	}
324 
@endif
325 
@endif
326 
@end
6 7u83 327 
	case sort_token: {
328 
	    s.name = "TOKEN";
329 
	    s.decode = 'T';
330 
	    break;
2 7u83 331 
	}
6 7u83 332 
	case sort_foreign: {
333 
	    s.name = "FOREIGN";
334 
	    s.decode = 'F';
335 
	    break;
2 7u83 336 
	}
337 
	default: {
6 7u83 338 
	    int m = n - extra_sorts;
339 
	    if (m >= 0 && m < no_foreign_sorts) {
340 
		s.name = foreign_sorts[m].name;
341 
		s.decode = foreign_sorts[m].decode;
2 7u83 342 
	    } else {
6 7u83 343 
		input_error("Illegal sort value, %%d", n);
344 
		s.name = "<error in SORT>";
345 
		s.decode = 'F';
2 7u83 346 
	    }
6 7u83 347 
	    break;
2 7u83 348 
	}
349 
    }
6 7u83 350 
    s.res = n;
351 
    s.args = null;
352 
    return(s);
2 7u83 353 
}
354 
 
355 
 
356 
/*
357 
 
358 
    CONVERT A DECODE LETTER TO A SORT VALUE
359 
 
360 
    This routine given a decode letter c returns the corresponding sort
361 
    number.
362 
*/
363 
 
6 7u83 364 
sortname
365 
find_sortname(int c)
2 7u83 366 
{
6 7u83 367 
    long i;
368 
    switch (c) {
2 7u83 369 
@loop sort
370 
@if sort.name.simple
371 
@if !sort.special
6 7u83 372 
	case '%SX': return(sort_%20SN);
2 7u83 373 
@endif
374 
@endif
375 
@end
6 7u83 376 
	case 'T': return(sort_token);
377 
	case 'F': return(sort_foreign);
2 7u83 378 
    }
6 7u83 379 
    for (i = 0; i < no_foreign_sorts; i++) {
380 
	if (c == foreign_sorts[i].decode) {
381 
	    return((sortname)(extra_sorts + i));
2 7u83 382 
	}
383 
    }
6 7u83 384 
    return(sort_unknown);
2 7u83 385 
}
386 
 
387 
 
388 
/*
389 
    INITIALISE FOREIGN SORT NAMES
390 
 
391 
    This routine initialises the array of foreign sort names.
392 
*/
393 
 
6 7u83 394 
void
395 
init_foreign_sorts(void)
2 7u83 396 
{
397 
@loop sort
398 
@if sort.name.foreign
6 7u83 399 
    add_foreign_sort("%ST", "%SCN", '%SX');
2 7u83 400 
@endif
401 
@end
6 7u83 402 
    return;
2 7u83 403 
}
404 
 
405 
 
406 
/*
407 
    LINKAGE VARIABLE NUMBERS
408 
 
409 
    Usually "tag" and "token" etc. appear in the var_types array.  These
410 
    variables indicate where (negative values mean not at all).
411 
*/
412 
%1u
413 
@loop sort
414 
@if sort.link
6 7u83 415 
long var_%SN = -%u;
2 7u83 416 
@endif
417 
@end
418 
 
419 
 
420 
/*
421 
    FIND A LINKAGE VARIABLE CODE
422 
 
423 
    This routine sets the nth element of the var_types array to the
424 
    linkage variable indicated by the variable name s.
425 
*/
426 
 
6 7u83 427 
char
428 
find_variable(string s, long n)
2 7u83 429 
{
430 
@loop sort
431 
@if sort.link
6 7u83 432 
    if (streq(s, "%SL")) {
433 
	var_%SN = n;
434 
	return('%SX');
2 7u83 435 
    }
436 
@endif
437 
@end
6 7u83 438 
    return('F');
2 7u83 439 
}
440 
 
441 
 
442 
/*
443 
    FIND A EQUATION DECODING FUNCTION
444 
 
445 
    This routine returns the unit decoding function used to deal with
446 
    units with equation name s.  It also assigns a unit description to
447 
    pt and a usage flag to po.
448 
*/
449 
 
6 7u83 450 
equation_func
451 
find_equation(string s, string *pt, int *po)
2 7u83 452 
{
453 
@loop sort
454 
@if sort.unit
6 7u83 455 
    if (streq(s, "%SU")) {
456 
	*pt = MSG_%SN;
457 
	*po = OPT_%SN;
458 
	return(de_%SN);
2 7u83 459 
    }
460 
@endif
461 
@end
6 7u83 462 
    if (streq(s, "tld")) {
463 
	*pt = MSG_tld_unit;
464 
	*po = OPT_tld_unit;
465 
	return(de_tld_unit);
2 7u83 466 
    }
6 7u83 467 
    if (streq(s, "tld2")) {
468 
	*pt = MSG_tld2_unit;
469 
	*po = OPT_tld2_unit;
470 
	return(de_tld2_unit);
2 7u83 471 
    }
6 7u83 472 
    return(NULL);
2 7u83 473 
}