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 51... Line 81...
51 
 
 81 
 
52 
    An external name representing an object of sort s is read from the
 82 
    An external name representing an object of sort s is read from the
53 
    input file.  If local is true this must just be an internal identifier.
 83 
    input file.  If local is true this must just be an internal identifier.
54 
*/
 84 
*/
55 
 
 85 
 
56 
static construct *read_external
 86 
static construct *
57 
    PROTO_N ( ( s, local ) )
 - 
 
58 
    PROTO_T ( sortname s X boolean local )
 87 
read_external(sortname s, boolean local)
59 
{
 88 
{
60 
    construct *p ;
 89 
    construct *p;
61 
    node *e = null ;
 90 
    node *e = null;
62 
    int estate = 0 ;
 91 
    int estate = 0;
63 
    position store ;
 92 
    position store;
64 
    allow_multibyte = 0 ;
 93 
    allow_multibyte = 0;
65 
 
 94 
 
66 
    /* Read identifier */
 95 
    /* Read identifier */
67 
    store_position ( &store ) ;
 96 
    store_position(&store);
68 
    read_word () ;
 97 
    read_word();
69 
 
 98 
 
70 
    /* Check for external name */
 99 
    /* Check for external name */
71 
    if ( func_input ) {
 100 
    if (func_input) {
72 
	if ( word_type == INPUT_WORD ) {
 101 
	if (word_type == INPUT_WORD) {
73 
	    if ( streq ( word, MAKE_STRING_EXTERN ) ) {
 102 
	    if (streq(word, MAKE_STRING_EXTERN)) {
74 
		estate = 1 ;
 103 
		estate = 1;
75 
	    } else if ( streq ( word, MAKE_UNIQUE_EXTERN ) ) {
 104 
	    } else if (streq(word, MAKE_UNIQUE_EXTERN)) {
76 
		estate = 2 ;
 105 
		estate = 2;
77 
	    } else if ( streq ( word, MAKE_CHAIN_EXTERN ) ) {
 106 
	    } else if (streq(word, MAKE_CHAIN_EXTERN)) {
78 
		estate = 3 ;
 107 
		estate = 3;
79 
	    }
 108 
	    }
80 
	    if ( estate ) {
 109 
	    if (estate) {
81 
		read_word () ;
 110 
		read_word();
82 
		if ( word_type != INPUT_OPEN ) {
 111 
		if (word_type != INPUT_OPEN) {
83 
		    /* Go back and treat as identifier */
 112 
		    /* Go back and treat as identifier */
84 
		    estate = 0 ;
 113 
		    estate = 0;
85 
		    set_position ( &store ) ;
 114 
		    set_position(&store);
86 
		    read_word () ;
 115 
		    read_word();
87 
		}
 116 
		}
88 
	    }
 117 
	    }
89 
	}
 118 
	}
90 
    } else {
 119 
    } else {
91 
	if ( word_type == INPUT_OPEN ) {
 120 
	if (word_type == INPUT_OPEN) {
92 
	    read_word () ;
 121 
	    read_word();
93 
	    if ( word_type != INPUT_WORD ) {
 122 
	    if (word_type != INPUT_WORD) {
94 
		input_error ( "External expected" ) ;
 123 
		input_error("External expected");
95 
		return ( null ) ;
 124 
		return(null);
96 
	    }
 125 
	    }
97 
	    if ( streq ( word, MAKE_STRING_EXTERN ) ) {
 126 
	    if (streq(word, MAKE_STRING_EXTERN)) {
98 
		estate = 1 ;
 127 
		estate = 1;
99 
	    } else if ( streq ( word, MAKE_UNIQUE_EXTERN ) ) {
 128 
	    } else if (streq(word, MAKE_UNIQUE_EXTERN)) {
100 
		estate = 2 ;
 129 
		estate = 2;
101 
	    } else if ( streq ( word, MAKE_CHAIN_EXTERN ) ) {
 130 
	    } else if (streq(word, MAKE_CHAIN_EXTERN)) {
102 
		estate = 3 ;
 131 
		estate = 3;
103 
	    } else {
 132 
	    } else {
104 
		input_error ( "Illegal external, %s", word ) ;
 133 
		input_error("Illegal external, %s", word);
105 
		return ( null ) ;
 134 
		return(null);
106 
	    }
 135 
	    }
107 
	}
 136 
	}
108 
    }
 137 
    }
109 
 
 138 
 
110 
    if ( estate ) {
 139 
    if (estate) {
111 
	/* There is an external name */
 140 
	/* There is an external name */
112 
	if ( local ) {
 141 
	if (local) {
113 
	    is_fatal = 0 ;
 142 
	    is_fatal = 0;
114 
	    input_error ( "Can't have external name with local" ) ;
 143 
	    input_error("Can't have external name with local");
115 
	}
 144 
	}
116 
	e = new_node () ;
 145 
	e = new_node();
117 
	e->cons = &true_cons ;
 146 
	e->cons = &true_cons;
118 
	if ( estate == 1 ) {
 147 
	if (estate == 1) {
119 
	    e->son = read_node ( "$" ) ;
 148 
	    e->son = read_node("$");
120 
	} else if ( estate == 2 ) {
 149 
	} else if (estate == 2) {
121 
	    e->son = read_node ( "*[$]" ) ;
 150 
	    e->son = read_node("*[$]");
122 
	} else {
 151 
	} else {
123 
	    e->son = read_node ( "$i" ) ;
 152 
	    e->son = read_node("$i");
124 
	}
 153 
	}
125 
	read_word () ;
 154 
	read_word();
126 
	if ( word_type != INPUT_CLOSE ) {
 155 
	if (word_type != INPUT_CLOSE) {
127 
	    is_fatal = 0 ;
 156 
	    is_fatal = 0;
128 
	    input_error ( "End of external construct expected" ) ;
 157 
	    input_error("End of external construct expected");
129 
	    looked_ahead = 1 ;
 158 
	    looked_ahead = 1;
130 
	}
 159 
	}
131 
	read_word () ;
 160 
	read_word();
132 
	if ( func_input ) {
 161 
	if (func_input) {
133 
	    if ( word_type != INPUT_COMMA ) {
 162 
	    if (word_type != INPUT_COMMA) {
134 
		is_fatal = 0 ;
 163 
		is_fatal = 0;
135 
		input_error ( "Comma expected" ) ;
 164 
		input_error("Comma expected");
136 
		looked_ahead = 1 ;
 165 
		looked_ahead = 1;
137 
	    }
 166 
	    }
138 
	    read_word () ;
 167 
	    read_word();
139 
	}
 168 
	}
140 
    } else {
 169 
    } else {
141 
	/* There is no external name */
 170 
	/* There is no external name */
142 
	if ( is_local_name ( word ) ) local = 1 ;
 171 
	if (is_local_name(word))local = 1;
143 
	if ( !local ) {
 172 
	if (!local) {
144 
	    e = new_node () ;
 173 
	    e = new_node();
145 
	    e->cons = &false_cons ;
 174 
	    e->cons = &false_cons;
146 
	}
 175 
	}
147 
    }
 176 
    }
148 
 
 177 
 
149 
    /* Check internal name */
 178 
    /* Check internal name */
150 
    if ( word_type != INPUT_WORD ) input_error ( "Identifier expected" ) ;
 179 
    if (word_type != INPUT_WORD)input_error("Identifier expected");
151 
    p = search_var_hash ( word, s ) ;
 180 
    p = search_var_hash(word, s);
152 
    if ( p == null ) {
 181 
    if (p == null) {
153 
	/* New object */
 182 
	/* New object */
154 
	p = make_construct ( s ) ;
 183 
	p = make_construct(s);
155 
	p->name = string_copy_aux ( word ) ;
 184 
	p->name = string_copy_aux(word);
156 
	p->ename = e ;
 185 
	p->ename = e;
157 
	IGNORE add_to_var_hash ( p, s ) ;
 186 
	IGNORE add_to_var_hash(p, s);
158 
    } else {
 187 
    } else {
159 
	/* Existing object : check consistency */
 188 
	/* Existing object : check consistency */
160 
	if ( local ) {
 189 
	if (local) {
161 
	    if ( p->ename ) {
 190 
	    if (p->ename) {
162 
		is_fatal = 0 ;
 191 
		is_fatal = 0;
163 
		input_error ( "Object %s previously declared global", word ) ;
 192 
		input_error("Object %s previously declared global", word);
164 
	    }
 193 
	    }
165 
	} else {
 194 
	} else {
166 
	    if ( p->ename ) {
 195 
	    if (p->ename) {
167 
		if ( e->son ) {
 196 
		if (e->son) {
168 
		    is_fatal = 0 ;
 197 
		    is_fatal = 0;
169 
		    input_error ( "External name of object %s given twice",
 198 
		    input_error("External name of object %s given twice",
170 
				  word ) ;
 199 
				  word);
171 
		}
 200 
		}
172 
	    } else {
 201 
	    } else {
173 
		is_fatal = 0 ;
 202 
		is_fatal = 0;
174 
		input_error ( "Object %s previously declared local", word ) ;
 203 
		input_error("Object %s previously declared local", word);
175 
	    }
 204 
	    }
176 
	}
 205 
	}
177 
    }
 206 
    }
178 
    allow_multibyte = 1 ;
 207 
    allow_multibyte = 1;
179 
    return ( p ) ;
 208 
    return(p);
180 
}
 209 
}
181 
 
 210 
 
