Subversion Repositories tendra.SVN

Rev

Rev 2 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1 
/*
2 
    		 Crown Copyright (c) 1997
3 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
6 
    acting through the Defence Evaluation and Research Agency
7 
    (DERA).  It is made available to Recipients with a
8 
    royalty-free licence for its use, reproduction, transfer
9 
    to other parties and amendment for any purpose not excluding
10 
    product development provided that any such use et cetera
11 
    shall be deemed to be acceptance of the following conditions:-
12 
 
13 
        (1) Its Recipients shall ensure that this Notice is
14 
        reproduced upon any copies or amended versions of it;
15 
 
16 
        (2) Any amended version of it shall be clearly marked to
17 
        show both the nature of and the organisation responsible
18 
        for the relevant amendment or amendments;
19 
 
20 
        (3) Its onward transfer from a recipient to another
21 
        party shall be deemed to be that party's acceptance of
22 
        these conditions;
23 
 
24 
        (4) DERA gives no warranty or assurance as to its
25 
        quality or suitability for any purpose and DERA accepts
26 
        no liability whatsoever in relation to any use to which
27 
        it may be put.
28 
*/
29 
 
30 
 
31 
#include "config.h"
32 
#include "tdf.h"
33 
#include "cmd_ops.h"
34 
#include "cons_ops.h"
35 
#include "info_ops.h"
36 
#include "link_ops.h"
37 
#include "par_ops.h"
38 
#include "sort_ops.h"
39 
#include "spec_ops.h"
40 
#include "error.h"
41 
#include "input.h"
42 
#include "lex.h"
43 
#include "output.h"
44 
 
45 
 
46 
/*
47 
    DO THE INITIAL SEGMENTS OF TWO STRINGS MATCH
48 
 
49 
    This macro gives a convenient method for testing whether the first
50 
    C characters of the strings A and B are equal.
51 
*/
52 
 
53 
#define strneq( A, B, C )\
54 
	( strncmp ( ( A ), ( B ), ( size_t ) ( C ) ) == 0 )
55 
 
56 
 
57 
/*
58 
    CURRENT OUTPUT FILE
59 
 
60 
    These variables describe the current output file.
61 
*/
62 
 
63 
static FILE *output_file ;
64 
static char output_buff [512] ;
65 
static int output_posn = 0 ;
66 
static unsigned crt_column = 0 ;
67 
 
68 
 
69 
/*
70 
    CURRENT LOOP VARIABLES
71 
 
72 
    These variables keep track of the current state of the various
73 
    output loops.
74 
*/
75 
 
76 
static unsigned crt_major = 0 ;
77 
static unsigned crt_minor = 0 ;
78 
static int crt_unique = 0 ;
79 
static SORT crt_sort = NULL_sort ;
80 
static SORT_INFO crt_info = NULL_info ;
81 
static CONSTRUCT crt_cons = NULL_cons ;
82 
static PARAMETER crt_param = NULL_par ;
83 
static int crt_param_no = 0 ;
84 
static int last_param_no = 0 ;
85 
 
86 
 
87 
/*
88 
    PRINT A CHARACTER TO THE OUTPUT FILE
89 
 
90 
    This routine prints the character c to the output file updating the
91 
    current column number.
92 
*/
93 
 
94 
static void output_char
95 
    PROTO_N ( ( c ) )
96 
    PROTO_T ( int c )
97 
{
98 
    int i = output_posn ;
99 
    output_buff [i] = ( char ) c ;
100 
    if ( ++i >= 500 || c == '\n' ) {
101 
	output_buff [i] = 0 ;
102 
	IGNORE fputs ( output_buff, output_file ) ;
103 
	i = 0 ;
104 
    }
105 
    if ( c == '\n' ) {
106 
	crt_column = 0 ;
107 
    } else if ( c == '\t' ) {
108 
	crt_column = 8 * ( crt_column / 8 + 1 ) ;
109 
    } else {
110 
	crt_column++ ;
111 
    }
112 
    output_posn = i ;
113 
    return ;
114 
}
115 
 
116 
 
117 
/*
118 
    PRINT A STRING TO THE OUTPUT FILE
119 
 
120 
    This routine prints the string s to the output file.
121 
*/
122 
 
123 
static void output_string
124 
    PROTO_N ( ( s ) )
125 
    PROTO_T ( char *s )
126 
{
127 
    char c ;
128 
    while ( c = *( s++ ), c != 0 ) {
129 
	output_char ( ( int ) c ) ;
130 
    }
131 
    return ;
132 
}
133 
 
134 
 
135 
/*
136 
    OUTPUT AN ENCODING STRING FOR A CONSTRUCT
137 
 
138 
    This routine writes the encoding strings for the parameter sorts of
139 
    the construct cons to the output file.
140 
*/
141 
 
142 
static void output_cons
143 
    PROTO_N ( ( cons, intro ) )
144 
    PROTO_T ( CONSTRUCT cons X int intro )
