Subversion Repositories tendra.SVN

Rev

Rev 2 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 2 Rev 7
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 44... Line 74...
44 
 
 74 
 
45 
/*
 75 
/*
46 
    WARN ABOUT UNDECLARED TOKENS
 76 
    WARN ABOUT UNDECLARED TOKENS
47 
*/
 77 
*/
48 
 
 78 
 
49 
int warn_undeclared = 0 ;
 79 
int warn_undeclared = 0;
50 
 
 80 
 
51 
 
 81 
 
52 
/*
 82 
/*
53 
    DECODING TOKENS
 83 
    DECODING TOKENS
54 
 
 84 
 
55 
    Simple TOKENs are represented by TDF integers.  They may also be
 85 
    Simple TOKENs are represented by TDF integers.  They may also be
56 
    tokenised themselves.
 86 
    tokenised themselves.
57 
*/
 87 
*/
58 
 
 88 
 
59 
object *de_token_aux
 89 
object *
60 
    PROTO_N ( ( s, nm ) )
 - 
 
61 
    PROTO_T ( sortname s X char *nm )
 90 
de_token_aux(sortname s, char *nm)
62 
{
 91 
{
63 
    word *w ;
 92 
    word *w;
64 
    long bits, t ;
 93 
    long bits, t;
65 
    object *obj = null ;
 94 
    object *obj = null;
66 
    int ap = 1, simple = 1 ;
 95 
    int ap = 1, simple = 1;
67 
    int just_tok = ( s == sort_unknown ? 1 : 0 ) ;
 96 
    int just_tok = (s == sort_unknown ? 1 : 0);
68 
 
 97 
 
69 
    /* Find the token number */
 98 
    /* Find the token number */
70 
    long n = de_token () ;
 99 
    long n = de_token();
71 
    if ( n == token_make_tok ) {
 100 
    if (n == token_make_tok) {
72 
	t = tdf_int () ;
 101 
	t = tdf_int();
73 
    } else {
 102 
    } else {
74 
	simple = 0 ;
 103 
	simple = 0;
75 
    }
 104 
    }
76 
 
 105 
 
77 
    /* Look up simple tokens */
 106 
    /* Look up simple tokens */
78 
    if ( simple ) {
 107 
    if (simple) {
79 
	SET ( t ) ;
 108 
	SET(t);
80 
	obj = find_binding ( crt_binding, var_token, t ) ;
 109 
	obj = find_binding(crt_binding, var_token, t);
81 
	if ( obj == null ) {
 110 
	if (obj == null) {
82 
	    obj = new_object ( var_token ) ;
 111 
	    obj = new_object(var_token);
83 
	    set_binding ( crt_binding, var_token, t, obj ) ;
 112 
	    set_binding(crt_binding, var_token, t, obj);
84 
	}
 113 
	}
85 
 
 114 
 
86 
	/* Check token sort */
 115 
	/* Check token sort */
87 
	if ( res_sort ( obj ) == sort_unknown ) {
 116 
	if (res_sort(obj) == sort_unknown) {
88 
	    sortname is = implicit_sort ( obj ) ;
 117 
	    sortname is = implicit_sort(obj);
89 
	    if ( is == sort_unknown && warn_undeclared ) {
 118 
	    if (is == sort_unknown && warn_undeclared) {
90 
		int old_recover = recover ;
 119 
		int old_recover = recover;
91 
		int old_exit_status = exit_status ;
 120 
		int old_exit_status = exit_status;
92 
		recover = 1 ;
 121 
		recover = 1;
93 
		input_error ( "Warning : token %s used before it is declared",
 122 
		input_error("Warning : token %s used before it is declared",
94 
			      object_name ( var_token, t ) ) ;
 123 
			      object_name(var_token, t));
95 
		recover = old_recover ;
 124 
		recover = old_recover;
96 
		exit_status = old_exit_status ;
 125 
		exit_status = old_exit_status;
97 
	    }
 126 
	    }
98 
	    if ( is != sort_unknown && is != s ) {
 127 
	    if (is != sort_unknown && is != s) {
99 
		sortid es ;
 128 
		sortid es;
100 
		out ( "<error>" ) ;
 129 
		out("<error>");
101 
		es = find_sort ( s ) ;
 130 
		es = find_sort(s);
102 
		input_error ( "Implicit sort error, token %s, %s expected",
 131 
		input_error("Implicit sort error, token %s, %s expected",
103 
			      object_name ( var_token, t ), es.name ) ;
 132 
			      object_name(var_token, t), es.name);
104 
	    }
 133 
	    }
105 
	    implicit_sort ( obj ) = s ;
 134 
	    implicit_sort(obj) = s;
106 
	} else if ( res_sort ( obj ) != s && !just_tok ) {
 135 
	} else if (res_sort(obj)!= s && !just_tok) {
107 
	    sortid es ;
 136 
	    sortid es;
108 
	    out ( "<error>" ) ;
 137 
	    out("<error>");
109 
	    es = find_sort ( s ) ;
 138 
	    es = find_sort(s);
110 
	    input_error ( "Sort error, token %s, %s expected",
 139 
	    input_error("Sort error, token %s, %s expected",
111 
			  object_name ( var_token, t ), es.name ) ;
 140 
			  object_name(var_token, t), es.name);
112 
	}
 141 
	}
113 
 
 142 
 
114 
	/* Output token name if appropriate */
 143 
	/* Output token name if appropriate */
115 
	if ( !dumb_mode ) {
 144 
	if (!dumb_mode) {
116 
	     if ( obj->named ) {
 145 
	     if (obj->named) {
117 
		if ( obj->name.simple ) {
 146 
		if (obj->name.simple) {
118 
		    out_string ( obj->name.val.str ) ;
 147 
		    out_string(obj->name.val.str);
119 
		    ap = 0 ;
 148 
		    ap = 0;
120 
		}
 149 
		}
121 
	    } else {
 150 
	    } else {
122 
		char buff [50] ;
 151 
		char buff[50];
123 
		IGNORE sprintf ( buff, "~token_%ld", obj->id ) ;
 152 
		IGNORE sprintf(buff, "~token_%ld", obj->id);
124 
		out_string ( buff ) ;
 153 
		out_string(buff);
125 
		ap = 0 ;
 154 
		ap = 0;
126 
	    }
 155 
	    }
127 
	}
 156 
	}
128 
    }
 157 
    }
129 
 
 158 
 
130 
    /* Output "apply_token" if appropriate */
 159 
    /* Output "apply_token" if appropriate */
131 
    if ( ap ) {
 160 
    if (ap) {
132 
	if ( just_tok ) {
 161 
	if (just_tok) {
133 
	    out_string ( "make_token" ) ;
 162 
	    out_string("make_token");
134 
	} else {
 163 
	} else {
135 
	    out_string ( "apply_" ) ;
 164 
	    out_string("apply_");
136 
	    out_string ( nm ) ;
 165 
	    out_string(nm);
137 
	    out_string ( "_token" ) ;
 166 
	    out_string("_token");
138 
	}
 167 
	}
139 
	w = new_word ( VERT_BRACKETS ) ;
 168 
	w = new_word(VERT_BRACKETS);
140 
	if ( simple ) {
 169 
	if (simple) {
141 
	    SET ( t ) ;
 170 
	    SET(t);
142 
	    out_object ( t, obj, var_token ) ;
 171 
	    out_object(t, obj, var_token);
143 
	} else {
 172 
	} else {
144 
	    if ( n == token_token_apply_token ) {
 173 
	    if (n == token_token_apply_token) {
145 
		object *subobj = de_token_aux ( sort_token, "token" ) ;
 174 
		object *subobj = de_token_aux(sort_token, "token");
146 
		if ( subobj ) obj = subobj->aux ;
 175 
		if (subobj)obj = subobj->aux;
147 
	    } else {
 176 
	    } else {
148 
		/* use_tokdef */
 177 
		/* use_tokdef */
149 
		long len = tdf_int () ;
 178 
		long len = tdf_int();
150 
		skip_bits ( len ) ;
 179 
		skip_bits(len);
151 
		out_string ( "use_tokdef(....)" ) ;
 180 
		out_string("use_tokdef(....)");
152 
		IGNORE new_word ( SIMPLE ) ;
 181 
		IGNORE new_word(SIMPLE);
153 
	    }
 182 
	    }
154 
	}
 183 
	}
155 
    } else {
 184 
    } else {
156 
	/* Applications of named tokens are indicated by "*" */
 185 
	/* Applications of named tokens are indicated by "*" */
157 
	out_string ( "*" ) ;
 186 
	out_string("*");
158 
    }
 187 
    }
159 
 
 188 
 
160 
    /* Quit here if just reading token */
 189 
    /* Quit here if just reading token */
161 
    if ( just_tok ) {
 190 
    if (just_tok) {
162 
	if ( ap ) {
 191 
	if (ap) {
163 
	    SET ( w ) ;
 192 
	    SET(w);
164 
	    end_word ( w ) ;
 193 
	    end_word(w);
165 
	} else {
 194 
	} else {
166 
	    IGNORE new_word ( SIMPLE ) ;
 195 
	    IGNORE new_word(SIMPLE);
167 
	}
 196 
	}
168 
	return ( obj ) ;
 197 
	return(obj);
169 
    }
 198 
    }
170 
 
 199 
 
171 
    /* Read length of token arguments */
 200 
    /* Read length of token arguments */
172 
    bits = tdf_int () ;
 201 
    bits = tdf_int();
173 
 
 202 
 
174 
    /* Deal with tokens without arguments */
 203 
    /* Deal with tokens without arguments */
175 
    if ( bits == 0 ) {
 204 
    if (bits == 0) {
176 
	if ( obj && res_sort ( obj ) != sort_unknown ) {
 205 
	if (obj && res_sort(obj)!= sort_unknown) {
177 
	    char *ps = arg_sorts ( obj ) ;
 206 
	    char *ps = arg_sorts(obj);
178 
	    if ( ps && *ps ) {
 207 
	    if (ps && *ps) {
179 
		if ( simple ) {
 208 
		if (simple) {
180 
		    SET ( t ) ;
 209 
		    SET(t);
181 
		    input_error ( "Token arguments missing, token %s",
 210 
		    input_error("Token arguments missing, token %s",
182 
				  object_name ( var_token, t ) ) ;
 211 
				  object_name(var_token, t));
183 
		} else {
 212 
		} else {
184 
		    input_error ( "Token arguments missing" ) ;
 213 
		    input_error("Token arguments missing");
185 
		}
 214 
		}
186 
	    }
 215 
	    }
187 
	}
 216 
	}
188 
	if ( ap ) {
 217 
	if (ap) {
189 
	    SET ( w ) ;
 218 
	    SET(w);
190 
	    end_word ( w ) ;
 219 
	    end_word(w);
191 
	} else {
 220 
	} else {
192 
	    IGNORE new_word ( SIMPLE ) ;
 221 
	    IGNORE new_word(SIMPLE);
193 
	}
 222 
	}
194 
	return ( obj ) ;
 223 
	return(obj);
195 
    }
 224 
    }
196 
 
 225 
 
197 
    /* Deal with tokens with arguments */
 226 
    /* Deal with tokens with arguments */
198 
    if ( obj && res_sort ( obj ) != sort_unknown && !is_foreign ( obj ) ) {
 227 
    if (obj && res_sort(obj)!= sort_unknown && !is_foreign(obj)) {
199 
	/* Known token - decode arguments */
 228 
	/* Known token - decode arguments */
200 
	if ( arg_sorts ( obj ) ) {
 229 
	if (arg_sorts(obj)) {
201 
	    long p = posn ( here ) ;
 230 
	    long p = posn(here);
202 
	    if ( !ap ) w = new_word ( VERT_BRACKETS ) ;
 231 
	    if (!ap)w = new_word(VERT_BRACKETS);
203 
	    decode ( arg_sorts ( obj ) ) ;
 232 
	    decode(arg_sorts(obj));
204 
	    if ( p + bits != posn ( here ) ) {
 233 
	    if (p + bits != posn(here)) {
205 
		if ( simple ) {
 234 
		if (simple) {
206 
		    SET ( t ) ;
 235 
		    SET(t);
207 
		    input_error ( "Token arguments length wrong, token %s",
 236 
		    input_error("Token arguments length wrong, token %s",
208 
				  object_name ( var_token, t ) ) ;
 237 
				  object_name(var_token, t));
209 
		} else {
 238 
		} else {
210 
		    input_error ( "Token arguments length wrong" ) ;
 239 
		    input_error("Token arguments length wrong");
211 
		}
 240 
		}
212 
	    }
 241 
	    }
213 
	} else {
 242 
	} else {
214 
	    if ( ap ) {
 243 
	    if (ap) {
215 
		SET ( w ) ;
 244 
		SET(w);
216 
		end_word ( w ) ;
 245 
		end_word(w);
217 
	    } else {
 246 
	    } else {
218 
		IGNORE new_word ( SIMPLE ) ;
 247 
		IGNORE new_word(SIMPLE);
219 
	    }
 248 
	    }
220 
	    return ( obj ) ;
 249 
	    return(obj);
221 
	}
 250 
	}
222 
    } else {
 251 
    } else {
223 
	/* Unknown token - step over arguments */
 252 
	/* Unknown token - step over arguments */
224 
	if ( !ap ) w = new_word ( VERT_BRACKETS ) ;
 253 
	if (!ap)w = new_word(VERT_BRACKETS);
225 
	out ( "...." ) ;
 254 
	out("....");
226 
	skip_bits ( bits ) ;
 255 
	skip_bits(bits);
227 
    }
 256 
    }
228 
    SET ( w ) ;
 257 
    SET(w);
229 
    end_word ( w ) ;
 258 
    end_word(w);
230 
    return ( obj ) ;
 259 
    return(obj);
231 
}
 260 
}
232 
 
 261 
 