182 
 
 211 
 
183 
/*
 212 
/*
184 
    READ AN ALIGNMENT TAG DECLARATION
 213 
    READ AN ALIGNMENT TAG DECLARATION
185 
 
 214 
 
186 
    An alignment tag declaration is read from the input file.
 215 
    An alignment tag declaration is read from the input file.
187 
*/
 216 
*/
188 
 
 217 
 
189 
static void read_aldec
 218 
static void
190 
    PROTO_N ( ( local ) )
 - 
 
191 
    PROTO_T ( boolean local )
 219 
read_aldec(boolean local)
192 
{
 220 
{
193 
    IGNORE read_external ( SORT_al_tag, local ) ;
 221 
    IGNORE read_external(SORT_al_tag, local);
194 
    return ;
 222 
    return;
195 
}
 223 
}
196 
 
 224 
 
197 
 
 225 
 
198 
/*
 226 
/*
199 
    READ AN ALIGNMENT TAG DEFINITION
 227 
    READ AN ALIGNMENT TAG DEFINITION
200 
 
 228 
 
201 
    An alignment tag definition is read from the input file.
 229 
    An alignment tag definition is read from the input file.
202 
*/
 230 
*/
203 
 
 231 
 
204 
static void read_aldef
 232 
static void
205 
    PROTO_N ( ( local ) )
 - 
 
206 
    PROTO_T ( boolean local )
 233 
read_aldef(boolean local)
207 
{
 234 
{
208 
    node *d ;
 235 
    node *d;
209 
    construct *p = read_external ( SORT_al_tag, local ) ;
 236 
    construct *p = read_external(SORT_al_tag, local);
210 
    al_tag_info *info = get_al_tag_info ( p ) ;
 237 
    al_tag_info *info = get_al_tag_info(p);
211 
 
 238 
 
212 
    /* Check comma */
 239 
    /* Check comma */
213 
    if ( func_input ) {
 240 
    if (func_input) {
214 
	read_word () ;
 241 
	read_word();
215 
	if ( word_type != INPUT_COMMA ) {
 242 
	if (word_type != INPUT_COMMA) {
216 
	    is_fatal = 0 ;
 243 
	    is_fatal = 0;
217 
	    input_error ( "Comma expected" ) ;
 244 
	    input_error("Comma expected");
218 
	    looked_ahead = 1 ;
 245 
	    looked_ahead = 1;
219 
	}
 246 
	}
220 
    }
 247 
    }
221 
 
 248 
 
222 
    /* Read the definition (an alignment) */
 249 
    /* Read the definition (an alignment) */
223 
    d = completion ( read_node ( "a" ) ) ;
 250 
    d = completion(read_node("a"));
224 
    if ( info->def ) {
 251 
    if (info->def) {
225 
	if ( !eq_node ( info->def, d ) ) {
 252 
	if (!eq_node(info->def, d)) {
226 
	    is_fatal = 0 ;
 253 
	    is_fatal = 0;
227 
	    input_error ( "Alignment tag %s defined inconsistently",
 254 
	    input_error("Alignment tag %s defined inconsistently",
228 
			  p->name ) ;
 255 
			  p->name);
229 
	}
 256 
	}
230 
	free_node ( d ) ;
 257 
	free_node(d);
231 
    } else {
 258 
    } else {
232 
	info->def = d ;
 259 
	info->def = d;
233 
    }
 260 
    }
234 
    return ;
 261 
    return;
235 
}
 262 
}
236 
 
 263 
 