145 
{
146 
    int c ;
147 
    int brks = 0 ;
148 
    unsigned kind = DEREF_unsigned ( cons_kind ( cons ) ) ;
149 
    LIST ( PARAMETER ) p = DEREF_list ( cons_pars ( cons ) ) ;
150 
    while ( !IS_NULL_list ( p ) ) {
151 
	PARAMETER par = DEREF_par ( HEAD_list ( p ) ) ;
152 
	SORT sort = DEREF_sort ( par_type ( par ) ) ;
153 
	int align = DEREF_int ( par_align ( par ) ) ;
154 
	int brk = DEREF_int ( par_brk ( par ) ) ;
155 
	int intro2 = DEREF_int ( par_intro ( par ) ) ;
156 
	if ( align ) output_char ( '|' ) ;
157 
	if ( brk ) output_char ( '{' ) ;
158 
	if ( intro2 ) intro = 1 ;
159 
	c = output_sort ( sort, intro ) ;
160 
	if ( c == '@' && kind == KIND_cond ) {
161 
	    /* Conditional construct */
162 
	    output_char ( '[' ) ;
163 
	    sort = DEREF_sort ( cons_res ( cons ) ) ;
164 
	    IGNORE output_sort ( sort, intro ) ;
165 
	    output_char ( ']' ) ;
166 
	}
167 
	brks += brk ;
168 
	p = TAIL_list ( p ) ;
169 
    }
170 
    while ( brks-- ) output_char ( '}' ) ;
171 
    return ;
172 
}
173 
 
174 
 
175 
/*
176 
    OUTPUT AN ENCODING STRING FOR A SORT
177 
 
178 
    Every basic and built-in type has an associated code letter.  This,
179 
    together with various control characters for lists and optional sorts,
180 
    allows every sort to be expressed as a sequence of characters.  This
181 
    routine prints this encoding string for the sort sort to the output
182 
    file
183 
*/
184 
 
185 
int output_sort
186 
    PROTO_N ( ( sort, intro ) )
187 
    PROTO_T ( SORT sort X int intro )
188 
{
189 
    int c = DEREF_int ( sort_code ( sort ) ) ;
190 
    SORT_INFO info = DEREF_info ( sort_info ( sort ) ) ;
191 
    if ( !IS_NULL_info ( info ) ) {
192 
	switch ( TAG_info ( info ) ) {
193 
	    case info_builtin_tag :
194 
	    case info_basic_tag : {
195 
		if ( c < 32 ) {
196 
		    char buff [10] ;
197 
		    sprintf_v ( buff, "\\%03o", ( unsigned ) c ) ;
198 
		    output_string ( buff ) ;
199 
		} else {
200 
		    output_char ( c ) ;
201 
		}
202 
		if ( intro ) {
203 
		    int edge = DEREF_int ( sort_edge ( sort ) ) ;
204 
		    if ( edge ) output_char ( '&' ) ;
205 
		}
206 
		break ;
207 
	    }
208 
	    case info_dummy_tag : {
209 
		CONSTRUCT cons = DEREF_cons ( info_dummy_cons ( info ) ) ;
210 
		output_cons ( cons, intro ) ;
211 
		break ;
212 
	    }
213 
	    case info_clist_tag :
214 
	    case info_slist_tag :
215 
	    case info_option_tag : {
216 
		sort = DEREF_sort ( info_clist_etc_arg ( info ) ) ;
217 
		output_char ( c ) ;
218 
		output_char ( '[' ) ;
219 
		IGNORE output_sort ( sort, intro ) ;
220 
		output_char ( ']' ) ;
221 
		break ;
222 
	    }
223 
	}
224 
    }
225 
    return ( c ) ;
226 
}
227 
 
228 
 
229 
/*
230 
    OUTPUT A FORMAT STRING
231 
 
232 
    This routine writes the format string s to the output file.
233 
*/
234 
 
235 
static void output
236 
    PROTO_N ( ( s ) )
237 
    PROTO_T ( string s )
