Subversion Repositories tendra.SVN

Rev

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

Rev Author Line No. Line
2 7u83 1
/*
7 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
7 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:-
7 7u83 42
 
2 7u83 43
        (1) Its Recipients shall ensure that this Notice is
44
        reproduced upon any copies or amended versions of it;
7 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;
7 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;
7 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
/* AUTOMATICALLY GENERATED BY make_tdf VERSION 2.0 FROM TDF 4.1 */
62
 
63
#include "config.h"
64
#include "types.h"
65
#include "de_types.h"
66
#include "enc_types.h"
67
#include "check.h"
68
#include "decode.h"
69
#include "de_capsule.h"
70
#include "de_unit.h"
71
#include "encode.h"
72
#include "node.h"
73
#include "read.h"
74
#include "shape.h"
75
#include "table.h"
76
#include "tdf.h"
77
#include "utility.h"
78
 
79
 
80
/* INITIALISE CONSTRUCTS */
81
 
7 7u83 82
void
83
init_constructs(void)
2 7u83 84
{
7 7u83 85
    sortname s;
2 7u83 86
 
7 7u83 87
    s = SORT_access;
88
    sort_letters[s] = 'u';
89
    sort_encoding[s] = 4;
90
    sort_extension[s] = 1;
91
    sort_decode[s] = de_access;
92
    sort_read[s] = read_access;
93
    new_sort(s, 14);
94
    new_cons("access_apply_token", s, 1, "!");
95
    sort_tokens[s] = 1;
96
    new_cons("access_cond", s, 2, "x@[u]@[u]");
97
    sort_conds[s] = 2;
98
    new_cons("add_accesses", s, 3, "uu");
99
    new_cons("constant", s, 4,(char *)null);
100
    new_cons("long_jump_access", s, 5,(char *)null);
101
    new_cons("no_other_read", s, 6,(char *)null);
102
    new_cons("no_other_write", s, 7,(char *)null);
103
    new_cons("out_par", s, 8,(char *)null);
104
    new_cons("preserve", s, 9,(char *)null);
105
    new_cons("register", s, 10,(char *)null);
106
    new_cons("standard_access", s, 11,(char *)null);
107
    new_cons("used_as_volatile", s, 12,(char *)null);
108
    new_cons("visible", s, 13,(char *)null);
2 7u83 109
 
7 7u83 110
    s = SORT_al_tag;
111
    sort_letters[s] = 'A';
112
    sort_encoding[s] = 1;
113
    sort_extension[s] = 1;
114
    sort_decode[s] = de_al_tag;
115
    sort_read[s] = read_al_tag;
116
    new_sort(s, 3);
117
    new_cons("al_tag_apply_token", s, 2, "!");
118
    sort_tokens[s] = 2;
119
    new_cons("make_al_tag", s, 1, "i");
2 7u83 120
 
7 7u83 121
    s = SORT_alignment;
122
    sort_letters[s] = 'a';
123
    sort_encoding[s] = 4;
124
    sort_extension[s] = 1;
125
    sort_decode[s] = de_alignment;
126
    sort_read[s] = read_alignment;
127
    new_sort(s, 13);
128
    new_cons("alignment_apply_token", s, 1, "!");
129
    sort_tokens[s] = 1;
130
    new_cons("alignment_cond", s, 2, "x@[a]@[a]");
131
    sort_conds[s] = 2;
132
    new_cons("alignment", s, 3, "S");
133
    new_cons("alloca_alignment", s, 4,(char *)null);
134
    new_cons("callees_alignment", s, 5, "b");
135
    new_cons("callers_alignment", s, 6, "b");
136
    new_cons("code_alignment", s, 7,(char *)null);
137
    new_cons("locals_alignment", s, 8,(char *)null);
138
    new_cons("obtain_al_tag", s, 9, "A");
139
    new_cons("parameter_alignment", s, 10, "S");
140
    new_cons("unite_alignments", s, 11, "aa");
141
    new_cons("var_param_alignment", s, 12,(char *)null);
2 7u83 142
 
7 7u83 143
    s = SORT_bitfield_variety;
144
    sort_letters[s] = 'B';
145
    sort_encoding[s] = 2;
146
    sort_extension[s] = 1;
147
    sort_decode[s] = de_bitfield_variety;
148
    sort_read[s] = read_bitfield_variety;
149
    new_sort(s, 4);
150
    new_cons("bfvar_apply_token", s, 1, "!");
151
    sort_tokens[s] = 1;
152
    new_cons("bfvar_cond", s, 2, "x@[B]@[B]");
153
    sort_conds[s] = 2;
154
    new_cons("bfvar_bits", s, 3, "bn");
2 7u83 155
 
7 7u83 156
    s = SORT_bool;
157
    sort_letters[s] = 'b';
158
    sort_encoding[s] = 3;
159
    sort_extension[s] = 1;
160
    sort_decode[s] = de_bool;
161
    sort_read[s] = read_bool;
162
    new_sort(s, 5);
163
    new_cons("bool_apply_token", s, 1, "!");
164
    sort_tokens[s] = 1;
165
    new_cons("bool_cond", s, 2, "x@[b]@[b]");
166
    sort_conds[s] = 2;
167
    new_cons("false", s, 3,(char *)null);
168
    new_cons("true", s, 4,(char *)null);
2 7u83 169
 
7 7u83 170
    s = SORT_callees;
171
    sort_letters[s] = 'q';
172
    sort_encoding[s] = 2;
173
    sort_extension[s] = 1;
174
    sort_decode[s] = de_callees;
175
    sort_read[s] = read_callees;
176
    new_sort(s, 4);
177
    new_cons("make_callee_list", s, 1, "*[x]");
178
    new_cons("make_dynamic_callees", s, 2, "xx");
179
    new_cons("same_callees", s, 3,(char *)null);
2 7u83 180
 
7 7u83 181
    s = SORT_error_code;
182
    sort_letters[s] = 'c';
183
    sort_encoding[s] = 2;
184
    sort_extension[s] = 1;
185
    sort_decode[s] = de_error_code;
186
    sort_read[s] = read_error_code;
187
    new_sort(s, 4);
188
    new_cons("nil_access", s, 1,(char *)null);
189
    new_cons("overflow", s, 2,(char *)null);
190
    new_cons("stack_overflow", s, 3,(char *)null);
2 7u83 191
 
7 7u83 192
    s = SORT_error_treatment;
193
    sort_letters[s] = 'e';
194
    sort_encoding[s] = 3;
195
    sort_extension[s] = 1;
196
    sort_decode[s] = de_error_treatment;
197
    sort_read[s] = read_error_treatment;
198
    new_sort(s, 8);
199
    new_cons("errt_apply_token", s, 1, "!");
200
    sort_tokens[s] = 1;
201
    new_cons("errt_cond", s, 2, "x@[e]@[e]");
202
    sort_conds[s] = 2;
203
    new_cons("continue", s, 3,(char *)null);
204
    new_cons("error_jump", s, 4, "l");
205
    new_cons("trap", s, 5, "*[c]");
206
    new_cons("wrap", s, 6,(char *)null);
207
    new_cons("impossible", s, 7,(char *)null);
2 7u83 208
 
7 7u83 209
    s = SORT_exp;
210
    sort_letters[s] = 'x';
211
    sort_encoding[s] = 7;
212
    sort_extension[s] = 1;
213
    sort_decode[s] = de_exp;
214
    sort_read[s] = read_exp;
215
    new_sort(s, 117);
216
    new_cons("exp_apply_token", s, 1, "!");
217
    sort_tokens[s] = 1;
218
    new_cons("exp_cond", s, 2, "x@[x]@[x]");
219
    sort_conds[s] = 2;
220
    new_cons("abs", s, 3, "ex");
221
    new_cons("add_to_ptr", s, 4, "xx");
222
    new_cons("and", s, 5, "xx");
223
    new_cons("apply_proc", s, 6, "Sx*[x]?[x]");
224
    new_cons("apply_general_proc", s, 7, "S?[P]x*[?[t&]x]q{x}");
225
    new_cons("assign", s, 8, "xx");
226
    new_cons("assign_with_mode", s, 9, "mxx");
227
    new_cons("bitfield_assign", s, 10, "xxx");
228
    new_cons("bitfield_assign_with_mode", s, 11, "mxxx");
229
    new_cons("bitfield_contents", s, 12, "Bxx");
230
    new_cons("bitfield_contents_with_mode", s, 13, "mBxx");
231
    new_cons("case", s, 14, "bx*[lss]");
232
    new_cons("change_bitfield_to_int", s, 15, "vx");
233
    new_cons("change_floating_variety", s, 16, "efx");
234
    new_cons("change_variety", s, 17, "evx");
235
    new_cons("change_int_to_bitfield", s, 18, "Bx");
236
    new_cons("complex_conjugate", s, 19, "x");
237
    new_cons("component", s, 20, "Sxx");
238
    new_cons("concat_nof", s, 21, "xx");
239
    new_cons("conditional", s, 22, "l&{xx}");
240
    new_cons("contents", s, 23, "Sx");
241
    new_cons("contents_with_mode", s, 24, "mSx");
242
    new_cons("current_env", s, 25,(char *)null);
243
    new_cons("div0", s, 26, "eexx");
244
    new_cons("div1", s, 27, "eexx");
245
    new_cons("div2", s, 28, "eexx");
246
    new_cons("env_offset", s, 29, "aat");
247
    new_cons("env_size", s, 30, "t");
248
    new_cons("fail_installer", s, 31, "X");
249
    new_cons("float_int", s, 32, "efx");
250
    new_cons("floating_abs", s, 33, "ex");
251
    new_cons("floating_div", s, 34, "exx");
252
    new_cons("floating_minus", s, 35, "exx");
253
    new_cons("floating_maximum", s, 36, "exx");
254
    new_cons("floating_minimum", s, 37, "exx");
255
    new_cons("floating_mult", s, 38, "e*[x]");
256
    new_cons("floating_negate", s, 39, "ex");
257
    new_cons("floating_plus", s, 40, "e*[x]");
258
    new_cons("floating_power", s, 41, "exx");
259
    new_cons("floating_test", s, 42, "?[n]eNlxx");
260
    new_cons("goto", s, 43, "l");
261
    new_cons("goto_local_lv", s, 44, "x");
262
    new_cons("identify", s, 45, "?[u]t^x{x}");
263
    new_cons("ignorable", s, 46, "x");
264
    new_cons("imaginary_part", s, 47, "x");
265
    new_cons("initial_value", s, 48, "{x}");
266
    new_cons("integer_test", s, 49, "?[n]Nlxx");
267
    new_cons("labelled", s, 50, "*[l&]{x*[x]}");
268
    new_cons("last_local", s, 51, "x");
269
    new_cons("local_alloc", s, 52, "x");
270
    new_cons("local_alloc_check", s, 53, "x");
271
    new_cons("local_free", s, 54, "xx");
272
    new_cons("local_free_all", s, 55,(char *)null);
273
    new_cons("long_jump", s, 56, "xx");
274
    new_cons("make_complex", s, 57, "fxx");
275
    new_cons("make_compound", s, 58, "x*[x]");
276
    new_cons("make_floating", s, 59, "frbXns");
277
    new_cons("make_general_proc", s, 60, "S?[P]*[S?[u]t&]*[S?[u]t&]{x}");
278
    new_cons("make_int", s, 61, "vs");
279
    new_cons("make_local_lv", s, 62, "l");
280
    new_cons("make_nof", s, 63, "*[x]");
281
    new_cons("make_nof_int", s, 64, "vX");
282
    new_cons("make_null_local_lv", s, 65,(char *)null);
283
    new_cons("make_null_proc", s, 66,(char *)null);
284
    new_cons("make_null_ptr", s, 67, "a");
285
    new_cons("make_proc", s, 68, "S*[S?[u]t&]?[t&?[u]]{x}");
286
    new_cons("make_stack_limit", s, 116, "xxx");
287
    new_cons("make_top", s, 69,(char *)null);
288
    new_cons("make_value", s, 70, "S");
289
    new_cons("maximum", s, 71, "xx");
290
    new_cons("minimum", s, 72, "xx");
291
    new_cons("minus", s, 73, "exx");
292
    new_cons("move_some", s, 74, "mxxx");
293
    new_cons("mult", s, 75, "exx");
294
    new_cons("n_copies", s, 76, "nx");
295
    new_cons("negate", s, 77, "ex");
296
    new_cons("not", s, 78, "x");
297
    new_cons("obtain_tag", s, 79, "t");
298
    new_cons("offset_add", s, 80, "xx");
299
    new_cons("offset_div", s, 81, "vxx");
300
    new_cons("offset_div_by_int", s, 82, "xx");
301
    new_cons("offset_max", s, 83, "xx");
302
    new_cons("offset_mult", s, 84, "xx");
303
    new_cons("offset_negate", s, 85, "x");
304
    new_cons("offset_pad", s, 86, "ax");
305
    new_cons("offset_subtract", s, 87, "xx");
306
    new_cons("offset_test", s, 88, "?[n]Nlxx");
307
    new_cons("offset_zero", s, 89, "a");
308
    new_cons("or", s, 90, "xx");
309
    new_cons("plus", s, 91, "exx");
310
    new_cons("pointer_test", s, 92, "?[n]Nlxx");
311
    new_cons("power", s, 93, "exx");
312
    new_cons("proc_test", s, 94, "?[n]Nlxx");
313
    new_cons("profile", s, 95, "n");
314
    new_cons("real_part", s, 96, "x");
315
    new_cons("rem0", s, 97, "eexx");
316
    new_cons("rem1", s, 98, "eexx");
317
    new_cons("rem2", s, 99, "eexx");
318
    new_cons("repeat", s, 100, "l&{xx}");
319
    new_cons("return", s, 101, "x");
320
    new_cons("return_to_label", s, 102, "x");
321
    new_cons("round_with_mode", s, 103, "ervx");
322
    new_cons("rotate_left", s, 104, "xx");
323
    new_cons("rotate_right", s, 105, "xx");
324
    new_cons("sequence", s, 106, "*[x]x");
325
    new_cons("set_stack_limit", s, 107, "x");
326
    new_cons("shape_offset", s, 108, "S");
327
    new_cons("shift_left", s, 109, "exx");
328
    new_cons("shift_right", s, 110, "xx");
329
    new_cons("subtract_ptrs", s, 111, "xx");
330
    new_cons("tail_call", s, 112, "?[P]xq");
331
    new_cons("untidy_return", s, 113, "x");
332
    new_cons("variable", s, 114, "?[u]t&x{x}");
333
    new_cons("xor", s, 115, "xx");
2 7u83 334
 
7 7u83 335
    s = SORT_floating_variety;
336
    sort_letters[s] = 'f';
337
    sort_encoding[s] = 3;
338
    sort_extension[s] = 1;
339
    sort_decode[s] = de_floating_variety;
340
    sort_read[s] = read_floating_variety;
341
    new_sort(s, 7);
342
    new_cons("flvar_apply_token", s, 1, "!");
343
    sort_tokens[s] = 1;
344
    new_cons("flvar_cond", s, 2, "x@[f]@[f]");
345
    sort_conds[s] = 2;
346
    new_cons("flvar_parms", s, 3, "nnnn");
347
    new_cons("complex_parms", s, 4, "nnnn");
348
    new_cons("float_of_complex", s, 5, "S");
349
    new_cons("complex_of_float", s, 6, "S");
2 7u83 350
 
7 7u83 351
    s = SORT_label;
352
    sort_letters[s] = 'l';
353
    sort_encoding[s] = 1;
354
    sort_extension[s] = 1;
355
    sort_decode[s] = de_label;
356
    sort_read[s] = read_label;
357
    new_sort(s, 3);
358
    new_cons("label_apply_token", s, 2, "!");
359
    sort_tokens[s] = 2;
360
    new_cons("make_label", s, 1, "i");
2 7u83 361
 
7 7u83 362
    s = SORT_nat;
363
    sort_letters[s] = 'n';
364
    sort_encoding[s] = 3;
365
    sort_extension[s] = 1;
366
    sort_decode[s] = de_nat;
367
    sort_read[s] = read_nat;
368
    new_sort(s, 6);
369
    new_cons("nat_apply_token", s, 1, "!");
370
    sort_tokens[s] = 1;
371
    new_cons("nat_cond", s, 2, "x@[n]@[n]");
372
    sort_conds[s] = 2;
373
    new_cons("computed_nat", s, 3, "x");
374
    new_cons("error_val", s, 4, "c");
375
    new_cons("make_nat", s, 5, "i");
2 7u83 376
 
7 7u83 377
    s = SORT_ntest;
378
    sort_letters[s] = 'N';
379
    sort_encoding[s] = 4;
380
    sort_extension[s] = 1;
381
    sort_decode[s] = de_ntest;
382
    sort_read[s] = read_ntest;
383
    new_sort(s, 17);
384
    new_cons("ntest_apply_token", s, 1, "!");
385
    sort_tokens[s] = 1;
386
    new_cons("ntest_cond", s, 2, "x@[N]@[N]");
387
    sort_conds[s] = 2;
388
    new_cons("equal", s, 3,(char *)null);
389
    new_cons("greater_than", s, 4,(char *)null);
390
    new_cons("greater_than_or_equal", s, 5,(char *)null);
391
    new_cons("less_than", s, 6,(char *)null);
392
    new_cons("less_than_or_equal", s, 7,(char *)null);
393
    new_cons("not_equal", s, 8,(char *)null);
394
    new_cons("not_greater_than", s, 9,(char *)null);
395
    new_cons("not_greater_than_or_equal", s, 10,(char *)null);
396
    new_cons("not_less_than", s, 11,(char *)null);
397
    new_cons("not_less_than_or_equal", s, 12,(char *)null);
398
    new_cons("less_than_or_greater_than", s, 13,(char *)null);
399
    new_cons("not_less_than_and_not_greater_than", s, 14,(char *)null);
400
    new_cons("comparable", s, 15,(char *)null);
401
    new_cons("not_comparable", s, 16,(char *)null);
2 7u83 402
 
7 7u83 403
    s = SORT_procprops;
404
    sort_letters[s] = 'P';
405
    sort_encoding[s] = 4;
406
    sort_extension[s] = 1;
407
    sort_decode[s] = de_procprops;
408
    sort_read[s] = read_procprops;
409
    new_sort(s, 10);
410
    new_cons("procprops_apply_token", s, 1, "!");
411
    sort_tokens[s] = 1;
412
    new_cons("procprops_cond", s, 2, "x@[P]@[P]");
413
    sort_conds[s] = 2;
414
    new_cons("add_procprops", s, 3, "PP");
415
    new_cons("check_stack", s, 4,(char *)null);
416
    new_cons("inline", s, 5,(char *)null);
417
    new_cons("no_long_jump_dest", s, 6,(char *)null);
418
    new_cons("untidy", s, 7,(char *)null);
419
    new_cons("var_callees", s, 8,(char *)null);
420
    new_cons("var_callers", s, 9,(char *)null);
2 7u83 421
 
7 7u83 422
    s = SORT_rounding_mode;
423
    sort_letters[s] = 'r';
424
    sort_encoding[s] = 3;
425
    sort_extension[s] = 1;
426
    sort_decode[s] = de_rounding_mode;
427
    sort_read[s] = read_rounding_mode;
428
    new_sort(s, 8);
429
    new_cons("rounding_mode_apply_token", s, 1, "!");
430
    sort_tokens[s] = 1;
431
    new_cons("rounding_mode_cond", s, 2, "x@[r]@[r]");
432
    sort_conds[s] = 2;
433
    new_cons("round_as_state", s, 3,(char *)null);
434
    new_cons("to_nearest", s, 4,(char *)null);
435
    new_cons("toward_larger", s, 5,(char *)null);
436
    new_cons("toward_smaller", s, 6,(char *)null);
437
    new_cons("toward_zero", s, 7,(char *)null);
2 7u83 438
 
7 7u83 439
    s = SORT_shape;
440
    sort_letters[s] = 'S';
441
    sort_encoding[s] = 4;
442
    sort_extension[s] = 1;
443
    sort_decode[s] = de_shape;
444
    sort_read[s] = read_shape;
445
    new_sort(s, 13);
446
    new_cons("shape_apply_token", s, 1, "!");
447
    sort_tokens[s] = 1;
448
    new_cons("shape_cond", s, 2, "x@[S]@[S]");
449
    sort_conds[s] = 2;
450
    new_cons("bitfield", s, 3, "B");
451
    new_cons("bottom", s, 4,(char *)null);
452
    new_cons("compound", s, 5, "x");
453
    new_cons("floating", s, 6, "f");
454
    new_cons("integer", s, 7, "v");
455
    new_cons("nof", s, 8, "nS");
456
    new_cons("offset", s, 9, "aa");
457
    new_cons("pointer", s, 10, "a");
458
    new_cons("proc", s, 11,(char *)null);
459
    new_cons("top", s, 12,(char *)null);
2 7u83 460
 
7 7u83 461
    s = SORT_signed_nat;
462
    sort_letters[s] = 's';
463
    sort_encoding[s] = 3;
464
    sort_extension[s] = 1;
465
    sort_decode[s] = de_signed_nat;
466
    sort_read[s] = read_signed_nat;
467
    new_sort(s, 6);
468
    new_cons("signed_nat_apply_token", s, 1, "!");
469
    sort_tokens[s] = 1;
470
    new_cons("signed_nat_cond", s, 2, "x@[s]@[s]");
471
    sort_conds[s] = 2;
472
    new_cons("computed_signed_nat", s, 3, "x");
473
    new_cons("make_signed_nat", s, 4, "ji");
474
    new_cons("snat_from_nat", s, 5, "bn");
2 7u83 475
 
7 7u83 476
    s = SORT_sortname;
477
    new_sort(s, 24);
478
    new_cons("access", s, 1,(char *)null);
479
    new_cons("al_tag", s, 2,(char *)null);
480
    new_cons("alignment", s, 3,(char *)null);
481
    new_cons("bitfield_variety", s, 4,(char *)null);
482
    new_cons("bool", s, 5,(char *)null);
483
    new_cons("error_treatment", s, 6,(char *)null);
484
    new_cons("exp", s, 7,(char *)null);
485
    new_cons("floating_variety", s, 8,(char *)null);
486
    new_cons("foreign_sort", s, 9, "X");
487
    new_cons("label", s, 10,(char *)null);
488
    new_cons("nat", s, 11,(char *)null);
489
    new_cons("ntest", s, 12,(char *)null);
490
    new_cons("procprops", s, 13,(char *)null);
491
    new_cons("rounding_mode", s, 14,(char *)null);
492
    new_cons("shape", s, 15,(char *)null);
493
    new_cons("signed_nat", s, 16,(char *)null);
494
    new_cons("string", s, 17,(char *)null);
495
    new_cons("tag", s, 18,(char *)null);
496
    new_cons("transfer_mode", s, 19,(char *)null);
497
    new_cons("token", s, 20, "~*[~]");
498
    new_cons("variety", s, 21,(char *)null);
499
    new_cons("callees", s, 22,(char *)null);
500
    new_cons("error_code", s, 23,(char *)null);
2 7u83 501
 
7 7u83 502
    s = SORT_string;
503
    sort_letters[s] = 'X';
504
    sort_encoding[s] = 3;
505
    sort_extension[s] = 1;
506
    sort_decode[s] = de_string;
507
    sort_read[s] = read_string;
508
    new_sort(s, 5);
509
    new_cons("string_apply_token", s, 1, "!");
510
    sort_tokens[s] = 1;
511
    new_cons("string_cond", s, 2, "x@[X]@[X]");
512
    sort_conds[s] = 2;
513
    new_cons("concat_string", s, 3, "XX");
514
    new_cons("make_string", s, 4, "$");
2 7u83 515
 
7 7u83 516
    s = SORT_tag;
517
    sort_letters[s] = 't';
518
    sort_encoding[s] = 1;
519
    sort_extension[s] = 1;
520
    sort_decode[s] = de_tag;
521
    sort_read[s] = read_tag;
522
    new_sort(s, 3);
523
    new_cons("tag_apply_token", s, 2, "!");
524
    sort_tokens[s] = 2;
525
    new_cons("make_tag", s, 1, "i");
2 7u83 526
 
7 7u83 527
    s = SORT_transfer_mode;
528
    sort_letters[s] = 'm';
529
    sort_encoding[s] = 3;
530
    sort_extension[s] = 1;
531
    sort_decode[s] = de_transfer_mode;
532
    sort_read[s] = read_transfer_mode;
533
    new_sort(s, 9);
534
    new_cons("transfer_mode_apply_token", s, 1, "!");
535
    sort_tokens[s] = 1;
536
    new_cons("transfer_mode_cond", s, 2, "x@[m]@[m]");
537
    sort_conds[s] = 2;
538
    new_cons("add_modes", s, 3, "mm");
539
    new_cons("overlap", s, 4,(char *)null);
540
    new_cons("standard_transfer_mode", s, 5,(char *)null);
541
    new_cons("trap_on_nil", s, 6,(char *)null);
542
    new_cons("volatile", s, 7,(char *)null);
543
    new_cons("complete", s, 8,(char *)null);
2 7u83 544
 
7 7u83 545
    s = SORT_variety;
546
    sort_letters[s] = 'v';
547
    sort_encoding[s] = 2;
548
    sort_extension[s] = 1;
549
    sort_decode[s] = de_variety;
550
    sort_read[s] = read_variety;
551
    new_sort(s, 5);
552
    new_cons("var_apply_token", s, 1, "!");
553
    sort_tokens[s] = 1;
554
    new_cons("var_cond", s, 2, "x@[v]@[v]");
555
    sort_conds[s] = 2;
556
    new_cons("var_limits", s, 3, "ss");
557
    new_cons("var_width", s, 4, "bn");
558
    return;
2 7u83 559
}
560
 