237 
 
 264 
 
238 
/*
 265 
/*
239 
    READ A TAG DECLARATION
 266 
    READ A TAG DECLARATION
240 
 
 267 
 
241 
    A tag declaration is read from the input file.  Whether it is a
 268 
    A tag declaration is read from the input file.  Whether it is a
242 
    variable or an identity is indicated by the is_var flag.
 269 
    variable or an identity is indicated by the is_var flag.
243 
*/
 270 
*/
244 
 
 271 
 
245 
static void read_tagdec
 272 
static void
246 
    PROTO_N ( ( local, is_var ) )
 - 
 
247 
    PROTO_T ( boolean local X int is_var )
 273 
read_tagdec(boolean local, int is_var)
248 
{
 274 
{
249 
    node *d ;
 275 
    node *d;
250 
    construct *p = read_external ( SORT_tag, local ) ;
 276 
    construct *p = read_external(SORT_tag, local);
251 
    tag_info *info = get_tag_info ( p ) ;
 277 
    tag_info *info = get_tag_info(p);
252 
    set_tag_type ( p, is_var ) ;
 278 
    set_tag_type(p, is_var);
253 
 
 279 
 
254 
    /* Check comma */
 280 
    /* Check comma */
255 
    if ( func_input ) {
 281 
    if (func_input) {
256 
	read_word () ;
 282 
	read_word();
257 
	if ( word_type != INPUT_COMMA ) {
 283 
	if (word_type != INPUT_COMMA) {
258 
	    is_fatal = 0 ;
 284 
	    is_fatal = 0;
259 
	    input_error ( "Comma expected" ) ;
 285 
	    input_error("Comma expected");
260 
	    looked_ahead = 1 ;
 286 
	    looked_ahead = 1;
261 
	}
 287 
	}
262 
    }
 288 
    }
263 
 
 289 
 
264 
    /* Declaration = optional access + optional string + shape from 4.0 */
 290 
    /* Declaration = optional access + optional string + shape from 4.0 */
265 
    d = completion ( read_node ( "?[u]?[X]S" ) ) ;
 291 
    d = completion(read_node("?[u]?[X]S"));
266 
    info->var = ( boolean ) is_var ;
 292 
    info->var = (boolean)is_var;
267 
    if ( info->dec ) {
 293 
    if (info->dec) {
268 
	if ( !eq_node ( info->dec, d ) ) {
 294 
	if (!eq_node(info->dec, d)) {
269 
	    is_fatal = 0 ;
 295 
	    is_fatal = 0;
270 
	    input_error ( "Tag %s declared inconsistently", p->name ) ;
 296 
	    input_error("Tag %s declared inconsistently", p->name);
271 
	}
 297 
	}
272 
	free_node ( d ) ;
 298 
	free_node(d);
273 
    } else {
 299 
    } else {
274 
	info->dec = d ;
 300 
	info->dec = d;
275 
    }
 301 
    }
276 
    return ;
 302 
    return;
277 
}
 303 
}
278 
 
 304 
 
279 
 
 305 
 
280 
/*
 306 
/*
281 
    READ A TAG DEFINITION
 307 
    READ A TAG DEFINITION
282 
 
 308 
 
283 
    A tag definition is read from the input file.  Whether it is a
 309 
    A tag definition is read from the input file.  Whether it is a
284 
    variable or an identity is indicated by the is_var flag.
 310 
    variable or an identity is indicated by the is_var flag.
285 
*/
 311 
*/
286 
 
 312 
 
287 
static void read_tagdef
 313 
static void
288 
    PROTO_N ( ( local, is_var ) )
 - 
 
289 
    PROTO_T ( boolean local X int is_var )
 314 
read_tagdef(boolean local, int is_var)
290 
{
 315 
{
291 
    node *d ;
 316 
    node *d;
292 
    construct *p = read_external ( SORT_tag, local ) ;
 317 
    construct *p = read_external(SORT_tag, local);
293 
    tag_info *info = get_tag_info ( p ) ;
 318 
    tag_info *info = get_tag_info(p);
294 
 
 319 
 
295 
    /* Set the tag type */
 320 
    /* Set the tag type */
296 
    if ( info->dec == null && !do_check ) {
 321 
    if (info->dec == null && !do_check) {
297 
	is_fatal = 0 ;
 322 
	is_fatal = 0;
298 
	input_error ( "Tag %s defined but not declared", word ) ;
 323 
	input_error("Tag %s defined but not declared", word);
299 
    }
 324 
    }
300 
    set_tag_type ( p, is_var ) ;
 325 
    set_tag_type(p, is_var);
301 
 
 326 
 
302 
    /* Check comma */
 327 
    /* Check comma */
303 
    if ( func_input ) {
 328 
    if (func_input) {
304 
	read_word () ;
 329 
	read_word();
305 
	if ( word_type != INPUT_COMMA ) {
 330 
	if (word_type != INPUT_COMMA) {
306 
	    is_fatal = 0 ;
 331 
	    is_fatal = 0;
307 
	    input_error ( "Comma expected" ) ;
 332 
	    input_error("Comma expected");
308 
	    looked_ahead = 1 ;
 333 
	    looked_ahead = 1;
309 
	}
 334 
	}
310 
    }
 335 
    }
311 
 
 336 
 
312 
    /* Definition - signature added in 4.0 */
 337 
    /* Definition - signature added in 4.0 */
313 
    d = completion ( read_node ( is_var ? "?[u]?[X]x" : "?[X]x" ) ) ;
 338 
    d = completion(read_node(is_var ? "?[u]?[X]x" : "?[X]x"));
314 
    info->var = ( boolean ) is_var ;
 339 
    info->var = (boolean)is_var;
315 
    if ( info->def ) {
 340 
    if (info->def) {
316 
	if ( is_var == 2 ) {
 341 
	if (is_var == 2) {
317 
	    node *dp = info->def ;
 342 
	    node *dp = info->def;
318 
	    while ( dp->bro ) dp = dp->bro ;
 343 
	    while (dp->bro)dp = dp->bro;
319 
	    dp->bro = d ;
 344 
	    dp->bro = d;
320 
	} else {
 345 
	} else {
321 
	    if ( !eq_node ( info->def, d ) ) {
 346 
	    if (!eq_node(info->def, d)) {
322 
		is_fatal = 0 ;
 347 
		is_fatal = 0;
323 
		input_error ( "Tag %s defined inconsistently", p->name ) ;
 348 
		input_error("Tag %s defined inconsistently", p->name);
324 
	    }
 349 
	    }
325 
	    free_node ( d ) ;
 350 
	    free_node(d);
326 
	}
 351 
	}
327 
    } else {
 352 
    } else {
328 
	info->def = d ;
 353 
	info->def = d;
329 
	if ( do_check ) check_tagdef ( p ) ;
 354 
	if (do_check)check_tagdef(p);
330 
    }
 355 
    }
331 
    return ;
 356 
    return;
332 
}
 357 
}
333 
 
 358 
 
