Warning: Attempt to read property "date" on null in /usr/local/www/websvn.planix.org/blame.php on line 247

Warning: Attempt to read property "msg" on null in /usr/local/www/websvn.planix.org/blame.php on line 247
WebSVN – tendra.SVN – Blame – /branches/algol60/src/utilities/calculus/template.c – Rev 2

Subversion Repositories tendra.SVN

Rev

Go to most recent revision | Details | 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 "calculus.h"
33
#include "cmd_ops.h"
34
#include "error.h"
35
#include "common.h"
36
#include "output.h"
37
#include "template.h"
38
#include "xalloc.h"
39
 
40
 
41
/*
42
    GET A COMMAND FROM A STRING
43
 
44
    This routine returns the address of the first non-white space character
45
    from the string ps.  It returns the null pointer if the end of the line
46
    is reached.
47
*/
48
 
49
static char *get_command
50
    PROTO_N ( ( ps ) )
51
    PROTO_T ( char **ps )
52
{
53
    char *t = *ps ;
54
    char *s = t ;
55
    if ( s ) {
56
	char c ;
57
	while ( c = *s, ( c == ' ' || c == '\t' || c == '\r' ) ) {
58
	    *s = 0 ;
59
	    s++ ;
60
	}
61
	if ( c == '#' || c == '\n' || c == 0 ) {
62
	    *s = 0 ;
63
	    *ps = NULL ;
64
	    return ( NULL ) ;
65
	}
66
	t = s ;
67
	while ( c = *s, !( c == ' ' || c == '\t' || c == '\r' ||
68
			   c == '\n' || c == 0 ) ) {
69
	    s++ ;
70
	}
71
	*ps = s ;
72
    }
73
    return ( t ) ;
74
}
75
 
76
 
77
/*
78
    READ A TEMPLATE FILE
79
 
80
    This routine reads a template file from the file f.
81
*/
82
 
83
static COMMAND read_template
84
    PROTO_N ( ( f, p ) )
85
    PROTO_T ( FILE *f X COMMAND p )
86
{
87
    int go = 1 ;
88
    char buff [1000] ;
89
    int ln1 = crt_line_no ;
90
    LIST ( COMMAND ) q = NULL_list ( COMMAND ) ;
91
    do {
92
	COMMAND r = NULL_cmd ;
93
	int ln2 = crt_line_no ;
94
	char *s = fgets ( buff, 1000, f ) ;
95
	if ( s == NULL ) {
96
	    /* End of file */
97
	    if ( IS_cmd_cond ( p ) ) {
98
		error ( ERROR_SERIOUS, "End of '@if' expected" ) ;
99
	    } else if ( IS_cmd_loop ( p ) ) {
100
		error ( ERROR_SERIOUS, "End of '@loop' expected" ) ;
101
	    }
102
	    break ;
103
	}
104
	s = xstrcpy ( s ) ;
105
	if ( s [0] == '@' ) {
106
	    /* Complex command */
107
	    char *s1, *s2, *s3 ;
108
	    s++ ;
109
	    s1 = get_command ( &s ) ;
110
	    if ( s1 == NULL ) s1 = "<empty>" ;
111
	    s2 = get_command ( &s ) ;
112
	    s3 = get_command ( &s ) ;
113
	    if ( streq ( s1, "if" ) ) {
114
		if ( s2 == NULL ) {
115
		    error ( ERROR_SERIOUS, "Incomplete '@%s' command", s1 ) ;
116
		    s2 = "true" ;
117
		}
118
		MAKE_cmd_cond ( ln2, s2, NULL_cmd, NULL_cmd, r ) ;
119
	    } else if ( streq ( s1, "else" ) ) {
120
		if ( IS_cmd_cond ( p ) ) {
121
		    COMMAND v = DEREF_cmd ( cmd_cond_true_code ( p ) ) ;
122
		    if ( !IS_NULL_cmd ( v ) ) {
123
			error ( ERROR_SERIOUS, "Duplicate '@%s' command", s1 ) ;
124
		    }
125
		    q = REVERSE_list ( q ) ;
126
		    MAKE_cmd_compound ( ln1, q, v ) ;
127
		    COPY_cmd ( cmd_cond_true_code ( p ), v ) ;
128
		    q = NULL_list ( COMMAND ) ;
129
		    ln1 = ln2 ;
130
		} else {
131
		    error ( ERROR_SERIOUS, "Misplaced '@%s' command", s1 ) ;
132
		}
133
		s3 = s2 ;
134
	    } else if ( streq ( s1, "endif" ) ) {
135
		if ( IS_cmd_cond ( p ) ) {
136
		    go = 0 ;
137
		} else {
138
		    error ( ERROR_SERIOUS, "Misplaced '@%s' command", s1 ) ;
139
		}
140
		s3 = s2 ;
141
	    } else if ( streq ( s1, "loop" ) ) {
142
		if ( s2 == NULL ) {
143
		    error ( ERROR_SERIOUS, "Incomplete '@%s' command", s1 ) ;
144
		    s2 = "false" ;
145
		}
146
		MAKE_cmd_loop ( ln2, s2, NULL_cmd, r ) ;
147
	    } else if ( streq ( s1, "end" ) ) {
148
		if ( IS_cmd_loop ( p ) ) {
149
		    go = 0 ;
150
		} else {
151
		    error ( ERROR_SERIOUS, "Misplaced '@%s' command", s1 ) ;
152
		}
153
		s3 = s2 ;
154
	    } else if ( streq ( s1, "comment" ) ) {
155
		s3 = NULL ;
156
	    } else {
157
		error ( ERROR_SERIOUS, "Unknown command, '@%s'", s1 ) ;
158
		s3 = NULL ;
159
	    }
160
	    if ( s3 ) {
161
		error ( ERROR_SERIOUS, "End of '@%s' expected", s1 ) ;
162
	    }
163
	    crt_line_no = ln2 + 1 ;
164
	    if ( !IS_NULL_cmd ( r ) ) {
165
		/* Read body of command */
166
		COMMAND u = read_template ( f, r ) ;
167
		if ( IS_cmd_cond ( r ) ) {
168
		    COMMAND v = DEREF_cmd ( cmd_cond_true_code ( r ) ) ;
169
		    if ( IS_NULL_cmd ( v ) ) {
170
			COPY_cmd ( cmd_cond_true_code ( r ), u ) ;
171
		    } else {
172
			COPY_cmd ( cmd_cond_false_code ( r ), u ) ;
173
		    }
174
		} else if ( IS_cmd_loop ( r ) ) {
175
		    COPY_cmd ( cmd_loop_body ( r ), u ) ;
176
		}
177
		CONS_cmd ( r, q, q ) ;
178
	    }
179
	} else {
180
	    /* Simple command */
181
	    MAKE_cmd_simple ( ln2, s, r ) ;
182
	    CONS_cmd ( r, q, q ) ;
183
	    crt_line_no = ln2 + 1 ;
184
	}
185
    } while ( go ) ;
186
    q = REVERSE_list ( q ) ;
187
    MAKE_cmd_compound ( ln1, q, p ) ;
188
    return ( p ) ;
189
}
190
 