561
 
562
/* FIND A SORT NAME */
563
 
7 7u83 564
sortname
565
find_sort(char c)
2 7u83 566
{
7 7u83 567
    sortname s;
568
    switch (c) {
569
	case 'u': s = SORT_access; break;
570
	case 'A': s = SORT_al_tag; break;
571
	case 'a': s = SORT_alignment; break;
572
	case 'B': s = SORT_bitfield_variety; break;
573
	case 'b': s = SORT_bool; break;
574
	case 'q': s = SORT_callees; break;
575
	case 'c': s = SORT_error_code; break;
576
	case 'e': s = SORT_error_treatment; break;
577
	case 'x': s = SORT_exp; break;
578
	case 'f': s = SORT_floating_variety; break;
579
	case 'l': s = SORT_label; break;
580
	case 'n': s = SORT_nat; break;
581
	case 'N': s = SORT_ntest; break;
582
	case 'P': s = SORT_procprops; break;
583
	case 'r': s = SORT_rounding_mode; break;
584
	case 'S': s = SORT_shape; break;
585
	case 's': s = SORT_signed_nat; break;
586
	case 'X': s = SORT_string; break;
587
	case 't': s = SORT_tag; break;
588
	case 'm': s = SORT_transfer_mode; break;
589
	case 'v': s = SORT_variety; break;
2 7u83 590
	default : {
7 7u83 591
	    input_error("Illegal decode letter, %c", c);
592
	    s = SORT_unknown;
593
	    break;
2 7u83 594
	}
595
    }
7 7u83 596
    return(s);
2 7u83 597
}
598
 