238 
{
239 
    char c ;
240 
    while ( c = *( s++ ), c != 0 ) {
241 
	if ( c == '%' ) {
242 
	    char *s0 = s ;
243 
	    int prec = 100 ;
244 
	    char buff [120] ;
245 
	    int have_prec = 0 ;
246 
	    SORT cs = crt_sort ;
247 
	    SORT_INFO ci = crt_info ;
248 
	    CONSTRUCT cc = crt_cons ;
249 
	    PARAMETER cp = crt_param ;
250 
	    c = *( s++ ) ;
251 
	    if ( c >= '0' && c <= '9' ) {
252 
		/* Read precision */
253 
		prec = ( int ) ( c - '0' ) ;
254 
		while ( c = *( s++ ), ( c >= '0' && c <= '9' ) ) {
255 
		    prec = 10 * prec + ( int ) ( c - '0' ) ;
256 
		}
257 
		have_prec = 1 ;
258 
	    }
259 
	    switch ( c ) {
260 
 
261 
		case 'C' :
262 
		cons_format : {
263 
		    /* Construct information */
264 
		    if ( IS_NULL_cons ( cc ) ) goto misplaced_arg ;
265 
		    c = *( s++ ) ;
266 
		    switch ( c ) {
267 
			case 'N' : {
268 
			    /* '%CN' -> construct name */
269 
			    string nm = DEREF_string ( cons_name ( cc ) ) ;
270 
			    sprintf_v ( buff, "%.*s", prec, nm ) ;
271 
			    output_string ( buff ) ;
272 
			    break ;
273 
			}
274 
			case 'E' : {
275 
			    /* '%CE' -> construct encoding */
276 
			    unsigned e ;
277 
			    e = DEREF_unsigned ( cons_encode ( cc ) ) ;
278 
			    sprintf_v ( buff, "%u", e ) ;
279 
			    output_string ( buff ) ;
280 
			    break ;
281 
			}
282 
			case 'S' : {
283 
			    /* '%CS' -> construct result sort */
284 
			    goto sort_format ;
285 
			}
286 
			case 'X' : {
287 
			    /* '%CX' -> construct encoding string */
288 
			    output_cons ( cc, 0 ) ;
289 
			    break ;
290 
			}
291 
			default : {
292 
			    goto bad_format ;
293 
			}
294 
		    }
295 
		    break ;
296 
		}
297 
 
298 
		case 'P' : {
299 
		    /* Parameter information */
300 
		    if ( IS_NULL_par ( cp ) ) goto misplaced_arg ;
301 
		    c = *( s++ ) ;
302 
		    if ( c == 'N' ) {
303 
			/* '%PN' -> parameter name */
304 
			string nm = DEREF_string ( par_name ( cp ) ) ;
305 
			sprintf_v ( buff, "%.*s", prec, nm ) ;
306 
			output_string ( buff ) ;
307 
		    } else if ( c == 'S' ) {
308 
			/* '%PS' -> parameter sort */
309 
			cs = DEREF_sort ( par_type ( cp ) ) ;
310 
			ci = DEREF_info ( sort_info ( cs ) ) ;
311 
			goto sort_format ;
312 
		    } else if ( c == 'E' ) {
313 
			/* '%PE' -> parameter number */
314 
			sprintf_v ( buff, "%d", crt_param_no ) ;
315 
			output_string ( buff ) ;
316 
		    } else {
317 
			goto bad_format ;
318 
		    }
319 
		    break ;
320 
		}
321 
 
322 
		case 'S' :
323 
		sort_format : {
324 
		    /* Sort information */
325 
		    if ( IS_NULL_info ( ci ) ) goto misplaced_arg ;
326 
		    c = *( s++ ) ;
327 
		    switch ( c ) {
328 
			case 'N' : {
329 
			    /* '%SN' -> sort name */
330 
			    string nm = DEREF_string ( sort_name ( cs ) ) ;
331 
			    sprintf_v ( buff, "%.*s", prec, nm ) ;
332 
			    output_string ( buff ) ;
333 
			    break ;
334 
			}
335 
			case 'T' : {
336 
			    /* '%ST' -> sort name in capitals */
337 
			    string nm = DEREF_string ( sort_caps ( cs ) ) ;
338 
			    sprintf_v ( buff, "%.*s", prec, nm ) ;
339 
			    output_string ( buff ) ;
340 
			    break ;
341 
			}
342 
			case 'L' : {
343 
			    /* '%SL' -> sort unit name */
344 
			    string nm = DEREF_string ( sort_link ( cs ) ) ;
345 
			    if ( nm ) {
346 
				sprintf_v ( buff, "%.*s", prec, nm ) ;
347 
				output_string ( buff ) ;
348 
			    }
349 
			    break ;
350 
			}
351 
			case 'U' : {
352 
			    /* '%SU' -> sort unit name */
353 
			    string nm = DEREF_string ( sort_unit ( cs ) ) ;
354 
			    if ( nm ) {
355 
				sprintf_v ( buff, "%.*s", prec, nm ) ;
356 
				output_string ( buff ) ;
357 
			    }
358 
			    break ;
359 
			}
360 
			case 'B' : {
361 
			    /* '%SB' -> bits in encoding */
362 
			    unsigned b = 0 ;
363 
			    if ( IS_info_basic ( ci ) ) {
364 
				b = DEREF_unsigned ( info_basic_bits ( ci ) ) ;
365 
			    }
366 
			    sprintf_v ( buff, "%u", b ) ;
367 
			    output_string ( buff ) ;
368 
			    break ;
369 
			}
370 
			case 'E' : {
371 
			    /* '%SE' -> extended encoding */
372 
			    unsigned e = 0 ;
373 
			    if ( IS_info_basic ( ci ) ) {
374 
				e = DEREF_unsigned ( info_basic_extend ( ci ) ) ;
375 
			    }
376 
			    sprintf_v ( buff, "%u", e ) ;
377 
			    output_string ( buff ) ;
378 
			    break ;
379 
			}
380 
			case 'M' : {
381 
			    /* '%SM' -> maximum encoding */
382 
			    unsigned m = 0 ;
383 
			    if ( IS_info_basic ( ci ) ) {
384 
				m = DEREF_unsigned ( info_basic_max ( ci ) ) ;
385 
			    }
386 
			    if ( have_prec ) m += ( unsigned ) prec ;
387 
			    sprintf_v ( buff, "%u", m ) ;
388 
			    output_string ( buff ) ;
389 
			    break ;
390 
			}
391 
			case 'C' : {
392 
			    /* '%SC' -> sortname information */
393 
			    cc = NULL_cons ;
394 
			    if ( IS_info_basic ( ci ) ) {
395 
				cc = DEREF_cons ( info_basic_sortname ( ci ) ) ;
396 
			    }
397 
			    goto cons_format ;
398 
			}
399 
			case 'S' : {
400 
			    /* '%SS' -> subsort information */
401 
			    if ( IS_info_clist_etc ( ci ) ) {
402 
				cs = DEREF_sort ( info_clist_etc_arg ( ci ) ) ;
403 
				ci = DEREF_info ( sort_info ( cs ) ) ;
404 
			    }
405 
			    goto sort_format ;
406 
			}
407 
			case 'X' : {
408 
			    /* '%SX' -> construct encoding string */
409 
			    IGNORE output_sort ( cs, 0 ) ;
410 
			    break ;
411 
			}
412 
			default : {
413 
			    goto bad_format ;
414 
			}
415 
		    }
416 
		    break ;
417 
		}
418 
 
419 
		case 'V' : {
420 
		    c = *( s++ ) ;
421 
		    if ( c == 'A' ) {
422 
			/* '%VA' -> major version number */
423 
			sprintf_v ( buff, "%u", crt_major ) ;
424 
			output_string ( buff ) ;
425 
		    } else if ( c == 'B' ) {
426 
			/* '%VB' -> minor version number */
427 
			sprintf_v ( buff, "%u", crt_minor ) ;
428 
			output_string ( buff ) ;
429 
		    } else {
430 
			goto bad_format ;
431 
		    }
432 
		    break ;
433 
		}
434 
 
435 
		case 'Z' : {
436 
		    c = *( s++ ) ;
437 
		    if ( c == 'V' ) {
438 
			/* %ZV -> program version */
439 
			sprintf_v ( buff, "%.*s", prec, progvers ) ;
440 
			output_string ( buff ) ;
441 
		    } else if ( c == 'X' ) {
442 
			/* %ZX -> program name */
443 
			sprintf_v ( buff, "%.*s", prec, progname ) ;
444 
			output_string ( buff ) ;
445 
		    } else {
446 
			goto bad_format ;
447 
		    }
448 
		    break ;
449 
		}
450 
 
451 
		case 'b' : {
452 
		    /* '%b' -> backspaces */
453 
		    if ( !have_prec ) prec = 1 ;
454 
		    output_posn -= prec ;
455 
		    if ( output_posn < 0 ) output_posn = 0 ;
456 
		    break ;
457 
		}
458 
 
459 
		case 't' : {
460 
		    /* '%t' -> tabs */
461 
		    if ( have_prec ) {
462 
			while ( crt_column < ( unsigned ) prec ) {
463 
			    output_char ( '\t' ) ;
464 
			}
465 
		    }
466 
		    break ;
467 
		}
468 
 
469 
		case 'u' : {
470 
		    /* '%u' -> unique value */
471 
		    if ( have_prec ) {
472 
			crt_unique = prec ;
473 
		    } else {
474 
			prec = crt_unique++ ;
475 
			sprintf_v ( buff, "%d", prec ) ;
476 
			output_string ( buff ) ;
477 
		    }
478 
		    break ;
479 
		}
480 
 
481 
		case '%' : {
482 
		    /* '%%' -> '%' */
483 
		    output_char ( '%' ) ;
484 
		    break ;
485 
		}
486 
 
487 
		case '@' : {
488 
		    /* '%@' -> '@' */
489 
		    output_char ( '@' ) ;
490 
		    break ;
491 
		}
492 
 
493 
		case '\n' : {
494 
		    /* Escaped newline */
495 
		    break ;
496 
		}
497 
 
498 
		case '_' : {
499 
		    /* Dummy end marker */
500 
		    break ;
501 
		}
502 
 
503 
		misplaced_arg : {
504 
		    error ( ERROR_SERIOUS, "Misplaced format, '%%%.2s'", s0 ) ;
505 
		    output_string ( "<error>" ) ;
506 
		    break ;
507 
		}
508 
 
509 
		default :
510 
		bad_format : {
511 
		    error ( ERROR_SERIOUS, "Unknown format, '%%%.2s'", s0 ) ;
512 
		    output_string ( "<error>" ) ;
513 
		    break ;
514 
		}
515 
	    }
516 
	} else {
517 
	    output_char ( ( int ) c ) ;
518 
	}
519 
    }
520 
    return ;
521 
}
522 
 