191
 
192
/*
193
    TOKEN CONDITION
194
 
195
    This variable gives the value of the token condition.
196
*/
197
 
198
int token_cond = 0 ;
199
 
200
 
201
/*
202
    EVALUATE A CONDITION
203
 
204
    This routine evaluates the condition s.
205
*/
206
 
207
static int eval_cond
208
    PROTO_N ( ( s ) )
209
    PROTO_T ( char *s )
210
{
211
    if ( s [0] == '!' ) {
212
	/* Negate condition */
213
	return ( !eval_cond ( s + 1 ) ) ;
214
    }
215
    if ( streq ( s, "comp.complex" ) ) {
216
	/* Complex component type */
217
	if ( HAVE_COMPONENT ) {
218
	    TYPE_P_P pt = cmp_type ( CRT_COMPONENT ) ;
219
	    TYPE_P t = DEREF_ptr ( pt ) ;
220
	    return ( is_complex_type ( t ) ) ;
221
	}
222
	return ( 0 ) ;
223
    }
224
    if ( streq ( s, "comp.default" ) ) {
225
	/* Component default value */
226
	if ( HAVE_COMPONENT ) {
227
	    string_P pv = cmp_name ( CRT_COMPONENT ) ;
228
	    string v = DEREF_string ( pv ) ;
229
	    if ( v ) return ( 1 ) ;
230
	}
231
	return ( 0 ) ;
232
    }
233
    if ( streq ( s, "token" ) ) return ( token_cond ) ;
234
    if ( streq ( s, "true" ) ) return ( 1 ) ;
235
    if ( streq ( s, "false" ) ) return ( 0 ) ;
236
    error ( ERROR_SERIOUS, "Unknown condition, '%s'", s ) ;
237
    return ( 0 ) ;
238
}
239
 
240
 
241
/*
242
    WRITE A TEMPLATE FILE
243
 
244
    This routine writes the template file given by the commands cmd.
245
*/
246
 
247
static void write_template
248
    PROTO_N ( ( cmd ) )
249
    PROTO_T ( COMMAND cmd )