599
 
600
/* DECODE A ACCESS */
601
 
7 7u83 602
node *
603
de_access(void)
2 7u83 604
{
7 7u83 605
    long n = fetch_extn(4);
606
    char *args;
607
    node *p = new_node();
608
    construct *cons = cons_no(SORT_access, n);
609
    p->cons = cons;
610
    if (n < 1 || n > 13 || cons->name == null) {
611
	input_error("Illegal access value, %ld", n);
2 7u83 612
    }
7 7u83 613
    switch (n) {
614
	case 1: {
615
	    IGNORE de_token(p, SORT_access);
616
	    break;
2 7u83 617
	}
7 7u83 618
	case 2: {
619
	    args = get_char_info(cons);
620
	    p->son = de_node(args);
621
	    if (do_check) {
622
		checking = "access_cond";
623
		IGNORE check1(ENC_integer, p->son);
2 7u83 624
	    }
7 7u83 625
	    break;
2 7u83 626
	}
627
	default : {
7 7u83 628
	    args = get_char_info(cons);
629
	    if (args) {
630
		p->son = de_node(args);
631
	    }
632
	    break;
2 7u83 633
	}
634
    }
635
#ifdef check_access
7 7u83 636
    check_access(p);
2 7u83 637
#endif
7 7u83 638
    return(p);
2 7u83 639
}
640
 
641
 
642
/* DECODE A AL_TAG */
643
 
7 7u83 644
node *
645
de_al_tag(void)
2 7u83 646
{
7 7u83 647
    long n = fetch_extn(1);
648
    char *args;
649
    node *p = new_node();
650
    construct *cons = cons_no(SORT_al_tag, n);
651
    p->cons = cons;
652
    if (n < 1 || n > 2 || cons->name == null) {
653
	input_error("Illegal al_tag value, %ld", n);
2 7u83 654
    }
7 7u83 655
    switch (n) {
656
	case 2: {
657
	    IGNORE de_token(p, SORT_al_tag);
658
	    break;
2 7u83 659
	}
7 7u83 660
	case 1: {
661
	    p->son = de_var_sort(al_tag_var);
662
	    break;
2 7u83 663
	}
664
	default : {
7 7u83 665
	    args = get_char_info(cons);
666
	    if (args) {
667
		p->son = de_node(args);
668
	    }
669
	    break;
2 7u83 670
	}
671
    }
672
#ifdef check_al_tag
7 7u83 673
    check_al_tag(p);
2 7u83 674
#endif
7 7u83 675
    return(p);
2 7u83 676
}
677
 
678
 
679
/* DECODE A AL_TAGDEF */
680
 
7 7u83 681
long
682
de_al_tagdef_bits(void)
2 7u83 683
{
7 7u83 684
    long n = fetch_extn(1);
685
    if (n < 1 || n > 1) {
686
	input_error("Illegal al_tagdef value, %ld", n);
2 7u83 687
    }
7 7u83 688
    return(n);
2 7u83 689
}
690
 
691
 
692
/* DECODE A ALIGNMENT */
693
 
7 7u83 694
node *
695
de_alignment(void)
2 7u83 696
{
7 7u83 697
    long n = fetch_extn(4);
698
    char *args;
699
    node *p = new_node();
700
    construct *cons = cons_no(SORT_alignment, n);
701
    p->cons = cons;
702
    if (n < 1 || n > 12 || cons->name == null) {
703
	input_error("Illegal alignment value, %ld", n);
2 7u83 704
    }
7 7u83 705
    switch (n) {
706
	case 1: {
707
	    IGNORE de_token(p, SORT_alignment);
708
	    break;
2 7u83 709
	}
7 7u83 710
	case 2: {
711
	    args = get_char_info(cons);
712
	    p->son = de_node(args);
713
	    if (do_check) {
714
		checking = "alignment_cond";
715
		IGNORE check1(ENC_integer, p->son);
2 7u83 716
	    }
7 7u83 717
	    break;
2 7u83 718
	}
719
	default : {
7 7u83 720
	    args = get_char_info(cons);
721
	    if (args) {
722
		p->son = de_node(args);
723
	    }
724
	    break;
2 7u83 725
	}
726
    }
727
#ifdef check_alignment
7 7u83 728
    check_alignment(p);
2 7u83 729
#endif
7 7u83 730
    return(p);
2 7u83 731
}
732
 
733
 
734
/* DECODE A BITFIELD_VARIETY */
735
 
7 7u83 736
node *
737
de_bitfield_variety(void)
2 7u83 738
{
7 7u83 739
    long n = fetch_extn(2);
740
    char *args;
741
    node *p = new_node();
742
    construct *cons = cons_no(SORT_bitfield_variety, n);
743
    p->cons = cons;
744
    if (n < 1 || n > 3 || cons->name == null) {
745
	input_error("Illegal bitfield_variety value, %ld", n);
2 7u83 746
    }
7 7u83 747
    switch (n) {
748
	case 1: {
749
	    IGNORE de_token(p, SORT_bitfield_variety);
750
	    break;
2 7u83 751
	}
7 7u83 752
	case 2: {
753
	    args = get_char_info(cons);
754
	    p->son = de_node(args);
755
	    if (do_check) {
756
		checking = "bfvar_cond";
757
		IGNORE check1(ENC_integer, p->son);
2 7u83 758
	    }
7 7u83 759
	    break;
2 7u83 760
	}
761
	default : {
7 7u83 762
	    args = get_char_info(cons);
763
	    if (args) {
764
		p->son = de_node(args);
765
	    }
766
	    break;
2 7u83 767
	}
768
    }
769
#ifdef check_bitfield_variety
7 7u83 770
    check_bitfield_variety(p);
2 7u83 771
#endif
7 7u83 772
    return(p);
2 7u83 773
}
774
 
775
 
776
/* DECODE A BOOL */
777
 
7 7u83 778
node *
779
de_bool(void)
2 7u83 780
{
7 7u83 781
    long n = fetch_extn(3);
782
    char *args;
783
    node *p = new_node();
784
    construct *cons = cons_no(SORT_bool, n);
785
    p->cons = cons;
786
    if (n < 1 || n > 4 || cons->name == null) {
787
	input_error("Illegal bool value, %ld", n);
2 7u83 788
    }
7 7u83 789
    switch (n) {
790
	case 1: {
791
	    IGNORE de_token(p, SORT_bool);
792
	    break;
2 7u83 793
	}
7 7u83 794
	case 2: {
795
	    args = get_char_info(cons);
796
	    p->son = de_node(args);
797
	    if (do_check) {
798
		checking = "bool_cond";
799
		IGNORE check1(ENC_integer, p->son);
2 7u83 800
	    }
7 7u83 801
	    break;
2 7u83 802
	}
803
	default : {
7 7u83 804
	    args = get_char_info(cons);
805
	    if (args) {
806
		p->son = de_node(args);
807
	    }
808
	    break;
2 7u83 809
	}
810
    }
811
#ifdef check_bool
7 7u83 812
    check_bool(p);
2 7u83 813
#endif
7 7u83 814
    return(p);
2 7u83 815
}
816
 