334 
 
 359 
 
335 
/*
 360 
/*
336 
    READ A SORTNAME
 361 
    READ A SORTNAME
337 
 
 362 
 
338 
    A sortname is read from the input file.
 363 
    A sortname is read from the input file.
339 
*/
 364 
*/
340 
 
 365 
 
341 
static sortname read_sortname
 366 
static sortname
342 
    PROTO_Z ()
 367 
read_sortname(void)
343 
{
 368 
{
344 
    sortname s ;
 369 
    sortname s;
345 
    if ( word_type != INPUT_WORD ) {
 370 
    if (word_type != INPUT_WORD) {
346 
	is_fatal = 0 ;
 371 
	is_fatal = 0;
347 
	input_error ( "Sort name expected" ) ;
 372 
	input_error("Sort name expected");
348 
	return ( SORT_unknown ) ;
 373 
	return(SORT_unknown);
349 
    }
 374 
    }
350 
    s = find_high_sort ( word ) ;
 375 
    s = find_high_sort(word);
351 
    if ( s == SORT_unknown ) {
 376 
    if (s == SORT_unknown) {
352 
	is_fatal = 0 ;
 377 
	is_fatal = 0;
353 
	input_error ( "Illegal sort name, %s", word ) ;
 378 
	input_error("Illegal sort name, %s", word);
354 
    } else {
 379 
    } else {
355 
	if ( s > SORT_max && s < SORT_no ) {
 380 
	if (s > SORT_max && s < SORT_no) {
356 
	    is_fatal = 0 ;
 381 
	    is_fatal = 0;
357 
	    input_error ( "Bad sort name, %s", word ) ;
 382 
	    input_error("Bad sort name, %s", word);
358 
	}
 383 
	}
359 
    }
 384 
    }
360 
    return ( s ) ;
 385 
    return(s);
361 
}
 386 
}
362 
 
 387 
 
363 
 
 388 
 
364 
/*
 389 
/*
365 
    READ TOKEN SORT
 390 
    READ TOKEN SORT
Line 367... Line 392...
367 
    A token sort is read and the information is stored in info.  This
 392 
    A token sort is read and the information is stored in info.  This
368 
    can be a definition (with formal parameters) or a declaration
 393 
    can be a definition (with formal parameters) or a declaration
369 
    (without) depending on the value of def.
 394 
    (without) depending on the value of def.
370 
*/
 395 
*/
371 
 
 396 
 
372 
static void read_toksort
 397 
static void
373 
    PROTO_N ( ( info, def ) )
 - 
 
374 
    PROTO_T ( tok_info *info X boolean def )
 398 