250
{
251
    if ( !IS_NULL_cmd ( cmd ) ) {
252
	crt_line_no = DEREF_int ( cmd_line ( cmd ) ) ;
253
	switch ( TAG_cmd ( cmd ) ) {
254
	    case cmd_simple_tag : {
255
		string s = DEREF_string ( cmd_simple_text ( cmd ) ) ;
256
		output ( s ) ;
257
		break ;
258
	    }
259
	    case cmd_compound_tag : {
260
		LIST ( COMMAND ) p ;
261
		p = DEREF_list ( cmd_compound_seq ( cmd ) ) ;
262
		while ( !IS_NULL_list ( p ) ) {
263
		    COMMAND a = DEREF_cmd ( HEAD_list ( p ) ) ;
264
		    write_template ( a ) ;
265
		    p = TAIL_list ( p ) ;
266
		}
267
		break ;
268
	    }
269
	    case cmd_loop_tag : {
270
		string s = DEREF_string ( cmd_loop_control ( cmd ) ) ;
271
		COMMAND a = DEREF_cmd ( cmd_loop_body ( cmd ) ) ;
272
		if ( streq ( s, "enum" ) ) {
273
		    LOOP_ENUM write_template ( a ) ;
274
		} else if ( streq ( s, "enum.const" ) ) {
275
		    if ( HAVE_ENUM ) {
276
			LOOP_ENUM_CONST write_template ( a ) ;
277
		    }
278
		} else if ( streq ( s, "identity" ) ) {
279
		    LOOP_IDENTITY write_template ( a ) ;
280
		} else if ( streq ( s, "primitive" ) ) {
281
		    LOOP_PRIMITIVE write_template ( a ) ;
282
		} else if ( streq ( s, "struct" ) ) {
283
		    LOOP_STRUCTURE write_template ( a ) ;
284
		} else if ( streq ( s, "struct.comp" ) ) {
285
		    if ( HAVE_STRUCTURE ) {
286
			LOOP_STRUCTURE_COMPONENT write_template ( a ) ;
287
		    }
288
		} else if ( streq ( s, "union" ) ) {
289
		    LOOP_UNION write_template ( a ) ;
290
		} else if ( streq ( s, "union.comp" ) ) {
291
		    if ( HAVE_UNION ) {
292
			LOOP_UNION_COMPONENT write_template ( a ) ;
293
		    }
294
		} else if ( streq ( s, "union.field" ) ) {
295
		    if ( HAVE_UNION ) {
296
			LOOP_UNION_FIELD write_template ( a ) ;
297
		    }
298
		} else if ( streq ( s, "union.field.comp" ) ) {
299
		    if ( HAVE_UNION && HAVE_FIELD ) {
300
			LOOP_FIELD_COMPONENT write_template ( a ) ;
301
		    }
302
		} else if ( streq ( s, "union.map" ) ) {
303
		    if ( HAVE_UNION ) {
304
			LOOP_UNION_MAP write_template ( a ) ;
305
		    }
306
		} else if ( streq ( s, "union.map.arg" ) ) {
307
		    if ( HAVE_UNION && HAVE_MAP ) {
308
			LOOP_MAP_ARGUMENT write_template ( a ) ;
309
		    }
310
		} else {
311
		    error ( ERROR_SERIOUS, "Unknown control, '%s'", s ) ;
312
		}
313
		break ;
314
	    }
315
	    case cmd_cond_tag : {
316
		string s = DEREF_string ( cmd_cond_control ( cmd ) ) ;
317
		COMMAND a = DEREF_cmd ( cmd_cond_true_code ( cmd ) ) ;
318
		COMMAND b = DEREF_cmd ( cmd_cond_false_code ( cmd ) ) ;
319
		if ( eval_cond ( s ) ) {
320
		    write_template ( a ) ;
321
		} else {
322
		    write_template ( b ) ;
323
		}
324
		break ;
325
	    }
326
	}
327
    }
328
    return ;
329
}
330
 
331
 
332
/*
333
    PROCESS A TEMPLATE FILE
334
 
335
    This routine processes the template file in to the output file out.
336
*/
337
 
338
void template_file
339
    PROTO_N ( ( in, out ) )
340
    PROTO_T ( char *in X char *out )
341
{
342
    COMMAND cmd ;
343
    FILE *input_file ;
344
    crt_line_no = 1 ;
345
    crt_file_name = in ;
346
    input_file = fopen ( in, "r" ) ;
347
    if ( input_file == NULL ) {
348
	error ( ERROR_SERIOUS, "Can't open template file, '%s'", in ) ;
349
	return ;
350
    }
351
    MAKE_cmd_simple ( 1, "<dummy>", cmd ) ;
352
    cmd = read_template ( input_file, cmd ) ;
353
    fclose_v ( input_file ) ;
354
    if ( streq ( out, "." ) ) {
355
	output_file = stdout ;
356
    } else {
357
	output_file = fopen ( out, "w" ) ;
358
	if ( output_file == NULL ) {
359
	    error ( ERROR_SERIOUS, "Can't open output file, '%s'", out ) ;
360
	    return ;
361
	}
362
    }
363
    have_varargs = 0 ;
364
    write_template ( cmd ) ;
365
    have_varargs = 1 ;
366
    flush_output () ;
367
    if ( output_file != stdout ) fclose_v ( output_file ) ;
368
    return ;
369
}