523 
 
524 
/*
525 
    EVALUATE A CONDITION
526 
 
527 
    This routine evaluates the condition given by the string s.
528 
*/
529 
 
530 
static int eval_cond
531 
    PROTO_N ( ( s ) )
532 
    PROTO_T ( string s )
533 
{
534 
    string s0 = s ;
535 
    SORT cs = crt_sort ;
536 
    SORT_INFO ci = crt_info ;
537 
    CONSTRUCT cc = crt_cons ;
538 
    PARAMETER cp = crt_param ;
539 
 
540 
    if ( s [0] == '!' ) {
541 
	/* Negate condition */
542 
	return ( !eval_cond ( s + 1 ) ) ;
543 
    }
544 
 
545 
    if ( strneq ( s, "sort.", 5 ) ) {
546 
	/* Sort conditions */
547 
	s += 5 ;
548 
	sort_label : {
549 
	    unsigned tag = 100 ;
550 
	    if ( !IS_NULL_info ( ci ) ) tag = TAG_info ( ci ) ;
551 
	    if ( streq ( s, "builtin" ) ) return ( tag == info_builtin_tag ) ;
552 
	    if ( streq ( s, "basic" ) ) return ( tag == info_basic_tag ) ;
553 
	    if ( streq ( s, "dummy" ) ) return ( tag == info_dummy_tag ) ;
554 
	    if ( streq ( s, "list" ) ) return ( tag == info_clist_tag ) ;
555 
	    if ( streq ( s, "slist" ) ) return ( tag == info_slist_tag ) ;
556 
	    if ( streq ( s, "option" ) ) return ( tag == info_option_tag ) ;
557 
	    if ( streq ( s, "simple" ) ) {
558 
		return ( tag == info_basic_tag || tag == info_dummy_tag ) ;
559 
	    }
560 
	    if ( streq ( s, "compound" ) ) {
561 
		if ( tag == info_option_tag ) return ( 1 ) ;
562 
		return ( tag == info_clist_tag || tag == info_slist_tag ) ;
563 
	    }
564 
	    if ( streq ( s, "extends" ) ) {
565 
		if ( tag == info_basic_tag ) {
566 
		    unsigned a = DEREF_unsigned ( info_basic_extend ( ci ) ) ;
567 
		    if ( a ) return ( 1 ) ;
568 
		}
569 
		return ( 0 ) ;
570 
	    }
571 
	    if ( streq ( s, "special" ) ) {
572 
		int a = 0 ;
573 
		if ( !IS_NULL_sort ( cs ) ) {
574 
		    a = DEREF_int ( sort_special ( cs ) ) ;
575 
		}
576 
		return ( a ) ;
577 
	    }
578 
	    if ( streq ( s, "edge" ) ) {
579 
		int a = 0 ;
580 
		if ( !IS_NULL_sort ( cs ) ) {
581 
		    a = DEREF_int ( sort_edge ( cs ) ) ;
582 
		}
583 
		return ( a ) ;
584 
	    }
585 
	    if ( streq ( s, "link" ) ) {
586 
		if ( !IS_NULL_sort ( cs ) ) {
587 
		    string nm = DEREF_string ( sort_link ( cs ) ) ;
588 
		    if ( nm ) return ( 1 ) ;
589 
		}
590 
		return ( 0 ) ;
591 
	    }
592 
	    if ( streq ( s, "unit" ) ) {
593 
		if ( !IS_NULL_sort ( cs ) ) {
594 
		    string nm = DEREF_string ( sort_unit ( cs ) ) ;
595 
		    if ( nm ) return ( 1 ) ;
596 
		}
597 
		return ( 0 ) ;
598 
	    }
599 
	    if ( strneq ( s, "name.", 5 ) ) {
600 
		if ( tag == info_basic_tag ) {
601 
		    cc = DEREF_cons ( info_basic_sortname ( ci ) ) ;
602 
		} else {
603 
		    cc = NULL_cons ;
604 
		}
605 
		goto cons_label ;
606 
	    }
607 
	    if ( strneq ( s, "sub.", 4 ) ) {
608 
		s += 4 ;
609 
		if ( tag == info_clist_tag || tag == info_slist_tag ||
610 
		     tag == info_option_tag ) {
611 
		    cs = DEREF_sort ( info_clist_etc_arg ( ci ) ) ;
612 
		    ci = DEREF_info ( sort_info ( cs ) ) ;
613 
		}
614 
		goto sort_label ;
615 
	    }
616 
	    if ( strneq ( s, "eq.", 3 ) ) {
617 
		s += 3 ;
618 
		if ( !IS_NULL_sort ( cs ) ) {
619 
		    string nm = DEREF_string ( sort_name ( cs ) ) ;
620 
		    if ( streq ( nm, s ) ) return ( 1 ) ;
621 
		}
622 
		return ( 0 ) ;
623 
	    }
624 
	}
625 
 
626 
    } else if ( strneq ( s, "cons.", 5 ) ) {
627 
	/* Construct conditions */
628 
	cons_label : {
629 
	    unsigned kind = KIND_dummy ;
630 
	    s += 5 ;
631 
	    if ( strneq ( s, "sort.", 5 ) ) {
632 
		s += 5 ;
633 
		if ( IS_NULL_cons ( cc ) ) {
634 
		    cs = NULL_sort ;
635 
		    ci = NULL_info ;
636 
		}
637 
		goto sort_label ;
638 
	    }
639 
	    if ( !IS_NULL_cons ( cc ) ) {
640 
		kind = DEREF_unsigned ( cons_kind ( cc ) ) ;
641 
	    }
642 
	    if ( streq ( s, "simple" ) ) return ( kind == KIND_simple ) ;
643 
	    if ( streq ( s, "token" ) ) return ( kind == KIND_token ) ;
644 
	    if ( streq ( s, "cond" ) ) return ( kind == KIND_cond ) ;
645 
	    if ( streq ( s, "edge" ) ) return ( kind == KIND_edge ) ;
646 
	    if ( streq ( s, "foreign" ) ) return ( kind == KIND_foreign ) ;
647 
	    if ( streq ( s, "special" ) ) return ( kind == KIND_special ) ;
648 
	    if ( streq ( s, "params" ) ) {
649 
		if ( !IS_NULL_cons ( cc ) ) {
650 
		    LIST ( PARAMETER ) p = DEREF_list ( cons_pars ( cc ) ) ;
651 
		    if ( !IS_NULL_list ( p ) ) return ( 1 ) ;
652 
		}
653 
		return ( 0 ) ;
654 
	    }
655 
	    if ( streq ( s, "extends" ) ) {
656 
		if ( !IS_NULL_cons ( cc ) ) {
657 
		    if ( !IS_NULL_info ( ci ) && IS_info_basic ( ci ) ) {
658 
			unsigned b, e ;
659 
			b = DEREF_unsigned ( info_basic_bits ( ci ) ) ;
660 
			e = DEREF_unsigned ( cons_encode ( cc ) ) ;
661 
			if ( e >= ( ( unsigned ) 1 << b ) ) return ( 1 ) ;
662 
		    }
663 
		}
664 
		return ( 0 ) ;
665 
	    }
666 
	    if ( strneq ( s, "eq.", 3 ) ) {
667 
		s += 3 ;
668 
		if ( !IS_NULL_cons ( cc ) ) {
669 
		    string nm = DEREF_string ( cons_name ( cc ) ) ;
670 
		    if ( streq ( nm, s ) ) return ( 1 ) ;
671 
		}
672 
		return ( 0 ) ;
673 
	    }
674 
	}
675 
 
676 
    } else if ( strneq ( s, "param.", 6 ) ) {
677 
	/* Parameter conditions */
678 
	s += 6 ;
679 
	if ( strneq ( s, "sort.", 5 ) ) {
680 
	    s += 5 ;
681 
	    if ( !IS_NULL_par ( cp ) ) {
682 
		cs = DEREF_sort ( par_type ( cp ) ) ;
683 
		ci = DEREF_info ( sort_info ( cs ) ) ;
684 
	    } else {
685 
		cs = NULL_sort ;
686 
		ci = NULL_info ;
687 
	    }
688 
	    goto sort_label ;
689 
	}
690 
	if ( streq ( s, "align" ) ) {
691 
	    int a = 0 ;
692 
	    if ( !IS_NULL_par ( cp ) ) a = DEREF_int ( par_align ( cp ) ) ;
693 
	    return ( a ) ;
694 
	}
695 
	if ( streq ( s, "break" ) ) {
696 
	    int a = 0 ;
697 
	    if ( !IS_NULL_par ( cp ) ) a = DEREF_int ( par_brk ( cp ) ) ;
698 
	    return ( a ) ;
699 
	}
700 
	if ( streq ( s, "intro" ) ) {
701 
	    int a = 0 ;
702 
	    if ( !IS_NULL_par ( cp ) ) a = DEREF_int ( par_intro ( cp ) ) ;
703 
	    return ( a ) ;
704 
	}
705 
	if ( streq ( s, "first" ) ) {
706 
	    return ( crt_param_no == 0 ) ;
707 
	}
708 
	if ( streq ( s, "last" ) ) {
709 
	    return ( crt_param_no == last_param_no ) ;
710 
	}
711 
	if ( strneq ( s, "eq.", 3 ) ) {
712 
	    s += 3 ;
713 
	    if ( !IS_NULL_par ( cp ) ) {
714 
		string nm = DEREF_string ( par_name ( cp ) ) ;
715 
		if ( streq ( nm, s ) ) return ( 1 ) ;
716 
	    }
717 
	    return ( 0 ) ;
718 
	}
719 
 
720 
    } else {
721 
	/* Other conditions */
722 
	if ( streq ( s, "uniq" ) ) return ( crt_unique ) ;
723 
	if ( streq ( s, "true" ) ) return ( 1 ) ;
724 
	if ( streq ( s, "false" ) ) return ( 0 ) ;
725 
    }
726 
    error ( ERROR_SERIOUS, "Unknown condition, '%s'", s0 ) ;
727 
    return ( 0 ) ;
728 
}
729 
 