233 
 
 262 
 
234 
/*
 263 
/*
235 
    DECODING SIMPLE LABELS
 264 
    DECODING SIMPLE LABELS
236 
*/
 265 
*/
237 
 
 266 
 
238 
void de_make_label
 267 
void
239 
    PROTO_N ( ( lab_no ) )
 - 
 
240 
    PROTO_T ( long lab_no )
 268 
de_make_label(long lab_no)
241 
{
 269 
{
242 
    if ( dumb_mode ) {
 270 
    if (dumb_mode) {
243 
	word *w ;
 271 
	word *w;
244 
	out_string ( "label" ) ;
 272 
	out_string("label");
245 
	w = new_word ( HORIZ_BRACKETS ) ;
 273 
	w = new_word(HORIZ_BRACKETS);
246 
	out_int ( lab_no ) ;
 274 
	out_int(lab_no);
247 
	end_word ( w ) ;
 275 
	end_word(w);
248 
    } else {
 276 
    } else {
249 
	out_string ( "~label_" ) ;
 277 
	out_string("~label_");
250 
	out_int ( lab_no ) ;
 278 
	out_int(lab_no);
251 
    }
 279 
    }
252 
    if ( lab_no < 0 || lab_no >= max_lab_no ) {
 280 
    if (lab_no < 0 || lab_no >= max_lab_no) {
253 
	input_error ( "Label number %ld out of range", lab_no ) ;
 281 
	input_error("Label number %ld out of range", lab_no);
254 
    }
 282 
    }
255 
    return ;
 283 
    return;
256 
}
 284 
}
257 
 
 285 
 