read_toksort(tok_info *info, boolean def)
375 
{
 399 
{
376 
    /* Check comma */
 400 
    /* Check comma */
377 
    if ( func_input ) {
 401 
    if (func_input) {
378 
	read_word () ;
 402 
	read_word();
379 
	if ( word_type != INPUT_COMMA ) {
 403 
	if (word_type != INPUT_COMMA) {
380 
	    is_fatal = 0 ;
 404 
	    is_fatal = 0;
381 
	    input_error ( "Comma expected" ) ;
 405 
	    input_error("Comma expected");
382 
	    looked_ahead = 1 ;
 406 
	    looked_ahead = 1;
383 
	}
 407 
	}
384 
    }
 408 
    }
385 
 
 409 
 
386 
    /* Initialize values */
 410 
    /* Initialize values */
387 
    info->res = SORT_unknown ;
 411 
    info->res = SORT_unknown;
388 
    info->args = null ;
 412 
    info->args = null;
389 
    info->pars = null ;
 413 
    info->pars = null;
390 
    info->sig = null ;
 414 
    info->sig = null;
391 
 
 415 
 
392 
    /* Read signature */
 416 
    /* Read signature */
393 
    info->sig = read_node ( "?[X]" ) ;
 417 
    info->sig = read_node("?[X]");
394 
 
 418 
 
395 
    /* Read argument sorts */
 419 
    /* Read argument sorts */
396 
    read_word () ;
 420 
    read_word();
397 
    if ( word_type == INPUT_OPEN ) {
 421 
    if (word_type == INPUT_OPEN) {
398 
	int no_args = 0 ;
 422 
	int no_args = 0;
399 
	char arg_buff [100] ;
 423 
	char arg_buff[100];
400 
	char *a = arg_buff ;
 424 
	char *a = arg_buff;
401 
	construct *cons_buff [100] ;
 425 
	construct *cons_buff[100];
402 
	construct **c = cons_buff ;
 426 
	construct **c = cons_buff;
403 
	while ( read_word (), word_type != INPUT_CLOSE ) {
 427 
	while (read_word(), word_type != INPUT_CLOSE) {
404 
	    sortname s = read_sortname () ;
 428 
	    sortname s = read_sortname();
405 
	    if ( is_high ( s ) ) {
 429 
	    if (is_high(s)) {
406 
		sprint_high_sort ( a, s ) ;
 430 
		sprint_high_sort(a, s);
407 
		while ( *a ) a++ ;
 431 
		while (*a)a++;
408 
	    } else {
 432 
	    } else {
409 
		*( a++ ) = sort_letters [s] ;
 433 
		*(a++) = sort_letters[s];
410 
	    }
 434 
	    }
411 
	    if ( def ) {
 435 
	    if (def) {
412 
		/* Read formal argument */
 436 
		/* Read formal argument */
413 
		construct *q ;
 437 
		construct *q;
414 
		read_word () ;
 438 
		read_word();
415 
		if ( word_type != INPUT_WORD ) {
 439 
		if (word_type != INPUT_WORD) {
416 
		    input_error ( "Token identifier expected" ) ;
 440 
		    input_error("Token identifier expected");
417 
		}
 441 
		}
418 
		q = search_var_hash ( word, SORT_token ) ;
 442 
		q = search_var_hash(word, SORT_token);
419 
		if ( q ) {
 443 
		if (q) {
420 
		    input_error ( "Token %s already declared", word ) ;
 444 
		    input_error("Token %s already declared", word);
421 
		}
 445 
		}
422 
		q = make_construct ( SORT_token ) ;
 446 
		q = make_construct(SORT_token);
423 
		q->name = string_copy_aux ( word ) ;
 447 
		q->name = string_copy_aux(word);
424 
		IGNORE add_to_var_hash ( q, SORT_token ) ;
 448 
		IGNORE add_to_var_hash(q, SORT_token);
425 
		set_token_sort ( q, s, ( char * ) null, ( node * ) null ) ;
 449 
		set_token_sort(q, s,(char *)null,(node *)null);
426 
		*( c++ ) = q ;
 450 
		*(c++) = q;
427 
	    }
 451 
	    }
428 
	    /* Check comma */
 452 
	    /* Check comma */
429 
	    if ( func_input ) {
 453 
	    if (func_input) {
430 
		read_word () ;
 454 
		read_word();
431 
		if ( word_type == INPUT_CLOSE ) {
 455 
		if (word_type == INPUT_CLOSE) {
432 
		    looked_ahead = 1 ;
 456 
		    looked_ahead = 1;
433 
		} else if ( word_type != INPUT_COMMA ) {
 457 
		} else if (word_type != INPUT_COMMA) {
434 
		    is_fatal = 0 ;
 458 
		    is_fatal = 0;
435 
		    input_error ( "Comma or close bracket expected" ) ;
 459 
		    input_error("Comma or close bracket expected");
436 
		    looked_ahead = 1 ;
 460 
		    looked_ahead = 1;
437 
		}
 461 
		}
438 
	    }
 462 
	    }
439 
	    no_args++ ;
 463 
	    no_args++;
440 
	}
 464 
	}
441 
	*a = 0 ;
 465 
	*a = 0;
442 
	if ( *arg_buff ) {
 466 
	if (*arg_buff) {
443 
	    /* Store argument string */
 467 
	    /* Store argument string */
444 
	    info->args = string_copy_aux ( arg_buff ) ;
 468 
	    info->args = string_copy_aux(arg_buff);
445 
	    if ( def ) {
 469 
	    if (def) {
446 
		/* Store formal arguments */
 470 
		/* Store formal arguments */
447 
		int i, n = no_args ;
 471 
		int i, n = no_args;
448 
		info->pars = alloc_nof ( construct *, n + 1 ) ;
 472 
		info->pars = alloc_nof(construct *, n + 1);
449 
		for ( i = 0 ; i < n ; i++ ) info->pars [i] = cons_buff [i] ;
 473 
		for (i = 0; i < n; i++)info->pars[i] = cons_buff[i];
450 
		info->pars [n] = null ;
 474 
		info->pars[n] = null;
451 
	    }
 475 
	    }
452 
	}
 476 
	}
453 
	read_word () ;
 477 
	read_word();
454 
	if ( func_input ) {
 478 
	if (func_input) {
455 
	    if ( word_type != INPUT_ARROW ) {
 479 
	    if (word_type != INPUT_ARROW) {
456 
		is_fatal = 0 ;
 480 
		is_fatal = 0;
457 
		input_error ( "Arrow (->) expected" ) ;
 481 
		input_error("Arrow (->) expected");
458 
		looked_ahead = 1 ;
 482 
		looked_ahead = 1;
459 
	    }
 483 
	    }
460 
	    read_word () ;
 484 
	    read_word();
461 
	}
 485 
	}
462 
    }
 486 
    }
463 
 
 487 
 
464 
    /* Read result sort */
 488 
    /* Read result sort */
465 
    info->res = read_sortname () ;
 489 
    info->res = read_sortname();
466 
    if ( is_high ( info->res ) ) {
 490 
    if (is_high(info->res)) {
467 
	input_error ( "Tokens cannot return high-level sorts" ) ;
 491 
	input_error("Tokens cannot return high-level sorts");
468 
    }
 492 
    }
469 
    return ;
 493 
    return;
470 
}
 494 
}
471 
 
 495 
 
472 
 
 496 
 
473 
/*
 497 
/*
474 
    READ A TOKEN DECLARATION
 498 
    READ A TOKEN DECLARATION
475 
 
 499 
 
476 
    A token declaration is read from the input file.
 500 
    A token declaration is read from the input file.
477 
*/
 501 
*/
478 
 
 502 
 
479 
static void read_tokdec
 503 
static void
480 
    PROTO_N ( ( local ) )
 - 
 
481 
    PROTO_T ( boolean local )
 504 
read_tokdec(boolean local)
482 
{
 505 
{
483 
    tok_info store ;
 506 
    tok_info store;
484 
    construct *p = read_external ( SORT_token, local ) ;
 507 
    construct *p = read_external(SORT_token, local);
485 
    tok_info *info = get_tok_info ( p ) ;
 508 
    tok_info *info = get_tok_info(p);
486 
 
 509 
 
487 
    /* Get token sort */
 510 
    /* Get token sort */
488 
    adjust_token ( p ) ;
 511 
    adjust_token(p);
489 
    read_toksort ( &store, 0 ) ;
 512 
    read_toksort(&store, 0);
490 
    info->dec = 1 ;
 513 
    info->dec = 1;
491 
    set_token_sort ( p, store.res, store.args, store.sig ) ;
 514 
    set_token_sort(p, store.res, store.args, store.sig);
492 
    return ;
 515 
    return;
493 
}
 516 
}
494 
 
 517 
 
495 
 
 518 
 
496 
/*
 519 
/*
497 
    READ A TOKEN DEFINITION
 520 
    READ A TOKEN DEFINITION
498 
 
 521 
 
499 
    A token definition is read from the input file.
 522 
    A token definition is read from the input file.
500 
*/
 523 
*/
501 
 
 524 
 
502 
static void read_tokdef
 525 