817
 
818
/* DECODE A CALLEES */
819
 
7 7u83 820
node *
821
de_callees(void)
2 7u83 822
{
7 7u83 823
    long n = fetch_extn(2);
824
    char *args;
825
    node *p = new_node();
826
    construct *cons = cons_no(SORT_callees, n);
827
    p->cons = cons;
828
    if (n < 1 || n > 3 || cons->name == null) {
829
	input_error("Illegal callees value, %ld", n);
2 7u83 830
    }
7 7u83 831
    args = get_char_info(cons);
832
    if (args) {
833
	p->son = de_node(args);
834
    }
2 7u83 835
#ifdef check_callees
7 7u83 836
    check_callees(p);
2 7u83 837
#endif
7 7u83 838
    return(p);
2 7u83 839
}
840
 
841
 
842
/* DECODE A ERROR_CODE */
843
 
7 7u83 844
node *
845
de_error_code(void)
2 7u83 846
{
7 7u83 847
    long n = fetch_extn(2);
848
    char *args;
849
    node *p = new_node();
850
    construct *cons = cons_no(SORT_error_code, n);
851
    p->cons = cons;
852
    if (n < 1 || n > 3 || cons->name == null) {
853
	input_error("Illegal error_code value, %ld", n);
2 7u83 854
    }
7 7u83 855
    args = get_char_info(cons);
856
    if (args) {
857
	p->son = de_node(args);
858
    }
2 7u83 859
#ifdef check_error_code
7 7u83 860
    check_error_code(p);
2 7u83 861
#endif
7 7u83 862
    return(p);
2 7u83 863
}
864
 
865
 
866
/* DECODE A ERROR_TREATMENT */
867
 
7 7u83 868
node *
869
de_error_treatment(void)
2 7u83 870
{
7 7u83 871
    long n = fetch_extn(3);
872
    char *args;
873
    node *p = new_node();
874
    construct *cons = cons_no(SORT_error_treatment, n);
875
    p->cons = cons;
876
    if (n < 1 || n > 7 || cons->name == null) {
877
	input_error("Illegal error_treatment value, %ld", n);
2 7u83 878
    }
7 7u83 879
    switch (n) {
880
	case 1: {
881
	    IGNORE de_token(p, SORT_error_treatment);
882
	    break;
2 7u83 883
	}
7 7u83 884
	case 2: {
885
	    args = get_char_info(cons);
886
	    p->son = de_node(args);
887
	    if (do_check) {
888
		checking = "errt_cond";
889
		IGNORE check1(ENC_integer, p->son);
2 7u83 890
	    }
7 7u83 891
	    break;
2 7u83 892
	}
893
	default : {
7 7u83 894
	    args = get_char_info(cons);
895
	    if (args) {
896
		p->son = de_node(args);
897
	    }
898
	    break;
2 7u83 899
	}
900
    }
901
#ifdef check_error_treatment
7 7u83 902
    check_error_treatment(p);
2 7u83 903
#endif
7 7u83 904
    return(p);
2 7u83 905
}
906
 
907
 
908
/* DECODE A EXP */
909
 
7 7u83 910
node *
911
de_exp(void)
2 7u83 912
{
7 7u83 913
    long n = fetch_extn(7);
914
    char *args;
915
    node *p = new_node();
916
    construct *cons = cons_no(SORT_exp, n);
917
    p->cons = cons;
918
    if (n < 1 || n > 116 || cons->name == null) {
919
	input_error("Illegal exp value, %ld", n);
2 7u83 920
    }
7 7u83 921
    switch (n) {
922
	case 1: {
923
	    IGNORE de_token(p, SORT_exp);
924
	    break;
2 7u83 925
	}
7 7u83 926
	case 2: {
927
	    args = get_char_info(cons);
928
	    p->son = de_node(args);
929
	    if (do_check) {
930
		checking = "exp_cond";
931
		IGNORE check1(ENC_integer, p->son);
2 7u83 932
	    }
7 7u83 933
	    break;
2 7u83 934
	}
935
	default : {
7 7u83 936
	    args = get_char_info(cons);
937
	    if (args) {
938
		p->son = de_node(args);
939
	    }
940
	    break;
2 7u83 941
	}
942
    }
943
#ifdef check_exp
7 7u83 944
    check_exp(p);
2 7u83 945
#endif
7 7u83 946
    return(p);
2 7u83 947
}
948
 
949
 
950
/* DECODE A EXTERNAL */
951
 
7 7u83 952
long
953
de_external_bits(void)
2 7u83 954
{
7 7u83 955
    long n = fetch_extn(2);
956
    if (n < 1 || n > 3) {
957
	input_error("Illegal external value, %ld", n);
2 7u83 958
    }
7 7u83 959
    return(n);
2 7u83 960
}
961
 
962
 
963
/* DECODE A FLOATING_VARIETY */
964
 
7 7u83 965
node *
966
de_floating_variety(void)
2 7u83 967
{
7 7u83 968
    long n = fetch_extn(3);
969
    char *args;
970
    node *p = new_node();
971
    construct *cons = cons_no(SORT_floating_variety, n);
972
    p->cons = cons;
973
    if (n < 1 || n > 6 || cons->name == null) {
974
	input_error("Illegal floating_variety value, %ld", n);
2 7u83 975
    }
7 7u83 976
    switch (n) {
977
	case 1: {
978
	    IGNORE de_token(p, SORT_floating_variety);
979
	    break;
2 7u83 980
	}
7 7u83 981
	case 2: {
982
	    args = get_char_info(cons);
983
	    p->son = de_node(args);
984
	    if (do_check) {
985
		checking = "flvar_cond";
986
		IGNORE check1(ENC_integer, p->son);
2 7u83 987
	    }
7 7u83 988
	    break;
2 7u83 989
	}
990
	default : {
7 7u83 991
	    args = get_char_info(cons);
992
	    if (args) {
993
		p->son = de_node(args);
994
	    }
995
	    break;
2 7u83 996
	}
997
    }
998
#ifdef check_floating_variety
7 7u83 999
    check_floating_variety(p);
2 7u83 1000
#endif
7 7u83 1001
    return(p);
2 7u83 1002
}
1003
 
1004
 
1005
/* DECODE A LABEL */
1006
 
7 7u83 1007
node *
1008
de_label(void)
2 7u83 1009
{
7 7u83 1010
    long n = fetch_extn(1);
1011
    char *args;
1012
    node *p = new_node();
1013
    construct *cons = cons_no(SORT_label, n);
1014
    p->cons = cons;
1015
    if (n < 1 || n > 2 || cons->name == null) {
1016
	input_error("Illegal label value, %ld", n);
2 7u83 1017
    }
7 7u83 1018
    switch (n) {
1019
	case 2: {
1020
	    IGNORE de_token(p, SORT_label);
1021
	    break;
2 7u83 1022
	}
7 7u83 1023
	case 1: {
1024
	    long m = tdf_int();
1025
	    p->son = new_node();
1026
	    p->son->cons = find_label(m);
1027
	    break;
2 7u83 1028
	}
1029
	default : {
7 7u83 1030
	    args = get_char_info(cons);
1031
	    if (args) {
1032
		p->son = de_node(args);
1033
	    }
1034
	    break;
2 7u83 1035
	}
1036
    }
1037
#ifdef check_label
7 7u83 1038
    check_label(p);
2 7u83 1039
#endif
7 7u83 1040
    return(p);
2 7u83 1041
}
1042
 
1043
 
1044
/* DECODE A NAT */
1045
 
7 7u83 1046
node *
1047
de_nat(void)
2 7u83 1048
{
7 7u83 1049
    long n = fetch_extn(3);
1050
    char *args;
1051
    node *p = new_node();
1052
    construct *cons = cons_no(SORT_nat, n);
1053
    p->cons = cons;
1054
    if (n < 1 || n > 5 || cons->name == null) {
1055
	input_error("Illegal nat value, %ld", n);
2 7u83 1056
    }
7 7u83 1057
    switch (n) {
1058
	case 1: {
1059
	    IGNORE de_token(p, SORT_nat);
1060
	    break;
2 7u83 1061
	}
7 7u83 1062
	case 2: {
1063
	    args = get_char_info(cons);
1064
	    p->son = de_node(args);
1065
	    if (do_check) {
1066
		checking = "nat_cond";
1067
		IGNORE check1(ENC_integer, p->son);
2 7u83 1068
	    }
7 7u83 1069
	    break;
2 7u83 1070
	}
1071
	default : {
7 7u83 1072
	    args = get_char_info(cons);
1073
	    if (args) {
1074
		p->son = de_node(args);
1075
	    }
1076
	    break;
2 7u83 1077
	}
1078
    }
1079
#ifdef check_nat
7 7u83 1080
    check_nat(p);
2 7u83 1081
#endif
7 7u83 1082
    return(p);
2 7u83 1083
}
1084
 
1085
 
1086
/* DECODE A NTEST */
1087
 
7 7u83 1088
node *
1089
de_ntest(void)
2 7u83 1090
{
7 7u83 1091
    long n = fetch_extn(4);
1092
    char *args;
1093
    node *p = new_node();
1094
    construct *cons = cons_no(SORT_ntest, n);
1095
    p->cons = cons;
1096
    if (n < 1 || n > 16 || cons->name == null) {
1097
	input_error("Illegal ntest value, %ld", n);
2 7u83 1098
    }
7 7u83 1099
    switch (n) {
1100
	case 1: {
1101
	    IGNORE de_token(p, SORT_ntest);
1102
	    break;
2 7u83 1103
	}
7 7u83 1104
	case 2: {
1105
	    args = get_char_info(cons);
1106
	    p->son = de_node(args);
1107
	    if (do_check) {
1108
		checking = "ntest_cond";
1109
		IGNORE check1(ENC_integer, p->son);
2 7u83 1110
	    }
7 7u83 1111
	    break;
2 7u83 1112
	}
1113
	default : {
7 7u83 1114
	    args = get_char_info(cons);
1115
	    if (args) {
1116
		p->son = de_node(args);
1117
	    }
1118
	    break;
2 7u83 1119
	}
1120
    }
1121
#ifdef check_ntest
7 7u83 1122
    check_ntest(p);
2 7u83 1123
#endif
7 7u83 1124
    return(p);
2 7u83 1125
}
1126
 
1127
 
1128
/* DECODE A PROCPROPS */
1129
 
7 7u83 1130
node *
1131
de_procprops(void)
2 7u83 1132
{
7 7u83 1133
    long n = fetch_extn(4);
1134
    char *args;
1135
    node *p = new_node();
1136
    construct *cons = cons_no(SORT_procprops, n);
1137
    p->cons = cons;
1138
    if (n < 1 || n > 9 || cons->name == null) {
1139
	input_error("Illegal procprops value, %ld", n);
2 7u83 1140
    }
7 7u83 1141
    switch (n) {
1142
	case 1: {
1143
	    IGNORE de_token(p, SORT_procprops);
1144
	    break;
2 7u83 1145
	}
7 7u83 1146
	case 2: {
1147
	    args = get_char_info(cons);
1148
	    p->son = de_node(args);
1149
	    if (do_check) {
1150
		checking = "procprops_cond";
1151
		IGNORE check1(ENC_integer, p->son);
2 7u83 1152
	    }
7 7u83 1153
	    break;
2 7u83 1154
	}
1155
	default : {
7 7u83 1156
	    args = get_char_info(cons);
1157
	    if (args) {
1158
		p->son = de_node(args);
1159
	    }
1160
	    break;
2 7u83 1161
	}
1162
    }
1163
#ifdef check_procprops
7 7u83 1164
    check_procprops(p);
2 7u83 1165
#endif
7 7u83 1166
    return(p);
2 7u83 1167
}
1168
 
