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