static void
503 
    PROTO_N ( ( local ) )
 - 
 
504 
    PROTO_T ( boolean local )
 526 
read_tokdef(boolean local)
505 
{
 527 
{
506 
    node *d ;
 528 
    node *d;
507 
    char buff [2] ;
 529 
    char buff[2];
508 
    tok_info store ;
 530 
    tok_info store;
509 
    construct *p = read_external ( SORT_token, local ) ;
 531 
    construct *p = read_external(SORT_token, local);
510 
    tok_info *info = get_tok_info ( p ) ;
 532 
    tok_info *info = get_tok_info(p);
511 
    construct **old_pars = info->pars ;
 533 
    construct **old_pars = info->pars;
512 
 
 534 
 
513 
    /* Get token sort */
 535 
    /* Get token sort */
514 
    adjust_token ( p ) ;
 536 
    adjust_token(p);
515 
    read_toksort ( &store, 1 ) ;
 537 
    read_toksort(&store, 1);
516 
    info->dec = 1 ;
 538 
    info->dec = 1;
517 
    info->pars = store.pars ;
 539 
    info->pars = store.pars;
518 
    set_token_sort ( p, store.res, store.args, store.sig ) ;
 540 
    set_token_sort(p, store.res, store.args, store.sig);
519 
 
 541 
 
520 
    /* Check comma */
 542 
    /* Check comma */
521 
    if ( func_input ) {
 543 
    if (func_input) {
522 
	read_word () ;
 544 
	read_word();
523 
	if ( word_type != INPUT_COMMA ) {
 545 
	if (word_type != INPUT_COMMA) {
524 
	    is_fatal = 0 ;
 546 
	    is_fatal = 0;
525 
	    input_error ( "Comma expected" ) ;
 547 
	    input_error("Comma expected");
526 
	    looked_ahead = 1 ;
 548 
	    looked_ahead = 1;
527 
	}
 549 
	}
528 
    }
 550 
    }
529 
 
 551 
 
530 
    /* Read the definition */
 552 
    /* Read the definition */
531 
    buff [0] = sort_letters [ store.res ] ;
 553 
    buff[0] = sort_letters[store.res];
532 
    buff [1] = 0 ;
 554 
    buff[1] = 0;
533 
    d = read_node ( buff ) ;
 555 
    d = read_node(buff);
534 
 
 556 
 
535 
    /* Free formal parameters */
 557 
    /* Free formal parameters */
536 
    if ( info->pars ) {
 558 
    if (info->pars) {
537 
	construct **ps ;
 559 
	construct **ps;
538 
	for ( ps = info->pars ; *ps ; ps++ ) {
 560 
	for (ps = info->pars; *ps; ps++) {
539 
	    remove_var_hash ( ( *ps )->name, SORT_token ) ;
 561 
	    remove_var_hash((*ps) ->name, SORT_token);
540 
	}
 562 
	}
541 
    }
 563 
    }
542 
 
 564 
 
543 
    /* Check consistency */
 565 
    /* Check consistency */
544 
    d = completion ( d ) ;
 566 
    d = completion(d);
545 
    if ( info->def ) {
 567 
    if (info->def) {
546 
	if ( !eq_node ( info->def, d ) ) {
 568 
	if (!eq_node(info->def, d)) {
547 
	    is_fatal = 0 ;
 569 
	    is_fatal = 0;
548 
	    input_error ( "Token %s defined inconsistently", p->name ) ;
 570 
	    input_error("Token %s defined inconsistently", p->name);
549 
	}
 571 
	}
550 
	free_node ( d ) ;
 572 
	free_node(d);
551 
	info->pars = old_pars ;
 573 
	info->pars = old_pars;
552 
    } else {
 574 
    } else {
553 
	info->def = d ;
 575 
	info->def = d;
554 
    }
 576 
    }
555 
    return ;
 577 
    return;
556 
}
 578 
}
557 
 
 579 
 
558 
 
 580 
 
559 
/*
 581 
/*
560 
    READ A TOKEN SORT DEFINITION
 582 
    READ A TOKEN SORT DEFINITION
561 
 
 583 
 
562 
    A token sort defintion is read from the input file.
 584 
    A token sort defintion is read from the input file.
563 
*/
 585 
*/
564 
 
 586 
 
565 
static void read_sortdef
 587 
static void
566 
    PROTO_N ( ( local ) )
 - 
 
567 
    PROTO_T ( boolean local )
 588 
read_sortdef(boolean local)
568 
{
 589 
{
569 
    char *nm ;
 590 
    char *nm;
570 
    tok_info store ;
 591 
    tok_info store;
571 
 
 592 
 
572 
    /* The local quantifier should not be used */
 593 
    /* The local quantifier should not be used */
573 
    if ( local ) {
 594 
    if (local) {
574 
	is_fatal = 0 ;
 595 
	is_fatal = 0;
575 
	input_error ( "Can't have local here" ) ;
 596 
	input_error("Can't have local here");
576 
    }
 597 
    }
577 
 
 598 
 
578 
    /* Read the sort name */
 599 
    /* Read the sort name */
579 
    read_word () ;
 600 
    read_word();
580 
    if ( word_type != INPUT_WORD ) input_error ( "Identifier expected" ) ;
 601 
    if (word_type != INPUT_WORD)input_error("Identifier expected");
581 
    nm = string_copy_aux ( word ) ;
 602 
    nm = string_copy_aux(word);
582 
 
 603 
 
583 
    /* Get sort definition */
 604 
    /* Get sort definition */
584 
    read_toksort ( &store, 0 ) ;
 605 
    read_toksort(&store, 0);
585 
    set_high_sort ( nm, &store ) ;
 606 
    set_high_sort(nm, &store);
586 
    return ;
 607 
    return;
587 
}
 608 
}
588 
 
 609 
 
589 
 
 610 
 
590 
/*
 611 
/*
591 
    READ A SUBFILE
 612 
    READ A SUBFILE
Line 593... Line 614...
593 
    A complete subfile is read.  ftype gives the type of the subfile :
 614 
    A complete subfile is read.  ftype gives the type of the subfile :
594 
    0 = text, 1 = capsule, 2 = library.  ex is true to indicate that
 615 
    0 = text, 1 = capsule, 2 = library.  ex is true to indicate that
595 
    only the tokens should be read.
 616 
    only the tokens should be read.
596 
*/
 617 