258 
 
 286 
 
259 
/*
 287 
/*
260 
    FORMATTING SIZE FOR TDF STRINGS
 288 
    FORMATTING SIZE FOR TDF STRINGS
Line 270... Line 298...
270 
    DECODING FORMATTED STRINGS
 298 
    DECODING FORMATTED STRINGS
271 
 
 299 
 
272 
    A TDF string is read and output in a formatted form.
 300 
    A TDF string is read and output in a formatted form.
273 
*/
 301 
*/
274 
 
 302 
 
- 
 
 303 
void
275 
void de_tdfstring_format
 304 
de_tdfstring_format(void)
276 
    PROTO_Z ()
 - 
 
277 
{
 305 
{
278 
    string s ;
 306 
    string s;
279 
    word *ptr1 ;
 307 
    word *ptr1;
280 
    long sz = tdf_int () ;
 308 
    long sz = tdf_int();
281 
    long n = tdf_int () ;
 309 
    long n = tdf_int();
282 
    if ( sz != 8 ) {
 310 
    if (sz != 8) {
283 
	char sbuff [100] ;
 311 
	char sbuff[100];
284 
	IGNORE sprintf ( sbuff, "make_string_%ld", sz ) ;
 312 
	IGNORE sprintf(sbuff, "make_string_%ld", sz);
285 
	out_string ( sbuff ) ;
 313 
	out_string(sbuff);
286 
	ptr1 = new_word ( HORIZ_BRACKETS ) ;
 314 
	ptr1 = new_word(HORIZ_BRACKETS);
287 
    }
 315 
    }
288 
    if ( sz > 8 ) {
 316 
    if (sz > 8) {
289 
	long i ;
 317 
	long i;
290 
	for ( i = 0 ; i < n ; i++ ) {
 318 
	for (i = 0; i < n; i++) {
291 
	    long v = fetch ( ( int ) sz ) ;
 319 
	    long v = fetch((int)sz);
292 
	    out_int ( v ) ;
 320 
	    out_int(v);
293 
	}
 321 
	}
294 
    } else {
 322 
    } else {
295 
	s = get_string ( n, sz ) ;
 323 
	s = get_string(n, sz);
296 
	n = ( long ) strlen ( s ) ;
 324 
	n = (long)strlen(s);
297 
	if ( n == 0 ) {
 325 
	if (n == 0) {
298 
	    out ( "\"\"" ) ;
 326 
	    out("\"\"");
299 
	    return ;
 327 
	    return;
300 
	}
 328 
	}
301 
	while ( n ) {
 329 
	while (n) {
302 
	    long m = ( n < STRING_WIDTH ? n : STRING_WIDTH ) ;
 330 
	    long m = (n < STRING_WIDTH ? n : STRING_WIDTH);
303 
	    char *w = alloc_nof ( char, m + 3 ) ;
 331 
	    char *w = alloc_nof(char, m + 3);
304 
	    IGNORE memcpy ( w + 1, s, ( size_t ) m ) ;
 332 
	    IGNORE memcpy(w + 1, s,(size_t)m);
305 
	    w [0] = QUOTE ;
 333 
	    w[0] = QUOTE;
306 
	    w [ m + 1 ] = QUOTE ;
 334 
	    w[m + 1] = QUOTE;
307 
	    w [ m + 2 ] = 0 ;
 335 
	    w[m + 2] = 0;
308 
	    out ( w ) ;
 336 
	    out(w);
309 
	    n -= m ;
 337 
	    n -= m;
310 
	    s += m ;
 338 
	    s += m;
311 
	}
 339 
	}
312 
    }
 340 
    }
313 
    if ( sz != 8 ) {
 341 
    if (sz != 8) {
314 
	SET ( ptr1 ) ;
 342 
	SET(ptr1);
315 
	end_word ( ptr1 ) ;
 343 
	end_word(ptr1);
316 
    }
 344 
    }
317 
    return ;
 345 
    return;
318 
}
 346 
}
319 
 
 347 
 