1169
 
1170
/* DECODE A ROUNDING_MODE */
1171
 
7 7u83 1172
node *
1173
de_rounding_mode(void)
2 7u83 1174
{
7 7u83 1175
    long n = fetch_extn(3);
1176
    char *args;
1177
    node *p = new_node();
1178
    construct *cons = cons_no(SORT_rounding_mode, n);
1179
    p->cons = cons;
1180
    if (n < 1 || n > 7 || cons->name == null) {
1181
	input_error("Illegal rounding_mode value, %ld", n);
2 7u83 1182
    }
7 7u83 1183
    switch (n) {
1184
	case 1: {
1185
	    IGNORE de_token(p, SORT_rounding_mode);
1186
	    break;
2 7u83 1187
	}
7 7u83 1188
	case 2: {
1189
	    args = get_char_info(cons);
1190
	    p->son = de_node(args);
1191
	    if (do_check) {
1192
		checking = "rounding_mode_cond";
1193
		IGNORE check1(ENC_integer, p->son);
2 7u83 1194
	    }
7 7u83 1195
	    break;
2 7u83 1196
	}
1197
	default : {
7 7u83 1198
	    args = get_char_info(cons);
1199
	    if (args) {
1200
		p->son = de_node(args);
1201
	    }
1202
	    break;
2 7u83 1203
	}
1204
    }
1205
#ifdef check_rounding_mode
7 7u83 1206
    check_rounding_mode(p);
2 7u83 1207
#endif
7 7u83 1208
    return(p);
2 7u83 1209
}
1210
 
1211
 
1212
/* DECODE A SHAPE */
1213
 
7 7u83 1214
node *
1215
de_shape(void)
2 7u83 1216
{
7 7u83 1217
    long n = fetch_extn(4);
1218
    char *args;
1219
    node *p = new_node();
1220
    construct *cons = cons_no(SORT_shape, n);
1221
    p->cons = cons;
1222
    if (n < 1 || n > 12 || cons->name == null) {
1223
	input_error("Illegal shape value, %ld", n);
2 7u83 1224
    }
7 7u83 1225
    switch (n) {
1226
	case 1: {
1227
	    IGNORE de_token(p, SORT_shape);
1228
	    break;
2 7u83 1229
	}
7 7u83 1230
	case 2: {
1231
	    args = get_char_info(cons);
1232
	    p->son = de_node(args);
1233
	    if (do_check) {
1234
		checking = "shape_cond";
1235
		IGNORE check1(ENC_integer, p->son);
2 7u83 1236
	    }
7 7u83 1237
	    break;
2 7u83 1238
	}
1239
	default : {
7 7u83 1240
	    args = get_char_info(cons);
1241
	    if (args) {
1242
		p->son = de_node(args);
1243
	    }
1244
	    break;
2 7u83 1245
	}
1246
    }
1247
#ifdef check_shape
7 7u83 1248
    check_shape(p);
2 7u83 1249
#endif
7 7u83 1250
    return(p);
2 7u83 1251
}
1252
 
1253
 
1254
/* DECODE A SIGNED_NAT */
1255
 
7 7u83 1256
node *
1257
de_signed_nat(void)
2 7u83 1258
{
7 7u83 1259
    long n = fetch_extn(3);
1260
    char *args;
1261
    node *p = new_node();
1262
    construct *cons = cons_no(SORT_signed_nat, n);
1263
    p->cons = cons;
1264
    if (n < 1 || n > 5 || cons->name == null) {
1265
	input_error("Illegal signed_nat value, %ld", n);
2 7u83 1266
    }
7 7u83 1267
    switch (n) {
1268
	case 1: {
1269
	    IGNORE de_token(p, SORT_signed_nat);
1270
	    break;
2 7u83 1271
	}
7 7u83 1272
	case 2: {
1273
	    args = get_char_info(cons);
1274
	    p->son = de_node(args);
1275
	    if (do_check) {
1276
		checking = "signed_nat_cond";
1277
		IGNORE check1(ENC_integer, p->son);
2 7u83 1278
	    }
7 7u83 1279
	    break;
2 7u83 1280
	}
1281
	default : {
7 7u83 1282
	    args = get_char_info(cons);
1283
	    if (args) {
1284
		p->son = de_node(args);
1285
	    }
1286
	    break;
2 7u83 1287
	}
1288
    }
1289
#ifdef check_signed_nat
7 7u83 1290
    check_signed_nat(p);
2 7u83 1291
#endif
7 7u83 1292
    return(p);
2 7u83 1293
}
1294
 
1295
 
1296
/* DECODE A SORTNAME */
1297
 
7 7u83 1298
long
1299
de_sortname_bits(void)
2 7u83 1300
{
7 7u83 1301
    long n = fetch_extn(5);
1302
    if (n < 1 || n > 21) {
1303
	input_error("Illegal sortname value, %ld", n);
2 7u83 1304
    }
7 7u83 1305
    return(n);
2 7u83 1306
}
1307
 
1308
 
1309
/* DECODE A STRING */
1310
 
7 7u83 1311
node *
1312
de_string(void)
2 7u83 1313
{
7 7u83 1314
    long n = fetch_extn(3);
1315
    char *args;
1316
    node *p = new_node();
1317
    construct *cons = cons_no(SORT_string, n);
1318
    p->cons = cons;
1319
    if (n < 1 || n > 4 || cons->name == null) {
1320
	input_error("Illegal string value, %ld", n);
2 7u83 1321
    }
7 7u83 1322
    switch (n) {
1323
	case 1: {
1324
	    IGNORE de_token(p, SORT_string);
1325
	    break;
2 7u83 1326
	}
7 7u83 1327
	case 2: {
1328
	    args = get_char_info(cons);
1329
	    p->son = de_node(args);
1330
	    if (do_check) {
1331
		checking = "string_cond";
1332
		IGNORE check1(ENC_integer, p->son);
2 7u83 1333
	    }
7 7u83 1334
	    break;
2 7u83 1335
	}
1336
	default : {
7 7u83 1337
	    args = get_char_info(cons);
1338
	    if (args) {
1339
		p->son = de_node(args);
1340
	    }
1341
	    break;
2 7u83 1342
	}
1343
    }
1344
#ifdef check_string
7 7u83 1345
    check_string(p);
2 7u83 1346
#endif
7 7u83 1347
    return(p);
2 7u83 1348
}
1349
 
1350
 
1351
/* DECODE A TAG */
1352
 
7 7u83 1353
node *
1354
de_tag(void)
2 7u83 1355
{
7 7u83 1356
    long n = fetch_extn(1);
1357
    char *args;
1358
    node *p = new_node();
1359
    construct *cons = cons_no(SORT_tag, n);
1360
    p->cons = cons;
1361
    if (n < 1 || n > 2 || cons->name == null) {
1362
	input_error("Illegal tag value, %ld", n);
2 7u83 1363
    }
7 7u83 1364
    switch (n) {
1365
	case 2: {
1366
	    IGNORE de_token(p, SORT_tag);
1367
	    break;
2 7u83 1368
	}
7 7u83 1369
	case 1: {
1370
	    p->son = de_var_sort(tag_var);
1371
	    break;
2 7u83 1372
	}
1373
	default : {
7 7u83 1374
	    args = get_char_info(cons);
1375
	    if (args) {
1376
		p->son = de_node(args);
1377
	    }
1378
	    break;
2 7u83 1379
	}
1380
    }
1381
#ifdef check_tag
7 7u83 1382
    check_tag(p);
2 7u83 1383
#endif
7 7u83 1384
    return(p);
2 7u83 1385
}
1386
 
1387
 
1388
/* DECODE A TAGDEC */
1389
 
7 7u83 1390
long
1391
de_tagdec_bits(void)
2 7u83 1392
{
7 7u83 1393
    long n = fetch_extn(2);
1394
    if (n < 1 || n > 3) {
1395
	input_error("Illegal tagdec value, %ld", n);
2 7u83 1396
    }
7 7u83 1397
    return(n);
2 7u83 1398
}
1399
 
1400
 
1401
/* DECODE A TAGDEF */
1402
 
7 7u83 1403
long
1404
de_tagdef_bits(void)
2 7u83 1405
{
7 7u83 1406
    long n = fetch_extn(2);
1407
    if (n < 1 || n > 3) {
1408
	input_error("Illegal tagdef value, %ld", n);
2 7u83 1409
    }
7 7u83 1410
    return(n);
2 7u83 1411
}
1412
 
1413
 
1414
/* DECODE A TOKDEC */
1415
 
7 7u83 1416
long
1417
de_tokdec_bits(void)
2 7u83 1418
{
7 7u83 1419
    long n = fetch_extn(1);
1420
    if (n < 1 || n > 1) {
1421
	input_error("Illegal tokdec value, %ld", n);
2 7u83 1422
    }
7 7u83 1423
    return(n);
2 7u83 1424
}
1425
 
1426
 
1427
/* DECODE A TOKDEF */
1428
 
7 7u83 1429
long
1430
de_tokdef_bits(void)
2 7u83 1431
{
7 7u83 1432
    long n = fetch_extn(1);
1433
    if (n < 1 || n > 1) {
1434
	input_error("Illegal tokdef value, %ld", n);
2 7u83 1435
    }
7 7u83 1436
    return(n);
2 7u83 1437
}
1438
 
1439
 
1440
/* DECODE A TOKEN */
1441
 
7 7u83 1442
long
1443
de_token_bits(void)
2 7u83 1444
{
7 7u83 1445
    long n = fetch_extn(2);
1446
    if (n < 1 || n > 3) {
1447
	input_error("Illegal token value, %ld", n);
2 7u83 1448
    }
7 7u83 1449
    return(n);
2 7u83 1450
}
1451
 
1452
 
1453
/* DECODE A TOKEN_DEFN */
1454
 
7 7u83 1455
long
1456
de_token_defn_bits(void)
2 7u83 1457
{
7 7u83 1458
    long n = fetch_extn(1);
1459
    if (n < 1 || n > 1) {
1460
	input_error("Illegal token_defn value, %ld", n);
2 7u83 1461
    }
7 7u83 1462
    return(n);
2 7u83 1463
}
1464
 
1465
 
1466
/* DECODE A TRANSFER_MODE */
1467
 
7 7u83 1468
node *
1469
de_transfer_mode(void)
2 7u83 1470
{
7 7u83 1471
    long n = fetch_extn(3);
1472
    char *args;
1473
    node *p = new_node();
1474
    construct *cons = cons_no(SORT_transfer_mode, n);
1475
    p->cons = cons;
1476
    if (n < 1 || n > 8 || cons->name == null) {
1477
	input_error("Illegal transfer_mode value, %ld", n);
2 7u83 1478
    }
7 7u83 1479
    switch (n) {
1480
	case 1: {
1481
	    IGNORE de_token(p, SORT_transfer_mode);
1482
	    break;
2 7u83 1483
	}
7 7u83 1484
	case 2: {
1485
	    args = get_char_info(cons);
1486
	    p->son = de_node(args);
1487
	    if (do_check) {
1488
		checking = "transfer_mode_cond";
1489
		IGNORE check1(ENC_integer, p->son);
2 7u83 1490
	    }
7 7u83 1491
	    break;
2 7u83 1492
	}
1493
	default : {
7 7u83 1494
	    args = get_char_info(cons);
1495
	    if (args) {
1496
		p->son = de_node(args);
1497
	    }
1498
	    break;
2 7u83 1499
	}
1500
    }
1501
#ifdef check_transfer_mode
7 7u83 1502
    check_transfer_mode(p);
2 7u83 1503
#endif
7 7u83 1504
    return(p);
2 7u83 1505
}
1506
 
