Subversion Repositories tendra.SVN

Rev

Rev 5 | Details | Compare with Previous | Last modification | View Log | RSS feed

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