730 
 
731 
/*
732 
    WRITE A TEMPLATE FILE
733 
 
734 
    This routine writes the template file given by the commands cmd for
735 
    the specification spec to the output file.
736 
*/
737 
 
738 
static void output_template
739 
    PROTO_N ( ( spec, cmd ) )
740 
    PROTO_T ( SPECIFICATION spec X COMMAND cmd )
741 
{
742 
    if ( !IS_NULL_cmd ( cmd ) ) {
743 
	crt_line_no = DEREF_int ( cmd_line ( cmd ) ) ;
744 
	switch ( TAG_cmd ( cmd ) ) {
745 
	    case cmd_simple_tag : {
746 
		string s = DEREF_string ( cmd_simple_text ( cmd ) ) ;
747 
		output ( s ) ;
748 
		break ;
749 
	    }
750 
	    case cmd_compound_tag : {
751 
		LIST ( COMMAND ) p ;
752 
		p = DEREF_list ( cmd_compound_seq ( cmd ) ) ;
753 
		while ( !IS_NULL_list ( p ) ) {
754 
		    COMMAND a = DEREF_cmd ( HEAD_list ( p ) ) ;
755 
		    output_template ( spec, a ) ;
756 
		    p = TAIL_list ( p ) ;
757 
		}
758 
		break ;
759 
	    }
760 
	    case cmd_loop_tag : {
761 
		string s = DEREF_string ( cmd_loop_control ( cmd ) ) ;
762 
		COMMAND a = DEREF_cmd ( cmd_loop_body ( cmd ) ) ;
763 
		if ( streq ( s, "sort" ) ) {
764 
		    /* Loop over all sorts */
765 
		    SORT ls = crt_sort ;
766 
		    SORT_INFO li = crt_info ;
767 
		    LIST ( SORT ) ps = DEREF_list ( spec_sorts ( spec ) ) ;
768 
		    while ( !IS_NULL_list ( ps ) ) {
769 
			SORT cs = DEREF_sort ( HEAD_list ( ps ) ) ;
770 
			int mark = DEREF_int ( sort_mark ( cs ) ) ;
771 
			if ( mark ) {
772 
			    SORT_INFO ci = DEREF_info ( sort_info ( cs ) ) ;
773 
			    if ( !IS_NULL_info ( ci ) ) {
774 
				crt_sort = cs ;
775 
				crt_info = ci ;
776 
				output_template ( spec, a ) ;
777 
			    }
778 
			}
779 
			ps = TAIL_list ( ps ) ;
780 
		    }
781 
		    crt_sort = ls ;
782 
		    crt_info = li ;
783 
 
784 
		} else if ( streq ( s, "sort.cons" ) ) {
785 
		    /* Loop over all constructs */
786 
		    CONSTRUCT lc = crt_cons ;
787 
		    SORT_INFO ci = crt_info ;
788 
		    if ( !IS_NULL_info ( ci ) ) {
789 
			if ( IS_info_basic ( ci ) ) {
790 
			    LIST ( CONSTRUCT ) pc ;
791 
			    pc = DEREF_list ( info_basic_cons ( ci ) ) ;
792 
			    while ( !IS_NULL_list ( pc ) ) {
793 
				crt_cons = DEREF_cons ( HEAD_list ( pc ) ) ;
794 
				output_template ( spec, a ) ;
795 
				pc = TAIL_list ( pc ) ;
796 
			    }
797 
			} else if ( IS_info_dummy ( ci ) ) {
798 
			    crt_cons = DEREF_cons ( info_dummy_cons ( ci ) ) ;
799 
			    output_template ( spec, a ) ;
800 
			}
801 
		    }
802 
		    crt_cons = lc ;
803 
 
804 
		} else if ( streq ( s, "cons.param" ) ) {
805 
		    /* Loop over all parameters */
806 
		    int np = crt_param_no ;
807 
		    int mp = last_param_no ;
808 
		    PARAMETER lp = crt_param ;
809 
		    CONSTRUCT cc = crt_cons ;
810 
		    if ( !IS_NULL_cons ( cc ) ) {
811 
			LIST ( PARAMETER ) pp ;
812 
			pp = DEREF_list ( cons_pars ( cc ) ) ;
813 
			crt_param_no = 0 ;
814 
			last_param_no = ( int ) LENGTH_list ( pp ) - 1 ;
815 
			while ( !IS_NULL_list ( pp ) ) {
816 
			    crt_param = DEREF_par ( HEAD_list ( pp ) ) ;
817 
			    output_template ( spec, a ) ;
818 
			    crt_param_no++ ;
819 
			    pp = TAIL_list ( pp ) ;
820 
			}
821 
		    }
822 
		    last_param_no = mp ;
823 
		    crt_param_no = np ;
824 
		    crt_param = lp ;
825 
 
826 
		} else if ( streq ( s, "param.prev" ) ) {
827 
		    /* Loop over all previous parameters */
828 
		    int np = crt_param_no ;
829 
		    int mp = last_param_no ;
830 
		    PARAMETER lp = crt_param ;
831 
		    CONSTRUCT cc = crt_cons ;
832 
		    if ( !IS_NULL_cons ( cc ) ) {
833 
			LIST ( PARAMETER ) pp ;
834 
			pp = DEREF_list ( cons_pars ( cc ) ) ;
835 
			crt_param_no = 0 ;
836 
			last_param_no = np - 1 ;
837 
			while ( !IS_NULL_list ( pp ) && crt_param_no < np ) {
838 
			    crt_param = DEREF_par ( HEAD_list ( pp ) ) ;
839 
			    output_template ( spec, a ) ;
840 
			    crt_param_no++ ;
841 
			    pp = TAIL_list ( pp ) ;
842 
			}
843 
		    }
844 
		    last_param_no = mp ;
845 
		    crt_param_no = np ;
846 
		    crt_param = lp ;
847 
 
848 
		} else {
849 
		    error ( ERROR_SERIOUS, "Unknown control, '%s'", s ) ;
850 
		}
851 
		break ;
852 
	    }
853 
	    case cmd_cond_tag : {
854 
		string s = DEREF_string ( cmd_cond_control ( cmd ) ) ;
855 
		COMMAND a = DEREF_cmd ( cmd_cond_true_code ( cmd ) ) ;
856 
		COMMAND b = DEREF_cmd ( cmd_cond_false_code ( cmd ) ) ;
857 
		if ( eval_cond ( s ) ) {
858 
		    output_template ( spec, a ) ;
859 
		} else {
860 
		    output_template ( spec, b ) ;
861 
		}
862 
		break ;
863 
	    }
864 
	    case cmd_use_tag : {
865 
		int m = 1 ;
866 
		string c = DEREF_string ( cmd_use_cons ( cmd ) ) ;
867 
		string s = DEREF_string ( cmd_use_sort ( cmd ) ) ;
868 
		while ( s [0] == '!' ) {
869 
		    m = !m ;
870 
		    s++ ;
871 
		}
872 
		if ( c == NULL && streq ( s, "all" ) ) {
873 
		    mark_all_sorts ( m ) ;
874 
		} else {
875 
		    SORT sn = find_sort ( s, 0 ) ;
876 
		    if ( c ) {
877 
			CONSTRUCT cn = find_construct ( sn, c ) ;
878 
			mark_construct ( cn, m ) ;
879 
		    } else {
880 
			mark_sort ( sn, m ) ;
881 
		    }
882 
		}
883 
		break ;
884 
	    }
885 
	    case cmd_special_tag : {
886 
		SORT sn ;
887 
		int m = 1 ;
888 
		string c = DEREF_string ( cmd_special_cons ( cmd ) ) ;
889 
		string s = DEREF_string ( cmd_special_sort ( cmd ) ) ;
890 
		while ( s [0] == '!' ) {
891 
		    m = !m ;
892 
		    s++ ;
893 
		}
894 
		sn = find_sort ( s, 0 ) ;
895 
		if ( c ) {
896 
		    if ( m ) {
897 
			set_special ( sn, c, KIND_special ) ;
898 
		    } else {
899 
			set_special ( sn, c, KIND_simple ) ;
900 
		    }
901 
		} else {
902 
		    COPY_int ( sort_special ( sn ), m ) ;
903 
		}
904 
		mark_sort ( sn, 1 ) ;
905 
		break ;
906 
	    }
907 
	}
908 
    }
909 
    return ;
910 
}
911 
 