1507
 
1508
/* DECODE A VARIETY */
1509
 
7 7u83 1510
node *
1511
de_variety(void)
2 7u83 1512
{
7 7u83 1513
    long n = fetch_extn(2);
1514
    char *args;
1515
    node *p = new_node();
1516
    construct *cons = cons_no(SORT_variety, n);
1517
    p->cons = cons;
1518
    if (n < 1 || n > 4 || cons->name == null) {
1519
	input_error("Illegal variety value, %ld", n);
2 7u83 1520
    }
7 7u83 1521
    switch (n) {
1522
	case 1: {
1523
	    IGNORE de_token(p, SORT_variety);
1524
	    break;
2 7u83 1525
	}
7 7u83 1526
	case 2: {
1527
	    args = get_char_info(cons);
1528
	    p->son = de_node(args);
1529
	    if (do_check) {
1530
		checking = "var_cond";
1531
		IGNORE check1(ENC_integer, p->son);
2 7u83 1532
	    }
7 7u83 1533
	    break;
2 7u83 1534
	}
1535
	default : {
7 7u83 1536
	    args = get_char_info(cons);
1537
	    if (args) {
1538
		p->son = de_node(args);
1539
	    }
1540
	    break;
2 7u83 1541
	}
1542
    }
1543
#ifdef check_variety
7 7u83 1544
    check_variety(p);
2 7u83 1545
#endif
7 7u83 1546
    return(p);
2 7u83 1547
}
1548
 
1549
 
1550
/* DECODE A VERSION */
1551
 
7 7u83 1552
long
1553
de_version_bits(void)
2 7u83 1554
{
7 7u83 1555
    long n = fetch_extn(1);
1556
    if (n < 1 || n > 2) {
1557
	input_error("Illegal version value, %ld", n);
2 7u83 1558
    }
7 7u83 1559
    return(n);
2 7u83 1560
}
1561
 
1562
 
1563
/* ENCODE A AL_TAG */
1564
 
7 7u83 1565
void
1566
enc_al_tag_bits(bitstream *p, int n)
2 7u83 1567
{
7 7u83 1568
    enc_bits_extn(p, 1,(long)n);
1569
    return;
2 7u83 1570
}
1571
 
1572
 
1573
/* ENCODE A AL_TAGDEF */
1574
 
7 7u83 1575
void
1576
enc_al_tagdef_bits(bitstream *p, int n)
2 7u83 1577
{
7 7u83 1578
    enc_bits_extn(p, 1,(long)n);
1579
    return;
2 7u83 1580
}
1581
 
1582
 
1583
/* ENCODE A EXTERNAL */
1584
 
7 7u83 1585
void
1586
enc_external_bits(bitstream *p, int n)
2 7u83 1587
{
7 7u83 1588
    enc_bits_extn(p, 2,(long)n);
1589
    return;
2 7u83 1590
}
1591
 
1592
 
1593
/* ENCODE A LABEL */
1594
 
7 7u83 1595
void
1596
enc_label_bits(bitstream *p, int n)
2 7u83 1597
{
7 7u83 1598
    enc_bits_extn(p, 1,(long)n);
1599
    return;
2 7u83 1600
}
1601
 
1602
 
1603
/* ENCODE A SORTNAME */
1604
 
7 7u83 1605
void
1606
enc_sortname_bits(bitstream *p, int n)
2 7u83 1607
{
7 7u83 1608
    enc_bits_extn(p, 5,(long)n);
1609
    return;
2 7u83 1610
}
1611
 
1612
 
1613
/* ENCODE A TAG */
1614
 
7 7u83 1615
void
1616
enc_tag_bits(bitstream *p, int n)
2 7u83 1617
{
7 7u83 1618
    enc_bits_extn(p, 1,(long)n);
1619
    return;
2 7u83 1620
}
1621
 
1622
 
1623
/* ENCODE A TAGDEC */
1624
 
7 7u83 1625
void
1626
enc_tagdec_bits(bitstream *p, int n)
2 7u83 1627
{
7 7u83 1628
    enc_bits_extn(p, 2,(long)n);
1629
    return;
2 7u83 1630
}
1631
 
1632
 
1633
/* ENCODE A TAGDEF */
1634
 
7 7u83 1635
void
1636
enc_tagdef_bits(bitstream *p, int n)
2 7u83 1637
{
7 7u83 1638
    enc_bits_extn(p, 2,(long)n);
1639
    return;
2 7u83 1640
}
1641
 
1642
 
1643
/* ENCODE A TOKDEC */
1644
 
7 7u83 1645
void
1646
enc_tokdec_bits(bitstream *p, int n)
2 7u83 1647
{
7 7u83 1648
    enc_bits_extn(p, 1,(long)n);
1649
    return;
2 7u83 1650
}
1651
 
1652
 
1653
/* ENCODE A TOKDEF */
1654
 
7 7u83 1655
void
1656
enc_tokdef_bits(bitstream *p, int n)
2 7u83 1657
{
7 7u83 1658
    enc_bits_extn(p, 1,(long)n);
1659
    return;
2 7u83 1660
}
1661
 
1662
 
1663
/* ENCODE A TOKEN */
1664
 
7 7u83 1665
void
1666
enc_token_bits(bitstream *p, int n)
2 7u83 1667
{
7 7u83 1668
    enc_bits_extn(p, 2,(long)n);
1669
    return;
2 7u83 1670
}
1671
 
1672
 
1673
/* ENCODE A TOKEN_DEFN */
1674
 
7 7u83 1675
void
1676
enc_token_defn_bits(bitstream *p, int n)
2 7u83 1677
{
7 7u83 1678
    enc_bits_extn(p, 1,(long)n);
1679
    return;
2 7u83 1680
}
1681
 
1682
 
1683
/* ENCODE A VERSION */
1684
 
7 7u83 1685
void
1686
enc_version_bits(bitstream *p, int n)
2 7u83 1687
{
7 7u83 1688
    enc_bits_extn(p, 1,(long)n);
1689
    return;
2 7u83 1690
}
1691
 
1692
 
1693
/* READ A ACCESS */
1694
 
7 7u83 1695
node *
1696
read_access(long n)
2 7u83 1697
{
7 7u83 1698
    char *args;
1699
    node *p = new_node();
1700
    construct *cons = cons_no(SORT_access, n);
1701
    p->cons = cons;
1702
    if (n < 0 || n > 13 || cons->name == null) {
1703
	input_error("Illegal access value, %ld", n);
2 7u83 1704
    }
7 7u83 1705
    switch (n) {
1706
	case 1: {
1707
	    read_token(p, SORT_access);
1708
	    break;
2 7u83 1709
	}
7 7u83 1710
	case 2: {
1711
	    args = get_char_info(cons);
1712
	    p->son = read_node(args);
1713
	    if (do_check) {
1714
		checking = "access_cond";
1715
		IGNORE check1(ENC_integer, p->son);
2 7u83 1716
	    }
7 7u83 1717
	    break;
2 7u83 1718
	}
1719
	default : {
7 7u83 1720
	    args = get_char_info(cons);
1721
	    if (args) {
1722
		p->son = read_node(args);
1723
	    }
1724
	    break;
2 7u83 1725
	}
1726
    }
1727
#ifdef check_access
7 7u83 1728
    check_access(p);
2 7u83 1729
#endif
7 7u83 1730
    return(p);
2 7u83 1731
}
1732
 
1733
 
1734
/* READ A AL_TAG */
1735
 
7 7u83 1736
node *
1737
read_al_tag(long n)
2 7u83 1738
{
7 7u83 1739
    char *args;
1740
    node *p = new_node();
1741
    construct *cons = cons_no(SORT_al_tag, n);
1742
    p->cons = cons;
1743
    if (n < 0 || n > 2 || cons->name == null) {
1744
	input_error("Illegal al_tag value, %ld", n);
2 7u83 1745
    }
7 7u83 1746
    switch (n) {
1747
	case 2: {
1748
	    read_token(p, SORT_al_tag);
1749
	    break;
2 7u83 1750
	}
7 7u83 1751
	case 1: {
1752
	    p->son = read_var_sort(SORT_al_tag);
1753
	    break;
2 7u83 1754
	}
1755
	default : {
7 7u83 1756
	    args = get_char_info(cons);
1757
	    if (args) {
1758
		p->son = read_node(args);
1759
	    }
1760
	    break;
2 7u83 1761
	}
1762
    }
1763
#ifdef check_al_tag
7 7u83 1764
    check_al_tag(p);
2 7u83 1765
#endif
7 7u83 1766
    return(p);
2 7u83 1767
}
1768
 
1769
 
1770
/* READ A ALIGNMENT */
1771
 
7 7u83 1772
node *
1773
read_alignment(long n)
2 7u83 1774
{
7 7u83 1775
    char *args;
1776
    node *p = new_node();
1777
    construct *cons = cons_no(SORT_alignment, n);
1778
    p->cons = cons;
1779
    if (n < 0 || n > 12 || cons->name == null) {
1780
	input_error("Illegal alignment value, %ld", n);
2 7u83 1781
    }
7 7u83 1782
    switch (n) {
1783
	case 1: {
1784
	    read_token(p, SORT_alignment);
1785
	    break;
2 7u83 1786
	}
7 7u83 1787
	case 2: {
1788
	    args = get_char_info(cons);
1789
	    p->son = read_node(args);
1790
	    if (do_check) {
1791
		checking = "alignment_cond";
1792
		IGNORE check1(ENC_integer, p->son);
2 7u83 1793
	    }
7 7u83 1794
	    break;
2 7u83 1795
	}
1796
	default : {
7 7u83 1797
	    args = get_char_info(cons);
1798
	    if (args) {
1799
		p->son = read_node(args);
1800
	    }
1801
	    break;
2 7u83 1802
	}
1803
    }
1804
#ifdef check_alignment
7 7u83 1805
    check_alignment(p);
2 7u83 1806
#endif
7 7u83 1807
    return(p);
2 7u83 1808
}
1809
 
1810
 
1811
/* READ A BITFIELD_VARIETY */
1812
 
7 7u83 1813
node *
1814
read_bitfield_variety(long n)
2 7u83 1815
{
7 7u83 1816
    char *args;
1817
    node *p = new_node();
1818
    construct *cons = cons_no(SORT_bitfield_variety, n);
1819
    p->cons = cons;
1820
    if (n < 0 || n > 3 || cons->name == null) {
1821
	input_error("Illegal bitfield_variety value, %ld", n);
2 7u83 1822
    }
7 7u83 1823
    switch (n) {
1824
	case 1: {
1825
	    read_token(p, SORT_bitfield_variety);
1826
	    break;
2 7u83 1827
	}
7 7u83 1828
	case 2: {
1829
	    args = get_char_info(cons);
1830
	    p->son = read_node(args);
1831
	    if (do_check) {
1832
		checking = "bfvar_cond";
1833
		IGNORE check1(ENC_integer, p->son);
2 7u83 1834
	    }
7 7u83 1835
	    break;
2 7u83 1836
	}
1837
	default : {
7 7u83 1838
	    args = get_char_info(cons);
1839
	    if (args) {
1840
		p->son = read_node(args);
1841
	    }
1842
	    break;
2 7u83 1843
	}
1844
    }
1845
#ifdef check_bitfield_variety
7 7u83 1846
    check_bitfield_variety(p);
2 7u83 1847
#endif
7 7u83 1848
    return(p);
2 7u83 1849
}
1850
 