320 
 
 348 
 
321 
/*
 349 
/*
322 
    DECODING THE EXP "solve" (OR "labelled")
 350 
    DECODING THE EXP "solve" (OR "labelled")
Line 332... Line 360...
332 
		      B, A1, C1, ..., An, Cn
 360 
		      B, A1, C1, ..., An, Cn
333 
 
 361 
 
334 
    so there is a certain amount of to-ing and fro-ing.
 362 
    so there is a certain amount of to-ing and fro-ing.
335 
*/
 363 
*/
336 
 
 364 
 
337 
void de_solve_fn
 365 
void
338 
    PROTO_N ( ( nm, str1, str2, str3, ntwice ) )
 - 
 
339 
    PROTO_T ( char *nm X char *str1 X char *str2 X char *str3 X int ntwice )
 366 
de_solve_fn(char *nm, char *str1, char *str2, char *str3, int ntwice)
340 
{
 367 
{
341 
    long i, n ;
 368 
    long i, n;
342 
    word *ptr1, *ptr2 ;
 369 
    word *ptr1, *ptr2;
343 
    place posn1, posn2 ;
 370 
    place posn1, posn2;
344 
 
 371 
 
345 
    int tempflag = printflag ;
 372 
    int tempflag = printflag;
346 
 
 373 
 
347 
    out_string ( nm ) ;
 374 
    out_string(nm);
348 
    ptr1 = new_word ( VERT_BRACKETS ) ;
 375 
    ptr1 = new_word(VERT_BRACKETS);
349 
 
 376 
 
350 
    /* Read the number of statements A1, ..., An */
 377 
    /* Read the number of statements A1, ..., An */
351 
    check_list () ;
 378 
    check_list();
352 
    n = tdf_int () ;
 379 
    n = tdf_int();
353 
 
 380 
 
354 
    /* Record the position of A1 */
 381 
    /* Record the position of A1 */
355 
    posn1.byte = here.byte ;
 382 
    posn1.byte = here.byte;
356 
    posn1.bit = here.bit ;
 383 
    posn1.bit = here.bit;
357 
 
 384 
 
358 
    /* Step over A1, ..., An */
 385 
    /* Step over A1, ..., An */
359 
    printflag = 0 ;
 386 
    printflag = 0;
360 
    for ( i = 0 ; i < n ; i++ ) decode ( str1 ) ;
 387 
    for (i = 0; i < n; i++)decode(str1);
361 
    printflag = tempflag ;
 388 
    printflag = tempflag;
362 
 
 389 
 
363 
    /* Decode B */
 390 
    /* Decode B */
364 
    decode ( str2 ) ;
 391 
    decode(str2);
365 
 
 392 
 
366 
    if ( ntwice ) {
 393 
    if (ntwice) {
367 
	/* Read and check the number of statements C1, ..., Cn */
 394 
	/* Read and check the number of statements C1, ..., Cn */
368 
	long m ;
 395 
	long m;
369 
	check_list () ;
 396 
	check_list();
370 
	m = tdf_int () ;
 397 
	m = tdf_int();
371 
	if ( m != n ) input_error ( "Illegal %s construct", nm ) ;
 398 
	if (m != n)input_error("Illegal %s construct", nm);
372 
    }
 399 
    }
373 
 
 400 
 
374 
    for ( i = 0 ; i < n ; i++ ) {
 401 
    for (i = 0; i < n; i++) {
375 
	ptr2 = new_word ( VERT_BRACKETS ) ;
 402 
	ptr2 = new_word(VERT_BRACKETS);
376 
 
 403 
 
377 
	/* Record the position of Ci */
 404 
	/* Record the position of Ci */
378 
	posn2.byte = here.byte ;
 405 
	posn2.byte = here.byte;
379 
	posn2.bit = here.bit ;
 406 
	posn2.bit = here.bit;
380 
 
 407 
 
381 
	/* Go back and read Ai */
 408 
	/* Go back and read Ai */
382 
	set_place ( &posn1 ) ;
 409 
	set_place(&posn1);
383 
	decode ( str1 ) ;
 410 
	decode(str1);
384 
 
 411 
 
385 
	/* Record the position of A(i+1) */
 412 
	/* Record the position of A(i+1) */
386 
	posn1.byte = here.byte ;
 413 
	posn1.byte = here.byte;
387 
	posn1.bit = here.bit ;
 414 
	posn1.bit = here.bit;
388 
 
 415 
 
389 
	/* Go forward and read Ci */
 416 
	/* Go forward and read Ci */
390 
	set_place ( &posn2 ) ;
 417 
	set_place(&posn2);
391 
	decode ( str3 ) ;
 418 
	decode(str3);
392 
 
 419 
 
393 
	end_word ( ptr2 ) ;
 420 
	end_word(ptr2);
394 
    }
 421 
    }
395 
    end_word ( ptr1 ) ;
 422 
    end_word(ptr1);
396 
    return ;
 423 
    return;
397 
}
 424 
}
398 
 
 425 
 