*/
597 
 
 618 
 
598 
static void sub_file
 619 
static void
599 
    PROTO_N ( ( ftype, ex ) )
 - 
 
600 
    PROTO_T ( int ftype X int ex )
 620 
sub_file(int ftype, int ex)
601 
{
 621 
{
602 
    position store ;
 622 
    position store;
603 
    boolean old_func_input = func_input ;
 623 
    boolean old_func_input = func_input;
604 
    char *old_name = input_file, *new_name ;
 624 
    char *old_name = input_file, *new_name;
605 
 
 625 
 
606 
    /* Read the file name */
 626 
    /* Read the file name */
607 
    allow_multibyte = 0 ;
 627 
    allow_multibyte = 0;
608 
    read_word () ;
 628 
    read_word();
609 
    allow_multibyte = 1 ;
 629 
    allow_multibyte = 1;
610 
    if ( word_type != INPUT_STRING ) {
 630 
    if (word_type != INPUT_STRING) {
611 
	is_fatal = 0 ;
 631 
	is_fatal = 0;
612 
	input_error ( "File name expected" ) ;
 632 
	input_error("File name expected");
613 
	return ;
 633 
	return;
614 
    }
 634 
    }
615 
    new_name = string_copy_aux ( word ) ;
 635 
    new_name = string_copy_aux(word);
616 
 
 636 
 
617 
    /* Save the position in the existing file */
 637 
    /* Save the position in the existing file */
618 
    store_position ( &store ) ;
 638 
    store_position(&store);
619 
 
 639 
 
620 
    /* Read the subfile */
 640 
    /* Read the subfile */
621 
    text_input = ( boolean ) ( ftype == 0 ? 1 : 0 ) ;
 641 
    text_input = (boolean)(ftype == 0 ? 1 : 0);
622 
    open_input ( new_name, 1 ) ;
 642 
    open_input(new_name, 1);
623 
    if ( ftype == 0 ) {
 643 
    if (ftype == 0) {
624 
	read_capsule () ;
 644 
	read_capsule();
625 
    } else {
 645 
    } else {
626 
	extract_tokdecs = ( boolean ) ex ;
 646 
	extract_tokdecs = (boolean)ex;
627 
	if ( ftype == 1 ) {
 647 
	if (ftype == 1) {
628 
	    de_capsule () ;
 648 
	    de_capsule();
629 
	} else {
 649 
	} else {
630 
	    de_library () ;
 650 
	    de_library();
631 
	}
 651 
	}
632 
	extract_tokdecs = 0 ;
 652 
	extract_tokdecs = 0;
633 
    }
 653 
    }
634 
 
 654 
 
635 
    /* Restore the position in the old file */
 655 
    /* Restore the position in the old file */
636 
    text_input = 1 ;
 656 
    text_input = 1;
637 
    open_input ( old_name, 1 ) ;
 657 
    open_input(old_name, 1);
638 
    set_position ( &store ) ;
 658 
    set_position(&store);
639 
    func_input = old_func_input ;
 659 
    func_input = old_func_input;
640 
    return ;
 660 
    return;
641 
}
 661 
}
642 
 
 662 
 
643 
 
 663 
 
644 
/*
 664 
/*
645 
    READ A CAPSULE
 665 
    READ A CAPSULE
646 
 
 666 
 
647 
    A complete capsule is read from the input file.
 667 
    A complete capsule is read from the input file.
648 
*/
 668 
*/
649 
 
 669 
 
650 
void read_capsule
 670 
void
651 
    PROTO_Z ()
 671 