1851
 
1852
/* READ A BOOL */
1853
 
7 7u83 1854
node *
1855
read_bool(long n)
2 7u83 1856
{
7 7u83 1857
    char *args;
1858
    node *p = new_node();
1859
    construct *cons = cons_no(SORT_bool, n);
1860
    p->cons = cons;
1861
    if (n < 0 || n > 4 || cons->name == null) {
1862
	input_error("Illegal bool value, %ld", n);
2 7u83 1863
    }
7 7u83 1864
    switch (n) {
1865
	case 1: {
1866
	    read_token(p, SORT_bool);
1867
	    break;
2 7u83 1868
	}
7 7u83 1869
	case 2: {
1870
	    args = get_char_info(cons);
1871
	    p->son = read_node(args);
1872
	    if (do_check) {
1873
		checking = "bool_cond";
1874
		IGNORE check1(ENC_integer, p->son);
2 7u83 1875
	    }
7 7u83 1876
	    break;
2 7u83 1877
	}
1878
	default : {
7 7u83 1879
	    args = get_char_info(cons);
1880
	    if (args) {
1881
		p->son = read_node(args);
1882
	    }
1883
	    break;
2 7u83 1884
	}
1885
    }
1886
#ifdef check_bool
7 7u83 1887
    check_bool(p);
2 7u83 1888
#endif
7 7u83 1889
    return(p);
2 7u83 1890
}
1891
 
1892
 
1893
/* READ A CALLEES */
1894
 
7 7u83 1895
node *
1896
read_callees(long n)
2 7u83 1897
{
7 7u83 1898
    char *args;
1899
    node *p = new_node();
1900
    construct *cons = cons_no(SORT_callees, n);
1901
    p->cons = cons;
1902
    if (n < 0 || n > 3 || cons->name == null) {
1903
	input_error("Illegal callees value, %ld", n);
2 7u83 1904
    }
7 7u83 1905
    args = get_char_info(cons);
1906
    if (args) {
1907
	p->son = read_node(args);
1908
    }
2 7u83 1909
#ifdef check_callees
7 7u83 1910
    check_callees(p);
2 7u83 1911
#endif
7 7u83 1912
    return(p);
2 7u83 1913
}
1914
 
1915
 
1916
/* READ A ERROR_CODE */
1917
 
7 7u83 1918
node *
1919
read_error_code(long n)
2 7u83 1920
{
7 7u83 1921
    char *args;
1922
    node *p = new_node();
1923
    construct *cons = cons_no(SORT_error_code, n);
1924
    p->cons = cons;
1925
    if (n < 0 || n > 3 || cons->name == null) {
1926
	input_error("Illegal error_code value, %ld", n);
2 7u83 1927
    }
7 7u83 1928
    args = get_char_info(cons);
1929
    if (args) {
1930
	p->son = read_node(args);
1931
    }
2 7u83 1932
#ifdef check_error_code
7 7u83 1933
    check_error_code(p);
2 7u83 1934
#endif
7 7u83 1935
    return(p);
2 7u83 1936
}
1937
 
1938
 
1939
/* READ A ERROR_TREATMENT */
1940
 
7 7u83 1941
node *
1942
read_error_treatment(long n)
2 7u83 1943
{
7 7u83 1944
    char *args;
1945
    node *p = new_node();
1946
    construct *cons = cons_no(SORT_error_treatment, n);
1947
    p->cons = cons;
1948
    if (n < 0 || n > 7 || cons->name == null) {
1949
	input_error("Illegal error_treatment value, %ld", n);
2 7u83 1950
    }
7 7u83 1951
    switch (n) {
1952
	case 1: {
1953
	    read_token(p, SORT_error_treatment);
1954
	    break;
2 7u83 1955
	}
7 7u83 1956
	case 2: {
1957
	    args = get_char_info(cons);
1958
	    p->son = read_node(args);
1959
	    if (do_check) {
1960
		checking = "errt_cond";
1961
		IGNORE check1(ENC_integer, p->son);
2 7u83 1962
	    }
7 7u83 1963
	    break;
2 7u83 1964
	}
1965
	default : {
7 7u83 1966
	    args = get_char_info(cons);
1967
	    if (args) {
1968
		p->son = read_node(args);
1969
	    }
1970
	    break;
2 7u83 1971
	}
1972
    }
1973
#ifdef check_error_treatment
7 7u83 1974
    check_error_treatment(p);
2 7u83 1975
#endif
7 7u83 1976
    return(p);
2 7u83 1977
}
1978
 
1979
 
1980
/* READ A EXP */
1981
 
7 7u83 1982
node *
1983
read_exp(long n)
2 7u83 1984
{
7 7u83 1985
    char *args;
1986
    node *p = new_node();
1987
    construct *cons = cons_no(SORT_exp, n);
1988
    p->cons = cons;
1989
    if (n < 0 || n > 116 || cons->name == null) {
1990
	input_error("Illegal exp value, %ld", n);
2 7u83 1991
    }
7 7u83 1992
    switch (n) {
1993
	case 1: {
1994
	    read_token(p, SORT_exp);
1995
	    break;
2 7u83 1996
	}
7 7u83 1997
	case 2: {
1998
	    args = get_char_info(cons);
1999
	    p->son = read_node(args);
2000
	    if (do_check) {
2001
		checking = "exp_cond";
2002
		IGNORE check1(ENC_integer, p->son);
2 7u83 2003
	    }
7 7u83 2004
	    break;
2 7u83 2005
	}
7 7u83 2006
	case 106: {
2007
	    read_sequence(p, get_char_info(cons));
2008
	    break;
2 7u83 2009
	}
2010
	default : {
7 7u83 2011
	    args = get_char_info(cons);
2012
	    if (args) {
2013
		p->son = read_node(args);
2014
	    }
2015
	    break;
2 7u83 2016
	}
2017
    }
2018
#ifdef check_exp
7 7u83 2019
    check_exp(p);
2 7u83 2020
#endif
7 7u83 2021
    return(p);
2 7u83 2022
}
2023
 
2024
 
2025
/* READ A FLOATING_VARIETY */
2026
 
7 7u83 2027
node *
2028
read_floating_variety(long n)
2 7u83 2029
{
7 7u83 2030
    char *args;
2031
    node *p = new_node();
2032
    construct *cons = cons_no(SORT_floating_variety, n);
2033
    p->cons = cons;
2034
    if (n < 0 || n > 6 || cons->name == null) {
2035
	input_error("Illegal floating_variety value, %ld", n);
2 7u83 2036
    }
7 7u83 2037
    switch (n) {
2038
	case 1: {
2039
	    read_token(p, SORT_floating_variety);
2040
	    break;
2 7u83 2041
	}
7 7u83 2042
	case 2: {
2043
	    args = get_char_info(cons);
2044
	    p->son = read_node(args);
2045
	    if (do_check) {
2046
		checking = "flvar_cond";
2047
		IGNORE check1(ENC_integer, p->son);
2 7u83 2048
	    }
7 7u83 2049
	    break;
2 7u83 2050
	}
2051
	default : {
7 7u83 2052
	    args = get_char_info(cons);
2053
	    if (args) {
2054
		p->son = read_node(args);
2055
	    }
2056
	    break;
2 7u83 2057
	}
2058
    }
2059
#ifdef check_floating_variety
7 7u83 2060
    check_floating_variety(p);
2 7u83 2061
#endif
7 7u83 2062
    return(p);
2 7u83 2063
}
2064
 
2065
 
2066
/* READ A LABEL */
2067
 
7 7u83 2068
node *
2069
read_label(long n)
2 7u83 2070
{
7 7u83 2071
    char *args;
2072
    node *p = new_node();
2073
    construct *cons = cons_no(SORT_label, n);
2074
    p->cons = cons;
2075
    if (n < 0 || n > 2 || cons->name == null) {
2076
	input_error("Illegal label value, %ld", n);
2 7u83 2077
    }
7 7u83 2078
    switch (n) {
2079
	case 2: {
2080
	    read_token(p, SORT_label);
2081
	    break;
2 7u83 2082
	}
7 7u83 2083
	case 1: {
2084
	    p->son = read_var_sort(SORT_label);
2085
	    break;
2 7u83 2086
	}
2087
	default : {
7 7u83 2088
	    args = get_char_info(cons);
2089
	    if (args) {
2090
		p->son = read_node(args);
2091
	    }
2092
	    break;
2 7u83 2093
	}
2094
    }
2095
#ifdef check_label
7 7u83 2096
    check_label(p);
2 7u83 2097
#endif
7 7u83 2098
    return(p);
2 7u83 2099
}
2100
 
2101
 
2102
/* READ A NAT */
2103
 
7 7u83 2104
node *
2105
read_nat(long n)
2 7u83 2106
{
7 7u83 2107
    char *args;
2108
    node *p = new_node();
2109
    construct *cons = cons_no(SORT_nat, n);
2110
    p->cons = cons;
2111
    if (n < 0 || n > 5 || cons->name == null) {
2112
	input_error("Illegal nat value, %ld", n);
2 7u83 2113
    }
7 7u83 2114
    switch (n) {
2115
	case 1: {
2116
	    read_token(p, SORT_nat);
2117
	    break;
2 7u83 2118
	}
7 7u83 2119
	case 2: {
2120
	    args = get_char_info(cons);
2121
	    p->son = read_node(args);
2122
	    if (do_check) {
2123
		checking = "nat_cond";
2124
		IGNORE check1(ENC_integer, p->son);
2 7u83 2125
	    }
7 7u83 2126
	    break;
2 7u83 2127
	}
2128
	default : {
7 7u83 2129
	    args = get_char_info(cons);
2130
	    if (args) {
2131
		p->son = read_node(args);
2132
	    }
2133
	    break;
2 7u83 2134
	}
2135
    }
2136
#ifdef check_nat
7 7u83 2137
    check_nat(p);
2 7u83 2138
#endif
7 7u83 2139
    return(p);
2 7u83 2140
}
2141
 
2142
 
2143
/* READ A NTEST */
2144
 
7 7u83 2145
node *
2146
read_ntest(long n)
2 7u83 2147
{
7 7u83 2148
    char *args;
2149
    node *p = new_node();
2150
    construct *cons = cons_no(SORT_ntest, n);
2151
    p->cons = cons;
2152
    if (n < 0 || n > 16 || cons->name == null) {
2153
	input_error("Illegal ntest value, %ld", n);
2 7u83 2154
    }
7 7u83 2155
    switch (n) {
2156
	case 1: {
2157
	    read_token(p, SORT_ntest);
2158
	    break;
2 7u83 2159
	}
7 7u83 2160
	case 2: {
2161
	    args = get_char_info(cons);
2162
	    p->son = read_node(args);
2163
	    if (do_check) {
2164
		checking = "ntest_cond";
2165
		IGNORE check1(ENC_integer, p->son);
2 7u83 2166
	    }
7 7u83 2167
	    break;
2 7u83 2168
	}
2169
	default : {
7 7u83 2170
	    args = get_char_info(cons);
2171
	    if (args) {
2172
		p->son = read_node(args);
2173
	    }
2174
	    break;
2 7u83 2175
	}
2176
    }
2177
#ifdef check_ntest
7 7u83 2178
    check_ntest(p);
2 7u83 2179
#endif
7 7u83 2180
    return(p);
2 7u83 2181
}
2182
 