399 
 
 426 
 
400 
/*
 427 
/*
401 
    DECODING THE EXP "case"
 428 
    DECODING THE EXP "case"
Line 406... Line 433...
406 
 
 433 
 
407 
    where A is given by the decode string str1, Li is a label and Bi
 434 
    where A is given by the decode string str1, Li is a label and Bi
408 
    is given by str2.
 435 
    is given by str2.
409 
*/
 436 
*/
410 
 
 437 
 
411 
void de_case_fn
 438 
void
412 
    PROTO_N ( ( nm, str1, str2 ) )
 - 
 
413 
    PROTO_T ( char *nm X char *str1 X char *str2 )
 439 
de_case_fn(char *nm, char *str1, char *str2)
414 
{
 440 
{
415 
    long i, n ;
 441 
    long i, n;
416 
    word *ptr1, *ptr2, *ptr3 ;
 442 
    word *ptr1, *ptr2, *ptr3;
417 
 
 443 
 
418 
    out_string ( nm ) ;
 444 
    out_string(nm);
419 
    ptr1 = new_word ( VERT_BRACKETS ) ;
 445 
    ptr1 = new_word(VERT_BRACKETS);
420 
    decode ( str1 ) ;
 446 
    decode(str1);
421 
    ptr2 = new_word ( VERT_BRACKETS ) ;
 447 
    ptr2 = new_word(VERT_BRACKETS);
422 
    check_list () ;
 448 
    check_list();
423 
    n = tdf_int () ;
 449 
    n = tdf_int();
424 
    for ( i = 0 ; i < n ; i++ ) {
 450 
    for (i = 0; i < n; i++) {
425 
	ptr3 = new_word ( HORIZ_NONE ) ;
 451 
	ptr3 = new_word(HORIZ_NONE);
426 
	IGNORE de_label () ;
 452 
	IGNORE de_label();
427 
	out ( ":" ) ;
 453 
	out(":");
428 
	format ( HORIZ_BRACKETS, "", str2 ) ;
 454 
	format(HORIZ_BRACKETS, "", str2);
429 
	end_word ( ptr3 ) ;
 455 
	end_word(ptr3);
430 
    }
 456 
    }
431 
    end_word ( ptr2 ) ;
 457 
    end_word(ptr2);
432 
    end_word ( ptr1 ) ;
 458 
    end_word(ptr1);
433 
    return ;
 459 
    return;
434 
}
 460 
}
435 
 
 461 
 