read_capsule(void)
652 
{
 672 
{
653 
    int starter ;
 673 
    int starter;
654 
    read_word () ;
 674 
    read_word();
655 
    if ( word_type == INPUT_OPEN ) {
 675 
    if (word_type == INPUT_OPEN) {
656 
	if ( func_input ) warning ( "Switching input form" ) ;
 676 
	if (func_input)warning("Switching input form");
657 
	func_input = 0 ;
 677 
	func_input = 0;
658 
	starter = INPUT_OPEN ;
 678 
	starter = INPUT_OPEN;
659 
    } else {
 679 
    } else {
660 
	if ( !func_input ) warning ( "Switching input form" ) ;
 680 
	if (!func_input)warning("Switching input form");
661 
	func_input = 1 ;
 681 
	func_input = 1;
662 
	starter = INPUT_WORD ;
 682 
	starter = INPUT_WORD;
663 
    }
 683 
    }
664 
    looked_ahead = 1 ;
 684 
    looked_ahead = 1;
665 
 
 685 
 
666 
    while ( read_word (), word_type == starter ) {
 686 
    while (read_word(), word_type == starter) {
667 
	char *cmd ;
 687 
	char *cmd;
668 
	char *wtemp ;
 688 
	char *wtemp;
669 
	boolean local = 0 ;
 689 
	boolean local = 0;
670 
	if ( !func_input ) {
 690 
	if (!func_input) {
671 
	    read_word () ;
 691 
	    read_word();
672 
	    if ( word_type != INPUT_WORD ) {
 692 
	    if (word_type != INPUT_WORD) {
673 
		input_error ( "Construct name expected" ) ;
 693 
		input_error("Construct name expected");
674 
	    }
 694 
	    }
675 
	}
 695 
	}
676 
 
 696 
 
677 
	/* Check for the local qualifier */
 697 
	/* Check for the local qualifier */
678 
	if ( streq ( word, LOCAL_DECL ) ) {
 698 
	if (streq(word, LOCAL_DECL)) {
679 
	    local = 1 ;
 699 
	    local = 1;
680 
	    read_word () ;
 700 
	    read_word();
681 
	    if ( word_type != INPUT_WORD ) {
 701 
	    if (word_type != INPUT_WORD) {
682 
		input_error ( "Construct name expected" ) ;
 702 
		input_error("Construct name expected");
683 
	    }
 703 
	    }
684 
	}
 704 
	}
685 
 
 705 
 
686 
	/* For functional input, expect an open bracket */
 706 
	/* For functional input, expect an open bracket */
687 
	if ( func_input ) {
 707 
	if (func_input) {
688 
	    wtemp = temp_copy ( word ) ;
 708 
	    wtemp = temp_copy(word);
689 
	    read_word () ;
 709 
	    read_word();
690 
	    if ( word_type != INPUT_OPEN ) {
 710 
	    if (word_type != INPUT_OPEN) {
691 
		is_fatal = 0 ;
 711 
		is_fatal = 0;
692 
		input_error ( "Open bracket expected" ) ;
 712 
		input_error("Open bracket expected");
693 
		looked_ahead = 1 ;
 713 
		looked_ahead = 1;
694 
	    }
 714 
	    }
695 
	} else {
 715 
	} else {
696 
	    wtemp = word ;
 716 
	    wtemp = word;
697 
	}
 717 
	}
698 
 
 718 
 
699 
	/* Macro to aid checking */
 719 
	/* Macro to aid checking */
700 
#define test_cmd( X, Y )\
 720 
#define test_cmd(X, Y)\
701 
	if ( streq ( wtemp, cmd = ( X ) ) ) {\
 721 
	if (streq(wtemp, cmd = (X))) {\
702 
	    Y ;\
 722 
	    Y ;\
703 
	} else
 723 
	} else
704 
 
 724 
 
705 
	/* Check on the various possible constructs */
 725 
	/* Check on the various possible constructs */
706 
	test_cmd ( MAKE_ALDEC, read_aldec ( local ) )
 726 
	test_cmd(MAKE_ALDEC, read_aldec(local))
707 
	test_cmd ( MAKE_ALDEF, read_aldef ( local ) )
 727 
	test_cmd(MAKE_ALDEF, read_aldef(local))
708 
	test_cmd ( MAKE_ID_TAGDEC, read_tagdec ( local, 0 ) )
 728 
	test_cmd(MAKE_ID_TAGDEC, read_tagdec(local, 0))
709 
	test_cmd ( MAKE_VAR_TAGDEC, read_tagdec ( local, 1 ) )
 729 
	test_cmd(MAKE_VAR_TAGDEC, read_tagdec(local, 1))
710 
	test_cmd ( MAKE_ID_TAGDEF, read_tagdef ( local, 0 ) )
 730 
	test_cmd(MAKE_ID_TAGDEF, read_tagdef(local, 0))
711 
	test_cmd ( MAKE_VAR_TAGDEF, read_tagdef ( local, 1 ) )
 731 
	test_cmd(MAKE_VAR_TAGDEF, read_tagdef(local, 1))
712 
	test_cmd ( MAKE_TOKDEC, read_tokdec ( local ) )
 732 
	test_cmd(MAKE_TOKDEC, read_tokdec(local))
713 
	test_cmd ( MAKE_TOKDEF, read_tokdef ( local ) )
 733 
	test_cmd(MAKE_TOKDEF, read_tokdef(local))
714 
	test_cmd ( COMMON_TAGDEC, read_tagdec ( local, 2 ) )
 734 
	test_cmd(COMMON_TAGDEC, read_tagdec(local, 2))
715 
	test_cmd ( COMMON_TAGDEF, read_tagdef ( local, 2 ) )
 735 
	test_cmd(COMMON_TAGDEF, read_tagdef(local, 2))
716 
	test_cmd ( MAKE_SORT, read_sortdef ( local ) )
 736 
	test_cmd(MAKE_SORT, read_sortdef(local))
717 
 
 737 
 
718 
	{
 738 
	{
719 
	    /* Include constructs */
 739 
	    /* Include constructs */
720 
	    if ( local ) {
 740 
	    if (local) {
721 
		is_fatal = 0 ;
 741 
		is_fatal = 0;
722 
		input_error ( "Can't have local here" ) ;
 742 
		input_error("Can't have local here");
723 
	    }
 743 
	    }
724 
	    test_cmd ( INCLUDE_TEXT, sub_file ( 0, 0 ) )
 744 
	    test_cmd(INCLUDE_TEXT, sub_file(0, 0))
725 
	    test_cmd ( INCLUDE_CODE, sub_file ( 1, 0 ) )
 745 
	    test_cmd(INCLUDE_CODE, sub_file(1, 0))
726 
	    test_cmd ( USE_CODE, sub_file ( 1, 1 ) )
 746 
	    test_cmd(USE_CODE, sub_file(1, 1))
727 
	    test_cmd ( INCLUDE_LIB, sub_file ( 2, 0 ) )
 747 
	    test_cmd(INCLUDE_LIB, sub_file(2, 0))
728 
	    test_cmd ( USE_LIB, sub_file ( 2, 1 ) )
 748 
	    test_cmd(USE_LIB, sub_file(2, 1))
729 
	    {
 749 
	    {
730 
		/* Illegal construct */
 750 
		/* Illegal construct */
731 
		input_error ( "Illegal construct name, %s", wtemp ) ;
 751 
		input_error("Illegal construct name, %s", wtemp);
732 
	    }
 752 
	    }
733 
	}
 753 
	}
734 
 
 754 
 
735 
	/* End of construct */
 755 
	/* End of construct */
736 
	read_word () ;
 756 
	read_word();
737 
	if ( word_type != INPUT_CLOSE ) {
 757 
	if (word_type != INPUT_CLOSE) {
738 
	    is_fatal = 0 ;
 758 
	    is_fatal = 0;
739 
	    input_error ( "End of %s construct expected", cmd ) ;
 759 
	    input_error("End of %s construct expected", cmd);
740 
	    looked_ahead = 1 ;
 760 
	    looked_ahead = 1;
741 
	}
 761 
	}
742 
	if ( func_input ) {
 762 
	if (func_input) {
743 
	    read_word () ;
 763 
	    read_word();
744 
	    if ( word_type != INPUT_SEMICOLON ) {
 764 
	    if (word_type != INPUT_SEMICOLON) {
745 
		is_fatal = 0 ;
 765 
		is_fatal = 0;
746 
		input_error ( "End of %s construct expected", cmd ) ;
 766 
		input_error("End of %s construct expected", cmd);
747 
		looked_ahead = 1 ;
 767 
		looked_ahead = 1;
748 
	    }
 768 
	    }
749 
	}
 769 
	}
750 
    }
 770 
    }
751 
    if ( word_type != INPUT_EOF ) {
 771 
    if (word_type != INPUT_EOF) {
752 
	is_fatal = 0 ;
 772 
	is_fatal = 0;
753 
	input_error ( "Start of construct expected" ) ;
 773 
	input_error("Start of construct expected");
754 
    }
 774 
    }
755 
    return ;
 775 
    return;
756 
}
 776 
}