2183
 
2184
/* READ A PROCPROPS */
2185
 
7 7u83 2186
node *
2187
read_procprops(long n)
2 7u83 2188
{
7 7u83 2189
    char *args;
2190
    node *p = new_node();
2191
    construct *cons = cons_no(SORT_procprops, n);
2192
    p->cons = cons;
2193
    if (n < 0 || n > 9 || cons->name == null) {
2194
	input_error("Illegal procprops value, %ld", n);
2 7u83 2195
    }
7 7u83 2196
    switch (n) {
2197
	case 1: {
2198
	    read_token(p, SORT_procprops);
2199
	    break;
2 7u83 2200
	}
7 7u83 2201
	case 2: {
2202
	    args = get_char_info(cons);
2203
	    p->son = read_node(args);
2204
	    if (do_check) {
2205
		checking = "procprops_cond";
2206
		IGNORE check1(ENC_integer, p->son);
2 7u83 2207
	    }
7 7u83 2208
	    break;
2 7u83 2209
	}
2210
	default : {
7 7u83 2211
	    args = get_char_info(cons);
2212
	    if (args) {
2213
		p->son = read_node(args);
2214
	    }
2215
	    break;
2 7u83 2216
	}
2217
    }
2218
#ifdef check_procprops
7 7u83 2219
    check_procprops(p);
2 7u83 2220
#endif
7 7u83 2221
    return(p);
2 7u83 2222
}
2223
 
2224
 
2225
/* READ A ROUNDING_MODE */
2226
 
7 7u83 2227
node *
2228
read_rounding_mode(long n)
2 7u83 2229
{
7 7u83 2230
    char *args;
2231
    node *p = new_node();
2232
    construct *cons = cons_no(SORT_rounding_mode, n);
2233
    p->cons = cons;
2234
    if (n < 0 || n > 7 || cons->name == null) {
2235
	input_error("Illegal rounding_mode value, %ld", n);
2 7u83 2236
    }
7 7u83 2237
    switch (n) {
2238
	case 1: {
2239
	    read_token(p, SORT_rounding_mode);
2240
	    break;
2 7u83 2241
	}
7 7u83 2242
	case 2: {
2243
	    args = get_char_info(cons);
2244
	    p->son = read_node(args);
2245
	    if (do_check) {
2246
		checking = "rounding_mode_cond";
2247
		IGNORE check1(ENC_integer, p->son);
2 7u83 2248
	    }
7 7u83 2249
	    break;
2 7u83 2250
	}
2251
	default : {
7 7u83 2252
	    args = get_char_info(cons);
2253
	    if (args) {
2254
		p->son = read_node(args);
2255
	    }
2256
	    break;
2 7u83 2257
	}
2258
    }
2259
#ifdef check_rounding_mode
7 7u83 2260
    check_rounding_mode(p);
2 7u83 2261
#endif
7 7u83 2262
    return(p);
2 7u83 2263
}
2264
 
2265
 
2266
/* READ A SHAPE */
2267
 
7 7u83 2268
node *
2269
read_shape(long n)
2 7u83 2270
{
7 7u83 2271
    char *args;
2272
    node *p = new_node();
2273
    construct *cons = cons_no(SORT_shape, n);
2274
    p->cons = cons;
2275
    if (n < 0 || n > 12 || cons->name == null) {
2276
	input_error("Illegal shape value, %ld", n);
2 7u83 2277
    }
7 7u83 2278
    switch (n) {
2279
	case 1: {
2280
	    read_token(p, SORT_shape);
2281
	    break;
2 7u83 2282
	}
7 7u83 2283
	case 2: {
2284
	    args = get_char_info(cons);
2285
	    p->son = read_node(args);
2286
	    if (do_check) {
2287
		checking = "shape_cond";
2288
		IGNORE check1(ENC_integer, p->son);
2 7u83 2289
	    }
7 7u83 2290
	    break;
2 7u83 2291
	}
2292
	default : {
7 7u83 2293
	    args = get_char_info(cons);
2294
	    if (args) {
2295
		p->son = read_node(args);
2296
	    }
2297
	    break;
2 7u83 2298
	}
2299
    }
2300
#ifdef check_shape
7 7u83 2301
    check_shape(p);
2 7u83 2302
#endif
7 7u83 2303
    return(p);
2 7u83 2304
}
2305
 
2306
 
2307
/* READ A SIGNED_NAT */
2308
 
7 7u83 2309
node *
2310
read_signed_nat(long n)
2 7u83 2311
{
7 7u83 2312
    char *args;
2313
    node *p = new_node();
2314
    construct *cons = cons_no(SORT_signed_nat, n);
2315
    p->cons = cons;
2316
    if (n < 0 || n > 5 || cons->name == null) {
2317
	input_error("Illegal signed_nat value, %ld", n);
2 7u83 2318
    }
7 7u83 2319
    switch (n) {
2320
	case 1: {
2321
	    read_token(p, SORT_signed_nat);
2322
	    break;
2 7u83 2323
	}
7 7u83 2324
	case 2: {
2325
	    args = get_char_info(cons);
2326
	    p->son = read_node(args);
2327
	    if (do_check) {
2328
		checking = "signed_nat_cond";
2329
		IGNORE check1(ENC_integer, p->son);
2 7u83 2330
	    }
7 7u83 2331
	    break;
2 7u83 2332
	}
7 7u83 2333
	case 4: {
2334
	    read_make_signed_nat(p, get_char_info(cons));
2335
	    break;
2 7u83 2336
	}
2337
	default : {
7 7u83 2338
	    args = get_char_info(cons);
2339
	    if (args) {
2340
		p->son = read_node(args);
2341
	    }
2342
	    break;
2 7u83 2343
	}
2344
    }
2345
#ifdef check_signed_nat
7 7u83 2346
    check_signed_nat(p);
2 7u83 2347
#endif
7 7u83 2348
    return(p);
2 7u83 2349
}
2350
 
2351
 
2352
/* READ A STRING */
2353
 
7 7u83 2354
node *
2355
read_string(long n)
2 7u83 2356
{
7 7u83 2357
    char *args;
2358
    node *p = new_node();
2359
    construct *cons = cons_no(SORT_string, n);
2360
    p->cons = cons;
2361
    if (n < 0 || n > 4 || cons->name == null) {
2362
	input_error("Illegal string value, %ld", n);
2 7u83 2363
    }
7 7u83 2364
    switch (n) {
2365
	case 1: {
2366
	    read_token(p, SORT_string);
2367
	    break;
2 7u83 2368
	}
7 7u83 2369
	case 2: {
2370
	    args = get_char_info(cons);
2371
	    p->son = read_node(args);
2372
	    if (do_check) {
2373
		checking = "string_cond";
2374
		IGNORE check1(ENC_integer, p->son);
2 7u83 2375
	    }
7 7u83 2376
	    break;
2 7u83 2377
	}
2378
	default : {
7 7u83 2379
	    args = get_char_info(cons);
2380
	    if (args) {
2381
		p->son = read_node(args);
2382
	    }
2383
	    break;
2 7u83 2384
	}
2385
    }
2386
#ifdef check_string
7 7u83 2387
    check_string(p);
2 7u83 2388
#endif
7 7u83 2389
    return(p);
2 7u83 2390
}
2391
 
2392
 
2393
/* READ A TAG */
2394
 
7 7u83 2395
node *
2396
read_tag(long n)
2 7u83 2397
{
7 7u83 2398
    char *args;
2399
    node *p = new_node();
2400
    construct *cons = cons_no(SORT_tag, n);
2401
    p->cons = cons;
2402
    if (n < 0 || n > 2 || cons->name == null) {
2403
	input_error("Illegal tag value, %ld", n);
2 7u83 2404
    }
7 7u83 2405
    switch (n) {
2406
	case 2: {
2407
	    read_token(p, SORT_tag);
2408
	    break;
2 7u83 2409
	}
7 7u83 2410
	case 1: {
2411
	    p->son = read_var_sort(SORT_tag);
2412
	    break;
2 7u83 2413
	}
2414
	default : {
7 7u83 2415
	    args = get_char_info(cons);
2416
	    if (args) {
2417
		p->son = read_node(args);
2418
	    }
2419
	    break;
2 7u83 2420
	}
2421
    }
2422
#ifdef check_tag
7 7u83 2423
    check_tag(p);
2 7u83 2424
#endif
7 7u83 2425
    return(p);
2 7u83 2426
}
2427
 
2428
 
2429
/* READ A TRANSFER_MODE */
2430
 
7 7u83 2431
node *
2432
read_transfer_mode(long n)
2 7u83 2433
{
7 7u83 2434
    char *args;
2435
    node *p = new_node();
2436
    construct *cons = cons_no(SORT_transfer_mode, n);
2437
    p->cons = cons;
2438
    if (n < 0 || n > 8 || cons->name == null) {
2439
	input_error("Illegal transfer_mode value, %ld", n);
2 7u83 2440
    }
7 7u83 2441
    switch (n) {
2442
	case 1: {
2443
	    read_token(p, SORT_transfer_mode);
2444
	    break;
2 7u83 2445
	}
7 7u83 2446
	case 2: {
2447
	    args = get_char_info(cons);
2448
	    p->son = read_node(args);
2449
	    if (do_check) {
2450
		checking = "transfer_mode_cond";
2451
		IGNORE check1(ENC_integer, p->son);
2 7u83 2452
	    }
7 7u83 2453
	    break;
2 7u83 2454
	}
2455
	default : {
7 7u83 2456
	    args = get_char_info(cons);
2457
	    if (args) {
2458
		p->son = read_node(args);
2459
	    }
2460
	    break;
2 7u83 2461
	}
2462
    }
2463
#ifdef check_transfer_mode
7 7u83 2464
    check_transfer_mode(p);
2 7u83 2465
#endif
7 7u83 2466
    return(p);
2 7u83 2467
}
2468
 
2469
 
2470
/* READ A VARIETY */
2471
 
7 7u83 2472
node *
2473
read_variety(long n)
2 7u83 2474
{
7 7u83 2475
    char *args;
2476
    node *p = new_node();
2477
    construct *cons = cons_no(SORT_variety, n);
2478
    p->cons = cons;
2479
    if (n < 0 || n > 4 || cons->name == null) {
2480
	input_error("Illegal variety value, %ld", n);
2 7u83 2481
    }
7 7u83 2482
    switch (n) {
2483
	case 1: {
2484
	    read_token(p, SORT_variety);
2485
	    break;
2 7u83 2486
	}
7 7u83 2487
	case 2: {
2488
	    args = get_char_info(cons);
2489
	    p->son = read_node(args);
2490
	    if (do_check) {
2491
		checking = "var_cond";
2492
		IGNORE check1(ENC_integer, p->son);
2 7u83 2493
	    }
7 7u83 2494
	    break;
2 7u83 2495
	}
2496
	default : {
7 7u83 2497
	    args = get_char_info(cons);
2498
	    if (args) {
2499
		p->son = read_node(args);
2500
	    }
2501
	    break;
2 7u83 2502
	}
2503
    }
2504
#ifdef check_variety
7 7u83 2505
    check_variety(p);
2 7u83 2506
#endif
7 7u83 2507
    return(p);
2 7u83 2508
}