436 
 
 462 
 
437 
/*
 463 
/*
438 
    DECODING THE EXP "make_proc"
 464 
    DECODING THE EXP "make_proc"
Line 443... Line 469...
443 
 
 469 
 
444 
    where A is given by the decode string str1, B by str2 and C by str3.
 470 
    where A is given by the decode string str1, B by str2 and C by str3.
445 
    However each Bi is grouped as a "make_proc_arg".
 471 
    However each Bi is grouped as a "make_proc_arg".
446 
*/
 472 
*/
447 
 
 473 
 
448 
void de_mk_proc_fn
 474 
void
449 
    PROTO_N ( ( nm, str1, str2, str3 ) )
 - 
 
450 
    PROTO_T ( char *nm X char *str1 X char *str2 X char *str3 )
 475 
de_mk_proc_fn(char *nm, char *str1, char *str2, char *str3)
451 
{
 476 
{
452 
    long i, n ;
 477 
    long i, n;
453 
    word *ptr ;
 478 
    word *ptr;
454 
    out_string ( nm ) ;
 479 
    out_string(nm);
455 
    ptr = new_word ( VERT_BRACKETS ) ;
 480 
    ptr = new_word(VERT_BRACKETS);
456 
    decode ( str1 ) ;
 481 
    decode(str1);
457 
    check_list () ;
 482 
    check_list();
458 
    n = tdf_int () ;
 483 
    n = tdf_int();
459 
    if ( n == 0 ) {
 484 
    if (n == 0) {
460 
	out ( "empty" ) ;
 485 
	out("empty");
461 
    } else {
 486 
    } else {
462 
	for ( i = 0 ; i < n ; i++ ) {
 487 
	for (i = 0; i < n; i++) {
463 
	    out_string ( nm ) ;
 488 
	    out_string(nm);
464 
	    format ( VERT_BRACKETS, "_arg", str2 ) ;
 489 
	    format(VERT_BRACKETS, "_arg", str2);
465 
	}
 490 
	}
466 
    }
 491 
    }
467 
    decode ( str3 ) ;
 492 
    decode(str3);
468 
    end_word ( ptr ) ;
 493 
    end_word(ptr);
469 
    return ;
 494 
    return;
470 
}
 495 
}