912 
 
913 
/*
914 
    MAIN OUTPUT ROUTINE
915 
 
916 
    This routine outputs all the information concerning the TDF specification
917 
    spec to the output file nm using the template cmd.
918 
*/
919 
 
920 
void output_spec
921 
    PROTO_N ( ( nm, spec, cmd ) )
922 
    PROTO_T ( char *nm X SPECIFICATION spec X COMMAND cmd )
923 
{
924 
    CONST char *tnm = crt_file_name ;
925 
    crt_line_no = 1 ;
926 
    if ( nm == NULL || streq ( nm, "-" ) ) {
927 
	crt_file_name = "<stdout>" ;
928 
	output_file = stdout ;
929 
	nm = NULL ;
930 
    } else {
931 
	crt_file_name = nm ;
932 
	output_file = fopen ( nm, "w" ) ;
933 
	if ( output_file == NULL ) {
934 
	    error ( ERROR_SERIOUS, "Can't open output file, '%s'", nm ) ;
935 
	    return ;
936 
	}
937 
    }
938 
    output_posn = 0 ;
939 
    crt_column = 0 ;
940 
    crt_file_name = tnm ;
941 
    crt_major = DEREF_unsigned ( spec_major ( spec ) ) ;
942 
    crt_minor = DEREF_unsigned ( spec_minor ( spec ) ) ;
943 
    output_template ( spec, cmd ) ;
944 
    if ( output_posn ) output_char ( '\n' ) ;
945 
    if ( nm ) fclose_v ( output_file ) ;
946 
    return ;
947 
}