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
33
 
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:-
42
 
43
        (1) Its Recipients shall ensure that this Notice is
44
        reproduced upon any copies or amended versions of it;
45
 
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;
49
 
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;
53
 
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
/**********************************************************************
62
$Author: pwe $
63
$Date: 1998/03/11 11:03:30 $
64
$Revision: 1.2 $
65
$Log: dg_fns.c,v $
66
 * Revision 1.2  1998/03/11  11:03:30  pwe
67
 * DWARF optimisation info
68
 *
69
 * Revision 1.1.1.1  1998/01/17  15:55:46  release
70
 * First version to be checked into rolling release.
71
 *
72
 * Revision 1.9  1998/01/11  18:44:53  pwe
73
 * consistent new/old diags
74
 *
75
 * Revision 1.8  1998/01/09  14:43:06  pwe
76
 * info for global STABS
77
 *
78
 * Revision 1.7  1998/01/09  09:29:45  pwe
79
 * prep restructure
80
 *
81
 * Revision 1.6  1997/12/04  19:36:24  pwe
82
 * ANDF-DE V1.9
83
 *
84
 * Revision 1.5  1997/11/06  09:17:39  pwe
85
 * ANDF-DE V1.8
86
 *
87
 * Revision 1.4  1997/10/28  10:12:31  pwe
88
 * local location support
89
 *
90
 * Revision 1.3  1997/10/23  09:21:04  pwe
91
 * ANDF-DE V1.7 and extra diags
92
 *
93
 * Revision 1.2  1997/10/10  18:16:37  pwe
94
 * prep ANDF-DE revision
95
 *
96
 * Revision 1.1  1997/08/23  13:26:46  pwe
97
 * initial ANDF-DE
98
 *
99
***********************************************************************/
100
 
101
 
102
#include "config.h"
103
#include "common_types.h"
104
#include "readglob.h"
105
#include "table_fns.h"
106
#include "basicread.h"
107
#include "install_fns.h"
108
#include "sortmacs.h"
109
#include "expmacs.h"
110
#include "tags.h"
111
#include "main_reads.h"
112
#include "natmacs.h"
113
#include "dg_fns.h"
114
#include "dg_aux.h"
115
#include "dg_globs.h"
116
#include "xalloc.h"
117
#include "toktypes.h"
118
#include "flags.h"
119
#include "externs.h"
120
 
121
 
122
dg_filename all_files = (dg_filename)0;
123
dg_compilation all_comp_units = (dg_compilation)0;
124
 
125
 
126
 
6 7u83 127
string_list
128
new_string_list(int n)
2 7u83 129
{
6 7u83 130
	string_list ans;
131
	ans.len = n;
132
	ans.array = (char **)xcalloc(n, sizeof(char *));
133
	return ans;
2 7u83 134
}
135
 
6 7u83 136
 
137
string_list
138
add_string_list(string_list list, string elem, int index)
2 7u83 139
{
6 7u83 140
	list.array[index] = elem.ints.chars;
141
	return list;
2 7u83 142
}
143
 
6 7u83 144
 
2 7u83 145
bool_option no_bool_option;
146
 
6 7u83 147
bool_option
148
yes_bool_option(bool elem)
2 7u83 149
{
6 7u83 150
	bool_option res;
151
	res.val = elem;
152
	res.present = 1;
153
	return res;
2 7u83 154
}
155
 
6 7u83 156
 
157
void
158
init_bool_option(void)
2 7u83 159
{
6 7u83 160
	no_bool_option.present = 0;
161
	return;
2 7u83 162
}
163
 
6 7u83 164
 
2 7u83 165
shape_option no_shape_option;
166
 
6 7u83 167
shape_option
168
yes_shape_option(shape elem)
2 7u83 169
{
6 7u83 170
	shape_option res;
171
	res.val = elem;
172
	res.present = 1;
173
	return res;
2 7u83 174
}
175
 
6 7u83 176
 
177
void
178
init_shape_option(void)
2 7u83 179
{
6 7u83 180
	no_shape_option.present = 0;
181
	return;
2 7u83 182
}
183
 
6 7u83 184
 
2 7u83 185
token_option no_token_option;
186
 
6 7u83 187
token_option
188
yes_token_option(token elem)
2 7u83 189
{
6 7u83 190
	token_option res;
191
	res.val = elem;
192
	res.present = 1;
193
	return res;
2 7u83 194
}
195
 
6 7u83 196
 
197
void
198
init_token_option(void)
2 7u83 199
{
6 7u83 200
	no_token_option.present = 0;
201
	return;
2 7u83 202
}
203
 
204
 
205
int unit_no_of_dgtags;
6 7u83 206
dgtag_struct **unit_ind_dgtags;
207
dgtag_struct *unit_dgtagtab;
2 7u83 208
 
209
 
6 7u83 210
dg
211
f_dg_apply_token(token token_value, bitstream token_args)
2 7u83 212
{
6 7u83 213
	tokval v;
214
	v = apply_tok(token_value, token_args, DG_SORT, (tokval *)0);
215
	return v.tk_dg;
2 7u83 216
}
217
 
6 7u83 218
 
2 7u83 219
dg f_dummy_dg;
220
 
6 7u83 221
dg
222
f_make_tag_dg(dg_tag tg, dg diag)
2 7u83 223
{
6 7u83 224
	if (tg->key) {
225
		failer("dg_tag defined twice");
226
	}
227
	tg->key = DGK_INFO;
228
	tg->p.info = diag;
229
	diag->this_tag = tg;
230
	return diag;
2 7u83 231
}
232
 
6 7u83 233
 
234
dg
235
f_list_dg(dg_list args)
2 7u83 236
{
6 7u83 237
	return args;
2 7u83 238
}
239
 
6 7u83 240
 
241
dg
242
f_params_dg(dg_name_list params, exp_option outer_env)
2 7u83 243
{
6 7u83 244
	dg ans = new_dg_info(DGA_PARAMS);
245
	ans->data.i_param.args = params;
246
	if (outer_env.present) {
247
		ans->data.i_param.o_env = diaginfo_exp(outer_env.val);
248
	} else {
249
		ans->data.i_param.o_env = nilexp;
250
	}
251
	ans->data.i_param.b_start = 0;
252
	return ans;
2 7u83 253
}
254
 
6 7u83 255
 
256
dg
257
f_source_language_dg(nat language)
2 7u83 258
{
6 7u83 259
	dg ans = new_dg_info(DGA_COMP);
260
	ans->data.i_comp.is_tag = 0;
261
	ans->data.i_comp.corl.comp_lang = language.nat_val.small_nat;
262
	return ans;
2 7u83 263
}
264
 
6 7u83 265
 
266
dg
267
f_compilation_dg(dg_tag comp_unit)
2 7u83 268
{
6 7u83 269
	dg ans = new_dg_info(DGA_COMP);
270
	ans->data.i_comp.is_tag = 1;
271
	ans->data.i_comp.corl.comp_tag = comp_unit;
272
	return ans;
2 7u83 273
}
274
 
6 7u83 275
 
276
dg
277
f_sourcepos_dg(dg_sourcepos span)
2 7u83 278
{
6 7u83 279
	dg ans = new_dg_info(DGA_SRC);
280
	ans->data.i_src.is_stmt = 0;
281
	ans->data.i_src.startpos = shorten_sourcepos(span);
282
	ans->data.i_src.endpos = end_sourcepos(span);
283
	return ans;
2 7u83 284
}
285
 
6 7u83 286
 
287
dg
288
f_name_decl_dg(dg_name dname)
2 7u83 289
{
6 7u83 290
	dg ans = new_dg_info(DGA_NAME);
291
	ans->data.i_nam.dnam = dname;
292
	return ans;
2 7u83 293
}
294
 
6 7u83 295
 
296
dg
297
f_lexical_block_dg(dg_idname_option idname, dg_sourcepos src_pos)
2 7u83 298
{
6 7u83 299
	dg ans = new_dg_info(DGA_SCOPE);
300
	ans->data.i_scope.lexname = idname_chars(idname);
301
	ans->data.i_scope.lexpos = shorten_sourcepos(src_pos);
302
	ans->data.i_scope.endpos = end_sourcepos(src_pos);
303
	ans->data.i_scope.begin_st = (long)0;
304
	return ans;
2 7u83 305
}
306
 
6 7u83 307
 
308
dg
309
f_inline_call_dg(dg_tag proc, dg_name_list act_params, nat_option call_kind)
2 7u83 310
{
6 7u83 311
	dg ans = new_dg_info(DGA_INL_CALL);
312
	ans->data.i_inl.proc = proc;
313
	ans->data.i_inl.args = act_params;
314
	if (call_kind.present) {
315
		ans->data.i_inl.ck = call_kind.val.nat_val.small_nat;
316
	} else {
317
		ans->data.i_inl.ck = 0;
318
	}
319
	ans->data.i_inl.resref = nildiag;
320
	proc->any_inl = 1;
321
	return ans;
2 7u83 322
}
323
 
6 7u83 324
 
325
dg
326
f_inline_result_dg(dg_tag inline_id)
2 7u83 327
{
6 7u83 328
	dg ans = new_dg_info(DGA_INL_RES);
329
	ans->data.i_res.call = inline_id;
330
	ans->data.i_res.res.k = NO_WH;
331
	ans->data.i_res.next = (dg_info)0;
332
	return ans;
2 7u83 333
}
334
 
6 7u83 335
 
336
dg
337
f_singlestep_dg(dg_sourcepos src_pos)
2 7u83 338
{
6 7u83 339
	dg ans = new_dg_info(DGA_SRC);
340
	ans->data.i_src.is_stmt = 1;
341
	ans->data.i_src.startpos = shorten_sourcepos(src_pos);
342
	ans->data.i_src.endpos.file = 0;
343
	return ans;
2 7u83 344
}
345
 
6 7u83 346
 
347
dg
348
f_with_dg(dg_type type, exp obtain_value)
2 7u83 349
{
6 7u83 350
	dg ans = new_dg_info(DGA_SRC);
351
	ans->data.i_with.w_typ = type;
352
	ans->data.i_with.w_exp = diaginfo_exp(obtain_value);
353
	return ans;
2 7u83 354
}
355
 
6 7u83 356
 
357
dg
358
f_exception_scope_dg(dg_tag_list handlers)
2 7u83 359
{
6 7u83 360
	dg ans = new_dg_info(DGA_X_TRY);
361
	ans->data.i_try.hl = handlers;
362
	return ans;
2 7u83 363
}
364
 
6 7u83 365
 
366
dg
367
f_exception_handler_dg(dg_name_option ex)
2 7u83 368
{
6 7u83 369
	dg ans = new_dg_info(DGA_X_CATCH);
370
	ans->data.i_catch.ex = ex;
371
	return ans;
2 7u83 372
}
373
 
6 7u83 374
 
375
dg
376
f_abortable_part_dg(dg_sourcepos src_pos, bool no_code)
2 7u83 377
{
6 7u83 378
	dg ans = new_dg_info(DGA_RVS);
379
	ans->data.i_rvs.rvs_key = DGR_ABTL;
380
	ans->data.i_rvs.n_code = (no_code ? 0 : 2);
381
	ans->data.i_rvs.has_iv = 0;
382
	ans->data.i_rvs.alt = 0;
383
	ans->data.i_rvs.pos = shorten_sourcepos(src_pos);
384
	ans->data.i_rvs.u.tg = (dg_tag)0;
385
	ans->data.i_rvs.en = (dg_tag)0;
386
	return ans;
2 7u83 387
}
388
 
6 7u83 389
 
390
dg
391
f_accept_dg(dg_sourcepos src_pos, dg_tag entry, dg_name_list params,
392
	    bool no_code, dg_tag_option alt)
2 7u83 393
{
6 7u83 394
	dg ans = new_dg_info(DGA_RVS);
395
	ans->data.i_rvs.rvs_key = DGR_ACC;
396
	ans->data.i_rvs.n_code = (no_code ? 0 : 2);
397
	ans->data.i_rvs.has_iv = 0;
398
	ans->data.i_rvs.alt = (alt ? 1 : 0);
399
	ans->data.i_rvs.pos = shorten_sourcepos(src_pos);
400
	ans->data.i_rvs.u.tg = alt;
401
	ans->data.i_rvs.en = entry;
402
	ans->data.i_rvs.u2.p = params;
403
	return ans;
2 7u83 404
}
405
 
6 7u83 406
 
407
dg
408
f_barrier_dg(dg_sourcepos src_pos, dg_tag entry)
2 7u83 409
{
6 7u83 410
	dg ans = new_dg_info(DGA_BAR);
411
	ans->data.i_bar.pos = shorten_sourcepos(src_pos);
412
	ans->data.i_bar.entry = entry;
413
	return ans;
2 7u83 414
}
415
 
6 7u83 416
 
417
dg
418
f_branch_dg(dg_sourcepos stmt_src_pos)
2 7u83 419
{
6 7u83 420
	dg ans = new_dg_info(DGA_BRANCH);
421
	ans->data.i_brn.pos = shorten_sourcepos(stmt_src_pos);
422
	return ans;
2 7u83 423
}
424
 
6 7u83 425
 
426
dg
427
f_call_dg(dg_idname_option idname, dg_sourcepos src_pos, nat_option call_kind,
428
	  dg_tag_option module, dg_tag_option basetype)
2 7u83 429
{
6 7u83 430
	dg ans = new_dg_info(DGA_CALL);
431
	ans->data.i_call.clnam = idname_chars(idname);
432
	ans->data.i_call.pos = shorten_sourcepos(src_pos);
433
	if (call_kind.present) {
434
		ans->data.i_call.ck = call_kind.val.nat_val.small_nat;
435
	} else {
436
		ans->data.i_call.ck = 0;
437
	}
438
	ans->data.i_call.p.k = NO_WH;
439
	UNUSED(module);
440
	UNUSED(basetype);
441
	return ans;
2 7u83 442
}
443
 
6 7u83 444
 
445
dg
446
f_destructor_dg(dg_sourcepos whence, exp_option obtain_value)
2 7u83 447
{
6 7u83 448
	dg ans = new_dg_info(DGA_DEST);
449
	ans->data.i_dest.pos = shorten_sourcepos(whence);
450
	if (obtain_value.present) {
451
		ans->data.i_dest.val = diaginfo_exp(obtain_value.val);
452
	} else {
453
		ans->data.i_dest.val = nilexp;
454
	}
455
	return ans;
2 7u83 456
}
457
 
6 7u83 458
 
459
dg
460
f_inlined_dg(dg d, dg_tag origin)
2 7u83 461
{
6 7u83 462
	UNUSED(origin);
2 7u83 463
	/* inlined_dg not yet supported */
6 7u83 464
	return d;
2 7u83 465
}
466
 
6 7u83 467
 
468
dg
469
f_jump_dg(dg_sourcepos stmt_src_pos)
2 7u83 470
{
6 7u83 471
	dg ans = new_dg_info(DGA_JUMP);
472
	ans->data.i_tst.pos = shorten_sourcepos(stmt_src_pos);
473
	return ans;
2 7u83 474
}
475
 
6 7u83 476
 
477
dg
478
f_label_dg(dg_idname idname, dg_sourcepos src_pos)
2 7u83 479
{
6 7u83 480
	dg ans = new_dg_info(DGA_LAB);
481
	ans->data.i_scope.lexname = idname_chars(idname);
482
	ans->data.i_scope.lexpos = shorten_sourcepos(src_pos);
483
	return ans;
2 7u83 484
}
485
 
6 7u83 486
 
487
dg
488
f_long_jump_dg(dg_sourcepos stmt_src_pos)
2 7u83 489
{
6 7u83 490
	dg ans = new_dg_info(DGA_LJ);
491
	ans->data.i_lj.pos = shorten_sourcepos(stmt_src_pos);
492
	return ans;
2 7u83 493
}
494
 
6 7u83 495
 
496
dg
497
f_raise_dg(dg_sourcepos stmt_src_pos, dg_type_option ex, exp_option value)
2 7u83 498
{
6 7u83 499
	dg ans = new_dg_info(DGA_X_RAISE);
500
	ans->data.i_raise.pos = shorten_sourcepos(stmt_src_pos);
501
	ans->data.i_raise.x_typ = ex;
502
	if (value.present) {
503
		ans->data.i_raise.x_val = diaginfo_exp(value.val);
504
	} else {
505
		ans->data.i_raise.x_val = nilexp;
506
	}
507
	return ans;
2 7u83 508
}
509
 
6 7u83 510
 
511
dg
512
f_requeue_dg(dg_sourcepos stmt_src_pos, dg_tag entry, bool with_abort)
2 7u83 513
{
6 7u83 514
	dg ans = new_dg_info(DGA_RVS);
515
	ans->data.i_rvs.rvs_key = DGR_REQUE;
516
	ans->data.i_rvs.n_code = 2;
517
	ans->data.i_rvs.has_iv = 0;
518
	ans->data.i_rvs.alt = 0;
519
	ans->data.i_rvs.w_abort = with_abort;
520
	ans->data.i_rvs.pos = shorten_sourcepos(stmt_src_pos);
521
	ans->data.i_rvs.u.tg = (dg_tag)0;
522
	ans->data.i_rvs.en = entry;
523
	return ans;
2 7u83 524
}
525
 
6 7u83 526
 
527
dg
528
f_rts_call_dg(dg_sourcepos src_pos, nat call_kind, dg_tag_option entry,
529
	      dg_tag_option alt)
2 7u83 530
{
6 7u83 531
	dg ans = new_dg_info(DGA_RVS);
532
	ans->data.i_rvs.rvs_key = DGR_RTS;
533
	ans->data.i_rvs.n_code = 1;
534
	ans->data.i_rvs.has_iv = 0;
535
	ans->data.i_rvs.alt = (alt ? 1 : 0);
536
	ans->data.i_rvs.kind = call_kind.nat_val.small_nat;
537
	ans->data.i_rvs.pos = shorten_sourcepos(src_pos);
538
	ans->data.i_rvs.u.tg = alt;
539
	ans->data.i_rvs.en = entry;
540
	return ans;
2 7u83 541
}
542
 
6 7u83 543
 
544
dg
545
f_select_dg(dg_sourcepos src_pos, bool async)
2 7u83 546
{
6 7u83 547
	dg ans = new_dg_info(DGA_RVS);
548
	ans->data.i_rvs.rvs_key = DGR_SEL;
549
	ans->data.i_rvs.n_code = (async ? 2 : 1);
550
	ans->data.i_rvs.has_iv = 0;
551
	ans->data.i_rvs.alt = 0;
552
	ans->data.i_rvs.async = async;
553
	ans->data.i_rvs.pos = shorten_sourcepos(src_pos);
554
	ans->data.i_rvs.u.tg = (dg_tag)0;
555
	return ans;
2 7u83 556
}
557
 
6 7u83 558
 
559
dg
560
f_select_alternative_dg(dg_sourcepos src_pos, nat alt_kind, bool no_code,
561
			exp alt_value)
2 7u83 562
{
6 7u83 563
	dg ans = new_dg_info(DGA_RVS);
564
	ans->data.i_rvs.rvs_key = DGR_ALT;
565
	ans->data.i_rvs.n_code = (no_code ? 0 : 2);
566
	ans->data.i_rvs.has_iv = 0;
567
	ans->data.i_rvs.alt = 0;
568
	ans->data.i_rvs.kind = alt_kind.nat_val.small_nat;
569
	ans->data.i_rvs.pos = shorten_sourcepos(src_pos);
570
	ans->data.i_rvs.u.tg = (dg_tag)0;
571
	ans->data.i_rvs.u2.e = diaginfo_exp(alt_value);
572
	return ans;
2 7u83 573
}
574
 
6 7u83 575
 
576
dg
577
f_select_guard_dg(dg_sourcepos src_pos, dg_tag alt)
2 7u83 578
{
6 7u83 579
	dg ans = new_dg_info(DGA_RVS);
580
	ans->data.i_rvs.rvs_key = DGR_SGD;
581
	ans->data.i_rvs.n_code = 2;
582
	ans->data.i_rvs.has_iv = 0;
583
	ans->data.i_rvs.alt = (alt ? 1 : 0);
584
	ans->data.i_rvs.pos = shorten_sourcepos(src_pos);
585
	ans->data.i_rvs.u.tg = alt;
586
	return ans;
2 7u83 587
}
588
 
6 7u83 589
 
590
dg
591
f_statement_part_dg(dg_tag lb)
2 7u83 592
{
6 7u83 593
	dg ans = new_dg_info(DGA_BEG);
594
	ans->data.i_tg = lb;
595
	return ans;
2 7u83 596
}
597
 
6 7u83 598
 
599
dg
600
f_test_dg(dg_sourcepos src_pos, bool inverted)
2 7u83 601
{
6 7u83 602
	dg ans = new_dg_info(DGA_TEST);
603
	ans->data.i_tst.pos = shorten_sourcepos(src_pos);
604
	ans->data.i_tst.inv = inverted;
605
	return ans;
2 7u83 606
}
607
 
6 7u83 608
 
609
dg
610
f_triggering_alternative_dg(dg_sourcepos src_pos, nat alt_kind, bool no_code)
2 7u83 611
{
6 7u83 612
	dg ans = new_dg_info(DGA_RVS);
613
	ans->data.i_rvs.rvs_key = DGR_TRIG;
614
	ans->data.i_rvs.n_code = (no_code ? 0 : 2);
615
	ans->data.i_rvs.has_iv = 0;
616
	ans->data.i_rvs.alt = 0;
617
	ans->data.i_rvs.kind = alt_kind.nat_val.small_nat;
618
	ans->data.i_rvs.pos = shorten_sourcepos(src_pos);
619
	ans->data.i_rvs.u.tg = (dg_tag)0;
620
	return ans;
2 7u83 621
}
622
 
6 7u83 623
 
624
void
625
init_dg(void)
2 7u83 626
{
6 7u83 627
	return;
2 7u83 628
}
629
 
6 7u83 630
 
2 7u83 631
dg_comp_props f_dummy_dg_comp_props;
632
 
6 7u83 633
dg_comp_props
634
f_make_dg_compunit(tdfint no_labels, dg_compilation comp_unit, dg_append_list l)
2 7u83 635
{
6 7u83 636
	UNUSED(no_labels);
637
	UNUSED(comp_unit);
638
	UNUSED(l);
639
	return f_dummy_dg_comp_props;	/* dummy, never called */
2 7u83 640
}
641
 
6 7u83 642
 
643
void
644
init_dg_comp_props(void)
2 7u83 645
{
6 7u83 646
	return;
2 7u83 647
}
648
 
6 7u83 649
 
2 7u83 650
dg_tag f_dummy_dg_tag;
651
 
6 7u83 652
dg_tag
653
f_make_dg_tag(tdfint num)
2 7u83 654
{
6 7u83 655
	int index = natint(num);
656
	if (index >= unit_no_of_dgtags) {
657
		failer("make_dg_tag out of range");
658
	}
659
	return unit_ind_dgtags[index];
2 7u83 660
}
661
 
6 7u83 662
 
663
void
664
init_dg_tag(void)
2 7u83 665
{
6 7u83 666
	return;
2 7u83 667
}
668
 
6 7u83 669
 
2 7u83 670
dg_name f_dummy_dg_name;
671
 
6 7u83 672
dg_name
673
f_dg_name_apply_token(token token_value, bitstream token_args)
2 7u83 674
{
6 7u83 675
	tokval v;
676
	v = apply_tok(token_value, token_args, DG_NAME_SORT, (tokval *)0);
677
	return v.tk_dg_name;
2 7u83 678
}
679
 
6 7u83 680
 
681
dg_name
682
f_dg_tag_name(dg_tag tg, dg_name nam)
2 7u83 683
{
6 7u83 684
	if (tg->key) {
685
		failer("dg_tag defined twice");
686
	}
687
	tg->key = DGK_NAME;
688
	tg->p.nam = nam;
689
	if (!nam->mor) {
690
		extend_dg_name(nam);
691
	}
692
	nam->mor->this_tag = tg;
693
	return nam;
2 7u83 694
}
695
 
6 7u83 696
 
697
dg_name
698
f_dg_object_name(dg_idname idname, dg_sourcepos whence, dg_type type,
699
		 exp_option obtain_value, dg_accessibility_option accessibility)
2 7u83 700
{
6 7u83 701
	dg_name ans = new_dg_name(DGN_OBJECT);
702
	ans->idnam = idname;
703
	ans->whence = shorten_sourcepos(whence);
704
	ans->data.n_obj.typ = type;
2 7u83 705
#ifdef NEWDIAGS
6 7u83 706
	if (obtain_value.present) {
707
		exp acc = obtain_value.val;
708
		ans->data.n_obj.obtain_val = diaginfo_exp(acc);
709
		set_obj_ref(ans);		/* globals only */
2 7u83 710
#if 0
6 7u83 711
		if (name(acc) == cont_tag && name(son(acc)) == name_tag &&
712
		    isglob(son(son(acc))) && isvar(son(son(acc))))
713
			brog(son(son(acc)))->dec_u.dec_val.diag_info = ans;
2 7u83 714
#endif
6 7u83 715
	} else {
716
		ans->data.n_obj.obtain_val = nilexp;
717
	}
2 7u83 718
#endif
6 7u83 719
	if (accessibility != DG_ACC_NONE) {
720
		extend_dg_name(ans);
721
		ans->mor->acc = accessibility;
722
	}
723
	return ans;
2 7u83 724
}
725
 
6 7u83 726
 
727
dg_name
728
f_dg_proc_name(dg_idname idname, dg_sourcepos whence, dg_type type,
729
	       exp_option obtain_value, dg_accessibility_option accessibility,
730
	       dg_virtuality_option virtuality, bool isinline,
731
	       dg_type_list_option exceptions, dg_tag_option elaboration)
2 7u83 732
{
6 7u83 733
	dg_name ans = new_dg_name(DGN_PROC);
734
	ans->idnam = idname;
735
	ans->whence = shorten_sourcepos(whence);
736
	ans->data.n_proc.typ = type;
2 7u83 737
#ifdef NEWDIAGS
6 7u83 738
	if (obtain_value.present) {
739
		exp acc = obtain_value.val;
740
		ans->data.n_proc.obtain_val = diaginfo_exp(acc);
741
		if (name(acc) == name_tag && isglob(son(acc))) {
742
			brog(son(acc))->dec_u.dec_val.diag_info = ans;
743
		}
744
	} else {
745
		ans->data.n_proc.obtain_val = nilexp;
746
	}
747
	ans->data.n_proc.params = (dg_info)0;
748
	if (accessibility != DG_ACC_NONE || virtuality != DG_VIRT_NONE ||
749
	    isinline || extra_diags || elaboration || exceptions.len >= 0) {
750
		extend_dg_name(ans);
751
		ans->mor->acc = accessibility;
752
		ans->mor->virt = virtuality;
753
		ans->mor->isinline = isinline;
754
		ans->mor->end_pos = end_sourcepos(whence);
755
		ans->mor->elabn = elaboration;
756
		ans->mor->exptns = exceptions;
757
	}
2 7u83 758
#endif
6 7u83 759
	return ans;
2 7u83 760
}
761
 
6 7u83 762
 
763
dg_name
764
f_dg_inlined_name(dg_name nam, dg_tag origin)
2 7u83 765
{
6 7u83 766
	if (!nam->mor) {
767
		extend_dg_name(nam);
768
	}
769
	nam->mor->inline_ref = origin;
770
	return nam;
2 7u83 771
}
772
 
6 7u83 773
 
774
dg_name
775
f_dg_constant_name(dg_name nam)
2 7u83 776
{
6 7u83 777
	if (!nam->mor) {
778
		extend_dg_name(nam);
779
	}
780
	nam->mor->isconst = 1;
781
	return nam;
2 7u83 782
}
783
 
6 7u83 784
 
785
dg_name
786
f_dg_type_name(dg_idname_option idname, dg_sourcepos whence,
787
	       dg_accessibility_option accessibility, dg_type_option type,
788
	       bool new_type, bool_option ada_derived,
789
	       dg_constraint_list_option constraints)
2 7u83 790
{
6 7u83 791
	dg_name ans = new_dg_name(DGN_TYPE);
792
	ans->idnam = idname;
793
	ans->whence = shorten_sourcepos(whence);
794
	ans->data.n_typ.raw = type;
795
	if (idname.id_key == DG_ID_NONE) {
796
		ans->data.n_typ.named = type;
797
	} else {
798
		ans->data.n_typ.named = (dg_type)0;
799
	}
800
	if (accessibility != DG_ACC_NONE || new_type ||
801
	    (ada_derived.present && ada_derived.val)) {
802
		extend_dg_name(ans);
803
		ans->mor->acc = accessibility;
804
		ans->mor->isnew = new_type;
805
		if (ada_derived.present) {
806
			ans->mor->aderiv = ada_derived.val;
807
		}
808
	}
809
	ans->data.n_typ.constraints = constraints;
810
	return ans;
2 7u83 811
}
812
 
6 7u83 813
 
814
dg_name
815
f_dg_subunit_name(dg_tag parent, dg_name nam, nat subunit_kind,
816
		  dg_accessibility_option accessibility)
2 7u83 817
{
6 7u83 818
	dg_name ans = new_dg_name(DGN_SUBUNIT);
819
	ans->data.n_sub.parent = parent;
820
	ans->data.n_sub.sub = nam;
821
	switch (subunit_kind.nat_val.small_nat) {
822
	case 1:
823
		/* SUK_child */
824
		ans->data.n_sub.child = 1;
825
		ans->data.n_sub.split = 0;
826
		break;
827
	case 2:
828
		/* SUK_separate */
829
		ans->data.n_sub.child = 0;
830
		ans->data.n_sub.split = 0;
831
		ans->data.n_sub.acc = accessibility;
832
		break;
833
	case 3:
834
		/* SUK_split_module */
835
		ans->data.n_sub.child = 0;
836
		ans->data.n_sub.split = 1;
837
		break;
838
	default:
839
		failer("unexpected SUK_kind");
840
	}
841
	return ans;
2 7u83 842
}
843
 
6 7u83 844
 
845
dg_name
846
f_dg_program_name(dg_idname idname, dg_sourcepos whence, exp obtain_value)
2 7u83 847
{
6 7u83 848
	dg_name ans = new_dg_name(DGN_PROC);
849
	ans->idnam = idname;
850
	ans->whence = shorten_sourcepos(whence);
851
	ans->data.n_proc.typ = (dg_type)0;
852
	ans->data.n_proc.obtain_val = diaginfo_exp(obtain_value);
853
	ans->data.n_proc.params = (dg_info)0;
854
	extend_dg_name(ans);
855
	ans->mor->prognm = 1;
856
	return ans;
2 7u83 857
}
858
 
6 7u83 859
 
860
dg_name
861
f_dg_entry_family_name(dg_name proc, dg_dim family)
2 7u83 862
{
6 7u83 863
	if (!proc->mor) {
864
		extend_dg_name(proc);
865
	}
866
	proc->mor->en_family = (dg_dim *)xmalloc(sizeof(dg_dim));
867
	*(proc->mor->en_family) = family;
868
	return proc;
2 7u83 869
}
870
 
6 7u83 871
 
872
dg_name
873
f_dg_entry_name(dg_idname idname, dg_sourcepos whence, dg_type type,
874
		dg_accessibility_option accessibility, dg_dim_option family)
2 7u83 875
{
6 7u83 876
	dg_name ans = new_dg_name(DGN_ENTRY);
877
	ans->idnam = idname;
878
	ans->whence = shorten_sourcepos(whence);
879
	ans->data.n_proc.typ = type;
880
	if (accessibility != DG_ACC_NONE || family.d_key != DG_DIM_NONE) {
881
		extend_dg_name(ans);
882
		ans->mor->acc = accessibility;
883
		if (family.d_key != DG_DIM_NONE) {
884
			ans->mor->en_family = (dg_dim *)xmalloc(sizeof(dg_dim));
885
			*(ans->mor->en_family) = family;
886
		}
887
	}
888
	return ans;
2 7u83 889
}
890
 
6 7u83 891
 
892
dg_name
893
f_dg_is_spec_name(dg_name nam, bool_option is_separate)
2 7u83 894
{
6 7u83 895
	if (!nam->mor) {
896
		extend_dg_name(nam);
897
	}
898
	nam->mor->isspec = 1;
899
	if (is_separate.present && is_separate.val) {
900
		nam->mor->issep = 1;
901
	}
902
	return nam;
2 7u83 903
}
904
 
905
 
6 7u83 906
dg_name
907
f_dg_module_name(dg_idname idname, dg_sourcepos whence, dg_namelist memlist,
908
		 exp_option init, dg_tag_option elaboration)
2 7u83 909
{
6 7u83 910
	dg_name ans = new_dg_name(DGN_MODULE);
911
	ans->idnam = idname;
912
	ans->whence = shorten_sourcepos(whence);
913
	ans->data.n_mod.members = memlist.list;
2 7u83 914
#ifdef NEWDIAGS
6 7u83 915
	if (memlist.tg) {
916
		memlist.tg->p.nl = &(ans->data.n_mod.members);
917
	}
918
	if (init.present) {
919
		exp acc = init.val;
920
		ans->data.n_mod.init = diaginfo_exp(acc);
921
		if (name(acc) == name_tag && isglob(son(acc))) {
922
			brog(son(acc))->dec_u.dec_val.diag_info = ans;
923
		}
924
	} else {
925
		ans->data.n_mod.init = nilexp;
926
	}
2 7u83 927
#endif
6 7u83 928
	if (elaboration) {
929
		extend_dg_name(ans);
930
		ans->mor->elabn = elaboration;
931
	}
932
	return ans;
2 7u83 933
}
934
 
6 7u83 935
 
936
dg_name
937
f_dg_namespace_name(dg_idname idname, dg_sourcepos whence, dg_namelist members)
2 7u83 938
{
6 7u83 939
	dg_name ans = new_dg_name(DGN_NSP);
940
	ans->idnam = idname;
941
	ans->whence = shorten_sourcepos(whence);
942
	ans->data.n_mod.members = members.list;
943
	if (members.tg) {
944
		members.tg->p.nl = &(ans->data.n_mod.members);
945
	}
946
	ans->data.n_mod.init = nilexp;
947
	return ans;
2 7u83 948
}
949
 
6 7u83 950
 
951
dg_name
952
f_dg_rep_clause_name(dg_name item, exp location)
2 7u83 953
{
6 7u83 954
	if (!item->mor) {
955
		extend_dg_name(item);
956
	}
957
	item->mor->repn = diaginfo_exp(location);
958
	return item;
2 7u83 959
}
960
 
6 7u83 961
 
962
dg_name
963
f_dg_spec_ref_name(dg_tag specification, dg_name nam)
2 7u83 964
{
6 7u83 965
	if (!nam->mor) {
966
		extend_dg_name(nam);
967
	}
968
	nam->mor->refspec = specification;
969
	return nam;
2 7u83 970
}
971
 
6 7u83 972
 
973
dg_name
974
f_dg_visibility_name(dg_tag dname, nat import_kind, dg_idname_option idname,
975
		     dg_sourcepos_option src_pos,
976
		     dg_accessibility_option accessibility, dg_type_option type)
2 7u83 977
{
6 7u83 978
	dg_name ans = new_dg_name(DGN_IMPORT);
979
	ans->idnam = idname;
980
	ans->whence = shorten_sourcepos(src_pos);
981
	ans->data.n_imp.import = dname;
982
	ans->data.n_imp.ik = import_kind.nat_val.small_nat;
983
	if (accessibility != DG_ACC_NONE) {
984
		extend_dg_name(ans);
985
		ans->mor->acc = accessibility;
986
	}
987
	ans->data.n_imp.i_typ = type;
988
	return ans;
2 7u83 989
}
990
 
6 7u83 991
 
992
void
993
init_dg_name(void)
2 7u83 994
{
6 7u83 995
	return;
2 7u83 996
}
997
 
6 7u83 998
 
2 7u83 999
dg_type f_dummy_dg_type;
1000
 
6 7u83 1001
dg_type
1002
f_dg_type_apply_token(token token_value, bitstream token_args)
2 7u83 1003
{
6 7u83 1004
	tokval v;
1005
	v = apply_tok(token_value, token_args, DG_TYPE_SORT, (tokval *)0);
1006
	return v.tk_dg_type;
2 7u83 1007
}
1008
 
6 7u83 1009
 
1010
dg_type
1011
f_dg_tag_type(dg_tag tg, dg_type type)
2 7u83 1012
{
6 7u83 1013
	if (tg->key && tg->key != DGK_TYPE) {
1014
		failer("dg_tag defined twice");
1015
	}
1016
	tg->key = DGK_TYPE;
1017
	tg->p.typ = type;
1018
	return type;
2 7u83 1019
}
1020
 
6 7u83 1021
 
1022
dg_type
1023
f_dg_named_type(dg_tag dname)
2 7u83 1024
{
6 7u83 1025
	dg_type ans;
1026
	if (dname->key == DGK_TYPE) {
1027
		return dname->p.typ;
1028
	}
1029
	if (dname->key == DGK_NAME && dname->p.nam->key == DGN_TYPE &&
1030
	    dname->p.nam->data.n_typ.named) {
1031
		return dname->p.nam->data.n_typ.named;
1032
	}
1033
	ans = new_dg_type(DGT_TAGGED);
1034
	ans->data.t_tag = dname;
1035
	if (dname->key == DGK_NONE && dname->outref.k == LAB_STR) {
1036
		dname->key = DGK_TYPE;
1037
		dname->p.typ = ans;
1038
		ans->outref = dname->outref;
1039
	} else if (dname->key == DGK_NAME && dname->p.nam->key == DGN_TYPE) {
1040
		dname->p.nam->data.n_typ.named = ans;
1041
	}
1042
	return ans;
2 7u83 1043
}
1044
 
6 7u83 1045
 
1046
dg_type
1047
f_dg_is_spec_type(dg_type type)
2 7u83 1048
{
6 7u83 1049
	if (!type->mor) {
1050
		extend_dg_type(type);
1051
	}
1052
	type->mor->isspec = 1;
1053
	return type;
2 7u83 1054
}
1055
 
6 7u83 1056
 
1057
dg_type
1058
f_dg_spec_ref_type(dg_tag specification, dg_type type)
2 7u83 1059
{
6 7u83 1060
	if (!type->mor) {
1061
		extend_dg_type(type);
1062
	}
1063
	type->mor->refspec = specification;
1064
	return type;
2 7u83 1065
}
1066
 
6 7u83 1067
 
1068
dg_type
1069
f_dg_modular_type(dg_type rep_type, exp size)
2 7u83 1070
{
6 7u83 1071
	dg_type ans = new_dg_type(DGT_MOD);
1072
	ans->data.t_adanum.rept = rep_type;
1073
	ans->data.t_adanum.digits = diaginfo_exp(size);
1074
	return ans;
2 7u83 1075
}
1076
 
6 7u83 1077
 
1078
dg_type
1079
f_dg_qualified_type(dg_qualifier qualifier, dg_type type)
2 7u83 1080
{
6 7u83 1081
	return get_qual_dg_type(qualifier, type);
2 7u83 1082
}
1083
 
6 7u83 1084
 
1085
dg_type
1086
f_dg_pointer_type(dg_type type, bool_option heap_only)
2 7u83 1087
{
6 7u83 1088
	if (heap_only.present && heap_only.val) {
1089
		return get_qual_dg_type(DG_HPPTR_T, type);
1090
	}
1091
	return get_qual_dg_type(DG_PTR_T, type);
2 7u83 1092
}
1093
 
6 7u83 1094
 
1095
dg_type
1096
f_dg_reference_type(dg_type type)
2 7u83 1097
{
6 7u83 1098
	return get_qual_dg_type(DG_REF_T, type);
2 7u83 1099
}
1100
 
6 7u83 1101
 
1102
dg_type
1103
f_dg_packed_type(dg_type type, shape sha)
2 7u83 1104
{
6 7u83 1105
	UNUSED(sha);
1106
	return get_qual_dg_type(DG_PACK_T, type);
2 7u83 1107
}
1108
 
6 7u83 1109
 
1110
dg_type
1111
f_dg_array_type(dg_type element_type, exp stride, bool_option row_major,
1112
		dg_dim_list dimensions)
2 7u83 1113
{
6 7u83 1114
	dg_type ans = new_dg_type(DGT_ARRAY);
1115
	ans->data.t_arr.elem_type = element_type;
1116
	ans->data.t_arr.stride = diaginfo_exp(stride);
1117
	ans->data.t_arr.rowm = (row_major.present ? row_major.val : 1);
1118
	ans->data.t_arr.dims = dimensions;
1119
	return ans;
2 7u83 1120
}
1121
 
6 7u83 1122
 
1123
dg_type
1124
f_dg_bitfield_type(dg_type type, bitfield_variety bv, shape sha)
2 7u83 1125
{
6 7u83 1126
	return get_dg_bitfield_type(type, sha, bv);
2 7u83 1127
}
1128
 
6 7u83 1129
 
1130
dg_type
1131
f_dg_enum_type(dg_enum_list values, dg_idname_option tagname,
1132
	       dg_sourcepos_option src_pos, shape sha, bool new_type)
2 7u83 1133
{
6 7u83 1134
	dg_type ans = new_dg_type(DGT_ENUM);
1135
	ans->data.t_enum.tnam = idname_chars(tagname);
1136
	ans->data.t_enum.tpos = shorten_sourcepos(src_pos);
1137
	ans->data.t_enum.values = values;
1138
	ans->data.t_enum.sha = sha;
1139
	if (new_type) {
1140
		extend_dg_type(ans);
1141
		ans->mor->isnew = new_type;
1142
	}
1143
	return ans;
2 7u83 1144
}
1145
 
6 7u83 1146
 
1147
dg_type
1148
f_dg_string_type(dg_tag character_type, exp lower_bound, exp length)
2 7u83 1149
{
6 7u83 1150
	dg_type ans = new_dg_type(DGT_STRING);
1151
	ans->data.t_string.ct = character_type;
1152
	ans->data.t_string.lb = diaginfo_exp(lower_bound);
1153
	ans->data.t_string.length = diaginfo_exp(length);
1154
	return ans;
2 7u83 1155
}
1156
 
6 7u83 1157
 
1158
dg_type
1159
f_dg_struct_type(dg_classmem_list fields, shape_option sha,
1160
		 dg_idname_option tagname, dg_sourcepos_option src_pos,
1161
		 dg_varpart_option varpart, bool is_union, bool new_type)
2 7u83 1162
{
6 7u83 1163
	dg_type ans = new_dg_type(DGT_STRUCT);
1164
	ans->data.t_struct.idnam = tagname;
1165
	ans->data.t_struct.tpos = shorten_sourcepos(src_pos);
1166
	ans->data.t_struct.is_union = is_union;
1167
	if (sha.present) {
1168
		ans->data.t_struct.sha = sha.val;
1169
	} else {
1170
		ans->data.t_struct.sha = (shape)0;
1171
	}
1172
	ans->data.t_struct.u.fields = fields;
1173
	if (new_type) {
1174
		extend_dg_type(ans);
1175
		ans->mor->isnew = new_type;
1176
	}
1177
	ans->data.t_struct.vpart = varpart;
1178
	return ans;
2 7u83 1179
}
1180
 
6 7u83 1181
 
2 7u83 1182
dg_type f_dg_void_type = (dg_type)0;
1183
 
6 7u83 1184
dg_type
1185
f_dg_set_type(dg_type element_type, shape sha)
2 7u83 1186
{
6 7u83 1187
	dg_type ans = new_dg_type(DGT_CONS);
1188
	ans->data.t_cons.c_key = DG_SET_T;
1189
	ans->data.t_cons.typ = element_type;
1190
	ans->data.t_cons.sha = sha;
1191
	return ans;
2 7u83 1192
}
1193
 
6 7u83 1194
 
1195
dg_type
1196
f_dg_subrange_type(dg_type rep_type, dg_bound low, dg_bound high)
2 7u83 1197
{
6 7u83 1198
	dg_type ans = new_dg_type(DGT_SUBR);
1199
	ans->data.t_subr.d_key = DG_DIM_BOUNDS;
1200
	ans->data.t_subr.low_ref = low.is_ref;
1201
	ans->data.t_subr.hi_ref = high.is_ref;
1202
	ans->data.t_subr.hi_cnt = 0;
1203
	ans->data.t_subr.count = -1;
1204
	ans->data.t_subr.d_typ = rep_type;
1205
	ans->data.t_subr.sha = low.sha;
1206
	ans->data.t_subr.lower = low.u;
1207
	ans->data.t_subr.upper = high.u;
1208
	return ans;
2 7u83 1209
}
1210
 
6 7u83 1211
 
1212
dg_type
1213
f_dg_proc_type(dg_param_list params, dg_type result_type,
1214
	       bool_option prototype, nat_option call_convention,
1215
	       nat_option language, procprops_option prcprops)
2 7u83 1216
{
6 7u83 1217
	dg_type ans = new_dg_type(DGT_PROC);
1218
	ans->data.t_proc.params = params;
1219
	ans->data.t_proc.res_type = result_type;
1220
	ans->data.t_proc.prps = prcprops;
1221
	if (prototype.present) {
1222
		ans->data.t_proc.knowpro = 1;
1223
		ans->data.t_proc.yespro = prototype.val;
1224
	} else {
1225
		ans->data.t_proc.knowpro = 0;
1226
	}
1227
	if (call_convention.present) {
1228
		ans->data.t_proc.ccv =
1229
		    (unsigned)call_convention.val.nat_val.small_nat;
1230
	} else {
1231
		ans->data.t_proc.ccv = 0;
1232
	}
1233
	if (language.present) {
1234
		ans->data.t_proc.lang =
1235
		    (unsigned)language.val.nat_val.small_nat;
1236
	} else {
1237
		ans->data.t_proc.lang = 0;
1238
	}
1239
	return ans;
2 7u83 1240
}
1241
 
6 7u83 1242
 
1243
dg_type
1244
f_dg_file_type(dg_type elem_type, shape sha)
2 7u83 1245
{
6 7u83 1246
	dg_type ans = new_dg_type(DGT_CONS);
1247
	ans->data.t_cons.c_key = DG_FILE_T;
1248
	ans->data.t_cons.typ = elem_type;
1249
	ans->data.t_cons.sha = sha;
1250
	return ans;
2 7u83 1251
}
1252
 
6 7u83 1253
 
1254
dg_type
1255
f_dg_class_type(dg_class_base_list inheritance, dg_classmem_list members,
1256
		dg_varpart_option varpart, dg_tag_list friends,
1257
		shape_option sha, dg_tag_option vtable_static,
1258
		dg_tag_option vtable_dynamic, dg_idname_option tagname,
1259
		dg_sourcepos_option src_pos, bool is_union,
1260
		dg_tag_option rtti_static, dg_tag_option rtti_dynamic,
1261
		bool new_type, bool_option ada_derived)
2 7u83 1262
{
6 7u83 1263
	dg_type ans = new_dg_type(DGT_CLASS);
1264
	ans->data.t_struct.idnam = tagname;
1265
	ans->data.t_struct.tpos = shorten_sourcepos(src_pos);
1266
	ans->data.t_struct.is_union = is_union;
1267
	if (sha.present) {
1268
		ans->data.t_struct.sha = sha.val;
1269
	} else {
1270
		ans->data.t_struct.sha = (shape)0;
1271
	}
1272
	ans->data.t_struct.u.cd = (class_data *)xmalloc(sizeof(class_data));
1273
	if (new_type || (ada_derived.present && ada_derived.val)) {
1274
		extend_dg_type(ans);
1275
		ans->mor->isnew = new_type;
1276
		if (ada_derived.present) {
1277
			ans->mor->aderiv = ada_derived.val;
1278
		}
1279
	}
1280
	ans->data.t_struct.u.cd->inherits = inheritance;
1281
	ans->data.t_struct.u.cd->members = members;
1282
	ans->data.t_struct.u.cd->friends = friends;
1283
	ans->data.t_struct.u.cd->vt_s = vtable_static;
1284
	ans->data.t_struct.u.cd->vt_d = vtable_dynamic;
1285
	ans->data.t_struct.u.cd->rtti_s = rtti_static;
1286
	ans->data.t_struct.u.cd->rtti_d = rtti_dynamic;
1287
	ans->data.t_struct.vpart = varpart;
1288
	return ans;
2 7u83 1289
}
1290
 
6 7u83 1291
 
1292
dg_type
1293
f_dg_ptr_memdata_type(dg_tag cls, dg_type memtype, shape sha,
1294
		      dg_tag_option pdm_type)
2 7u83 1295
{
6 7u83 1296
	dg_type ans = new_dg_type(DGT_PMEM);
1297
	ans->data.t_pmem.pclass = cls;
1298
	ans->data.t_pmem.memtyp = memtype;
1299
	ans->data.t_pmem.sha = sha;
1300
	UNUSED(pdm_type);
1301
	return ans;
2 7u83 1302
}
1303
 
6 7u83 1304
 
1305
dg_type
1306
f_dg_ptr_memfn_type(dg_tag cls, dg_type memtype, shape sha,
1307
		    dg_tag_option pfn_type)
2 7u83 1308
{
6 7u83 1309
	dg_type ans = new_dg_type(DGT_PMEM);
1310
	ans->data.t_pmem.pclass = cls;
1311
	ans->data.t_pmem.memtyp = memtype;
1312
	ans->data.t_pmem.sha = sha;
1313
	UNUSED(pfn_type);
1314
	return ans;
2 7u83 1315
}
1316
 
6 7u83 1317
 
1318
dg_type
1319
f_dg_task_type(dg_idname idname, dg_sourcepos whence, dg_name_list entries,
1320
	       dg_tag task_id, dg_tag tcb, dg_classmem_list members,
1321
	       dg_varpart_option varpart, shape_option sha,
1322
	       bool new_type, dg_tag_option elaboration)
2 7u83 1323
{
6 7u83 1324
	dg_type ans = new_dg_type(DGT_A_TASK);
1325
	ans->data.t_struct.idnam = idname;
1326
	ans->data.t_struct.tpos = shorten_sourcepos(whence);
1327
	ans->data.t_struct.is_union = 0;
1328
	if (sha.present) {
1329
		ans->data.t_struct.sha = sha.val;
1330
	} else {
1331
		ans->data.t_struct.sha = (shape)0;
1332
	}
1333
	ans->data.t_struct.u.td = (task_data *)xmalloc(sizeof(task_data));
1334
	if (new_type || elaboration) {
1335
		extend_dg_type(ans);
1336
		ans->mor->isnew = new_type;
1337
		ans->mor->elabn = elaboration;
1338
	}
1339
	ans->data.t_struct.u.td->entries = entries;
1340
	ans->data.t_struct.u.td->id = task_id;
1341
	ans->data.t_struct.u.td->cb = tcb;
1342
	ans->data.t_struct.u.td->members = members;
1343
	ans->data.t_struct.vpart = varpart;
1344
	return ans;
2 7u83 1345
}
1346
 
6 7u83 1347
 
1348
dg_type
1349
f_dg_address_type(dg_idname idname, shape sha)
2 7u83 1350
{
6 7u83 1351
	dg_type ans = new_dg_type(DGT_BASIC);
1352
	ans->data.t_bas.b_key = DG_ADR_T;
1353
	ans->data.t_bas.tnam = idname_chars(idname);
1354
	ans->data.t_bas.b_sh = sha;
1355
	return ans;
2 7u83 1356
}
1357
 
6 7u83 1358
 
1359
dg_type
1360
f_dg_boolean_type(dg_idname idname, variety var)
2 7u83 1361
{
6 7u83 1362
	dg_type ans = new_dg_type(DGT_BASIC);
1363
	ans->data.t_bas.b_key = DG_BOOL_T;
1364
	ans->data.t_bas.tnam = idname_chars(idname);
1365
	ans->data.t_bas.b_sh = f_integer(var);
1366
	return ans;
2 7u83 1367
}
1368
 
6 7u83 1369
 
1370
dg_type
1371
f_dg_complex_float_type(dg_idname idname, floating_variety var)
2 7u83 1372
{
6 7u83 1373
	dg_type ans = new_dg_type(DGT_BASIC);
1374
	ans->data.t_bas.b_key = DG_FLOAT_T;
1375
	ans->data.t_bas.tnam = idname_chars(idname);
1376
	ans->data.t_bas.b_sh = f_floating(var);
1377
	return ans;
2 7u83 1378
}
1379
 
6 7u83 1380
 
1381
dg_type
1382
f_dg_float_type(dg_idname idname, floating_variety var)
2 7u83 1383
{
6 7u83 1384
	dg_type ans = new_dg_type(DGT_BASIC);
1385
	ans->data.t_bas.b_key = DG_FLOAT_T;
1386
	ans->data.t_bas.tnam = idname_chars(idname);
1387
	ans->data.t_bas.b_sh = f_floating(var);
1388
	return ans;
2 7u83 1389
}
1390
 
6 7u83 1391
 
1392
dg_type
1393
f_dg_floating_digits_type(dg_type rep_type, exp digits)
2 7u83 1394
{
6 7u83 1395
	dg_type ans = new_dg_type(DGT_FLDIG);
1396
	ans->data.t_adanum.rept = rep_type;
1397
	ans->data.t_adanum.digits = diaginfo_exp(digits);
1398
	return ans;
2 7u83 1399
}
1400
 
6 7u83 1401
 
1402
dg_type
1403
f_dg_fixed_point_type(dg_type rep_type, exp small, exp_option delta,
1404
		      exp_option digits)
2 7u83 1405
{
6 7u83 1406
	dg_type ans = new_dg_type(DGT_FIXED);
1407
	ans->data.t_adanum.rept = rep_type;
1408
	ans->data.t_adanum.small = diaginfo_exp(small);
1409
	if (delta.present) {
1410
		ans->data.t_adanum.delta = diaginfo_exp(delta.val);
1411
	} else {
1412
		ans->data.t_adanum.delta = nilexp;
1413
	}
1414
	if (digits.present) {
1415
		ans->data.t_adanum.digits = diaginfo_exp(digits.val);
1416
	} else {
1417
		ans->data.t_adanum.digits = nilexp;
1418
	}
1419
	return ans;
2 7u83 1420
}
1421
 
6 7u83 1422
 
1423
dg_type
1424
f_dg_integer_type(dg_idname idname, variety var)
2 7u83 1425
{
6 7u83 1426
	dg_type ans = new_dg_type(DGT_BASIC);
1427
	ans->data.t_bas.b_key = DG_INT_T;
1428
	ans->data.t_bas.tnam = idname_chars(idname);
1429
	ans->data.t_bas.b_sh = f_integer(var);
1430
	return ans;
2 7u83 1431
}
1432
 
6 7u83 1433
 
1434
dg_type
1435
f_dg_char_type(dg_idname idname, variety var)
2 7u83 1436
{
6 7u83 1437
	dg_type ans = new_dg_type(DGT_BASIC);
1438
	ans->data.t_bas.b_key = DG_CHAR_T;
1439
	ans->data.t_bas.tnam = idname_chars(idname);
1440
	ans->data.t_bas.b_sh = f_integer(var);
1441
	return ans;
2 7u83 1442
}
1443
 
6 7u83 1444
 
1445
dg_type
1446
f_dg_inlined_type(dg_type type, dg_tag origin)
2 7u83 1447
{
6 7u83 1448
	if (!type->mor) {
1449
		extend_dg_type(type);
1450
	}
1451
	type->mor->inline_ref = origin;
1452
	return type;
2 7u83 1453
}
1454
 
6 7u83 1455
 
1456
dg_type
1457
f_dg_synchronous_type(dg_idname idname, dg_sourcepos whence,
1458
		      dg_name_list entries, dg_tag socb,
1459
		      dg_classmem_list members, dg_varpart_option varpart,
1460
		      shape_option sha, bool new_type,
1461
		      dg_tag_option elaboration)
2 7u83 1462
{
6 7u83 1463
	dg_type ans = new_dg_type(DGT_A_SYNCH);
1464
	ans->data.t_struct.idnam = idname;
1465
	ans->data.t_struct.tpos = shorten_sourcepos(whence);
1466
	ans->data.t_struct.is_union = 0;
1467
	if (sha.present) {
1468
		ans->data.t_struct.sha = sha.val;
1469
	} else {
1470
		ans->data.t_struct.sha = (shape)0;
1471
	}
1472
	ans->data.t_struct.u.td = (task_data *)xmalloc(sizeof(task_data));
1473
	if (new_type || elaboration) {
1474
		extend_dg_type(ans);
1475
		ans->mor->isnew = new_type;
1476
		ans->mor->elabn = elaboration;
1477
	}
1478
	ans->data.t_struct.u.td->entries = entries;
1479
	ans->data.t_struct.u.td->id = (dg_tag)0;
1480
	ans->data.t_struct.u.td->cb = socb;
1481
	ans->data.t_struct.u.td->members = members;
1482
	ans->data.t_struct.vpart = varpart;
1483
	return ans;
2 7u83 1484
}
1485
 
1486
 
6 7u83 1487
dg_type
1488
f_dg_unknown_type(shape sha)
2 7u83 1489
{
6 7u83 1490
	dg_type ans = new_dg_type(DGT_UNKNOWN);
1491
	UNUSED(sha);
1492
	return ans;
2 7u83 1493
}
1494
 
6 7u83 1495
 
1496
void
1497
init_dg_type(void)
2 7u83 1498
{
6 7u83 1499
	return;
2 7u83 1500
}
1501
 
6 7u83 1502
 
2 7u83 1503
dg_class_base f_dummy_dg_class_base;
1504
 
6 7u83 1505
dg_class_base
1506
f_make_dg_class_base(dg_tag base, dg_sourcepos_option whence,
1507
		     token_option location,
1508
		     dg_accessibility_option accessibility,
1509
		     dg_virtuality_option virtuality)
2 7u83 1510
{
6 7u83 1511
	dg_class_base ans;
1512
	ans.base = base;
1513
	ans.pos = shorten_sourcepos(whence);
1514
	if (location.present) {
1515
		shape ptr_sh = f_pointer(f_alignment(ulongsh));
1516
		ans.location = relative_exp(ptr_sh, location.val);
1517
	} else {
1518
		ans.location = nilexp;
1519
	}
1520
	ans.acc = accessibility;
1521
	ans.virt = virtuality;
1522
	return ans;
2 7u83 1523
}
1524
 
6 7u83 1525
 
1526
void
1527
init_dg_class_base(void)
2 7u83 1528
{
6 7u83 1529
	return;
2 7u83 1530
}
1531
 
6 7u83 1532
 
2 7u83 1533
dg_classmem f_dummy_dg_classmem;
1534
 
6 7u83 1535
dg_classmem
1536
f_dg_tag_classmem(dg_tag tg, dg_classmem mem)
2 7u83 1537
{
6 7u83 1538
	if (tg->key) {
1539
		failer("dg_tag defined twice");
1540
	}
1541
	tg->key = DGK_CLASSMEM;
1542
	mem.tg = tg;
1543
	return mem;
2 7u83 1544
}
1545
 
6 7u83 1546
 
1547
dg_classmem
1548
f_dg_field_classmem(dg_idname idname, dg_sourcepos src_pos, exp offset,
1549
		    dg_type field_type, dg_accessibility_option accessibility,
1550
		    bool_option discr, dg_default_option deflt)
2 7u83 1551
{
6 7u83 1552
	int is_discr = 0;
1553
	dg_classmem ans;
1554
	ans.cm_key = DG_CM_FIELD;
1555
	ans.d.cm_f.fnam = idname_chars(idname);
1556
	ans.d.cm_f.f_pos = shorten_sourcepos(src_pos);
1557
	ans.d.cm_f.f_typ = field_type;
1558
	ans.d.cm_f.f_offset = diaginfo_exp(offset);
1559
	ans.d.cm_f.acc = accessibility;
1560
	if (discr.present) {
1561
		is_discr = discr.val;
1562
	}
1563
	ans.d.cm_f.discr = is_discr;
1564
	ans.d.cm_f.dflt = deflt;
1565
	ans.tg = (dg_tag)0;
1566
	return ans;
2 7u83 1567
}
1568
 
6 7u83 1569
 
1570
dg_classmem
1571
f_dg_function_classmem(dg_name fn, exp_option vtable_slot)
2 7u83 1572
{
6 7u83 1573
	dg_classmem ans;
1574
	ans.cm_key = DG_CM_FN;
1575
	ans.d.cm_fn.fn = fn;
1576
	if (vtable_slot.present) {
1577
		ans.d.cm_fn.slot = diaginfo_exp(vtable_slot.val);
1578
	} else {
1579
		ans.d.cm_fn.slot = nilexp;
1580
	}
1581
	ans.tg = (dg_tag)0;
1582
	return ans;
2 7u83 1583
}
1584
 
6 7u83 1585
 
1586
dg_classmem
1587
f_dg_indirect_classmem(dg_idname idname, dg_sourcepos src_pos, token location,
1588
		       dg_type cmem_type)
2 7u83 1589
{
6 7u83 1590
	dg_classmem ans;
1591
	ans.cm_key = DG_CM_INDIRECT;
1592
	ans.d.cm_ind.nam = idname_chars(idname);
1593
	ans.d.cm_ind.pos = shorten_sourcepos(src_pos);
1594
	ans.d.cm_ind.typ = cmem_type;
1595
	ans.d.cm_ind.ind_loc = relative_exp(f_pointer(f_alignment(ulongsh)),
1596
					    location);
1597
	ans.tg = (dg_tag)0;
1598
	return ans;
2 7u83 1599
}
1600
 
6 7u83 1601
 
1602
dg_classmem
1603
f_dg_name_classmem(dg_name nam)
2 7u83 1604
{
6 7u83 1605
	dg_classmem ans;
1606
	ans.cm_key = DG_CM_STAT;
1607
	ans.d.cm_stat = nam;
1608
	ans.tg = (dg_tag)0;
1609
	return ans;
2 7u83 1610
}
1611
 
6 7u83 1612
 
1613
void
1614
init_dg_classmem(void)
2 7u83 1615
{
6 7u83 1616
	return;
2 7u83 1617
}
1618
 
6 7u83 1619
 
2 7u83 1620
dg_qualifier f_dummy_dg_qualifier;
1621
 
1622
dg_qualifier f_dg_const_qualifier = DG_CONST_T;
1623
 
1624
dg_qualifier f_dg_volatile_qualifier = DG_VOL_T;
1625
 
1626
dg_qualifier f_dg_aliased_qualifier = DG_ALIAS_T;
1627
 
1628
dg_qualifier f_dg_class_wide_qualifier = DG_CLWID_T;
1629
 
1630
dg_qualifier f_dg_limited_qualifier = DG_LIM_T;
1631
 
6 7u83 1632
void
1633
init_dg_qualifier(void)
2 7u83 1634
{
6 7u83 1635
	return;
2 7u83 1636
}
1637
 
6 7u83 1638
 
2 7u83 1639
dg_bound f_dummy_dg_bound;
1640
 
6 7u83 1641
dg_bound
1642
f_dg_dynamic_bound(dg_tag bound, shape sha)
2 7u83 1643
{
6 7u83 1644
	dg_bound ans;
1645
	ans.is_ref = 1;
1646
	ans.u.tg = bound;
1647
	ans.sha = sha;
1648
	return ans;
2 7u83 1649
}
1650
 
6 7u83 1651
 
1652
dg_bound
1653
f_dg_static_bound(exp bound)
2 7u83 1654
{
6 7u83 1655
	dg_bound ans;
1656
	if (name(bound) != val_tag) {
1657
		failer("not a constant");
1658
	}
1659
	ans.is_ref = 0;
1660
	ans.u.x = diaginfo_exp(bound);
1661
	ans.sha = sh(bound);
1662
	return ans;
2 7u83 1663
}
1664
 
6 7u83 1665
 
1666
dg_bound
1667
f_dg_unknown_bound(shape sha)
2 7u83 1668
{
6 7u83 1669
	dg_bound ans;
1670
	ans.is_ref = 1;
1671
	ans.u.tg = (dg_tag)0;
1672
	ans.sha = sha;
1673
	return ans;
2 7u83 1674
}
1675
 
6 7u83 1676
 
1677
void
1678
init_dg_bound(void)
2 7u83 1679
{
6 7u83 1680
	return;
2 7u83 1681
}
1682
 
6 7u83 1683
 
2 7u83 1684
dg_dim f_dummy_dg_dim;
1685
 
6 7u83 1686
dg_dim
1687
f_dg_dim_apply_token(token token_value, bitstream token_args)
2 7u83 1688
{
6 7u83 1689
	tokval v;
1690
	v = apply_tok(token_value, token_args, DG_DIM_SORT, (tokval *)0);
1691
	return v.tk_dg_dim;
2 7u83 1692
}
1693
 
6 7u83 1694
 
1695
dg_dim
1696
f_dg_tag_dim(dg_tag tg, dg_dim d)
2 7u83 1697
{
6 7u83 1698
	if (tg->key) {
1699
		failer("dg_tag defined twice");
1700
	}
1701
	tg->key = DGK_DIM;
1702
	d.tg = tg;
1703
	return d;
2 7u83 1704
}
1705
 
6 7u83 1706
 
1707
dg_dim
1708
f_dg_bounds_dim(dg_bound low, dg_bound high, dg_type index_type)
2 7u83 1709
{
6 7u83 1710
	dg_dim ans;
1711
	ans.d_key = DG_DIM_BOUNDS;
1712
	ans.low_ref = low.is_ref;
1713
	ans.hi_ref = high.is_ref;
1714
	ans.hi_cnt = 0;
1715
	ans.d_typ = index_type;
1716
	ans.sha = low.sha;
1717
	ans.lower = low.u;
1718
	ans.upper = high.u;
1719
	if (low.is_ref || high.is_ref) {
1720
		ans.count = -1;
1721
	} else {
1722
		ans.count = (long)(no(son(high.u.x)) - no(son(low.u.x)) + 1);
1723
	}
1724
	ans.tg = (dg_tag)0;
1725
	return ans;
2 7u83 1726
}
1727
 
6 7u83 1728
 
1729
dg_dim
1730
f_dg_count_dim(dg_bound low, dg_bound count, dg_type index_type)
2 7u83 1731
{
6 7u83 1732
	dg_dim ans;
1733
	ans.d_key = DG_DIM_BOUNDS;
1734
	ans.low_ref = low.is_ref;
1735
	ans.hi_ref = count.is_ref;
1736
	ans.hi_cnt = 1;
1737
	ans.d_typ = index_type;
1738
	ans.sha = low.sha;
1739
	ans.lower = low.u;
1740
	ans.upper = count.u;
1741
	if (count.is_ref) {
1742
		ans.count = -1;
1743
	} else {
1744
		ans.count = (long)(no(son(count.u.x)));
1745
	}
1746
	ans.tg = (dg_tag)0;
1747
	return ans;
2 7u83 1748
}
1749
 
6 7u83 1750
 
1751
dg_dim
1752
f_dg_type_dim(dg_type type, nat_option n)
2 7u83 1753
{
6 7u83 1754
	dg_dim ans;
1755
	ans.d_key = DG_DIM_TYPE;
1756
	ans.d_typ = type;
1757
	if (n.present) {
1758
		ans.count = (long)n.val.nat_val.small_nat;
1759
	} else {
1760
		ans.count = -1;
1761
	}
1762
	ans.tg = (dg_tag)0;
1763
	return ans;
2 7u83 1764
}
1765
 
6 7u83 1766
 
2 7u83 1767
dg_dim f_dg_unspecified_dim;
1768
 
6 7u83 1769
void
1770
init_dg_dim(void)
2 7u83 1771
{
6 7u83 1772
	f_dg_unspecified_dim.d_key = DG_DIM_NONE;
1773
	f_dg_unspecified_dim.low_ref = f_dg_unspecified_dim.hi_ref = 1;
1774
	f_dg_unspecified_dim.hi_cnt = 0;
1775
	f_dg_unspecified_dim.count = -1;
1776
	f_dg_unspecified_dim.d_typ = (dg_type)0;
1777
	f_dg_unspecified_dim.sha = f_top;
1778
	f_dg_unspecified_dim.lower.tg = f_dg_unspecified_dim.upper.tg =
1779
	    (dg_tag)0;
1780
	f_dg_unspecified_dim.tg = (dg_tag)0;
1781
	return;
2 7u83 1782
}
1783
 
6 7u83 1784
 
2 7u83 1785
dg_enum f_dummy_dg_enum;
1786
 
6 7u83 1787
dg_enum
1788
f_make_dg_enum(exp value, dg_idname idname, dg_sourcepos src_pos)
2 7u83 1789
{
6 7u83 1790
	dg_enum ans;
1791
	if (!value || name(value) != val_tag) {
1792
		failer("enum value not const");
1793
	}
1794
	ans.enam = idname_chars(idname);
1795
	ans.pos = shorten_sourcepos(src_pos);
1796
	ans.value = diaginfo_exp(value);
1797
	ans.is_chn = 0;
1798
	ans.tg = (dg_tag)0;
1799
	return ans;
2 7u83 1800
}
1801
 
6 7u83 1802
 
1803
dg_enum
1804
f_dg_char_enum(exp value, nat idchar, dg_sourcepos src_pos)
2 7u83 1805
{
6 7u83 1806
	dg_enum ans;
1807
	if (!value || name(value) != val_tag) {
1808
		failer("enum value not const");
1809
	}
1810
	ans.chn = idchar.nat_val.small_nat;
1811
	ans.pos = shorten_sourcepos(src_pos);
1812
	ans.value = diaginfo_exp(value);
1813
	ans.is_chn = 1;
1814
	ans.tg = (dg_tag)0;
1815
	return ans;
2 7u83 1816
}
1817
 
6 7u83 1818
 
1819
dg_enum
1820
f_dg_tag_enum(dg_tag tg, dg_enum e)
2 7u83 1821
{
6 7u83 1822
	if (tg->key) {
1823
		failer("dg_tag defined twice");
1824
	}
1825
	tg->key = DGK_ENUM;
1826
	e.tg = tg;
1827
	return e;
2 7u83 1828
}
1829
 
6 7u83 1830
 
1831
void
1832
init_dg_enum(void)
2 7u83 1833
{
6 7u83 1834
	return;
2 7u83 1835
}
1836
 
1837
dg_param f_dummy_dg_param;
1838
 
6 7u83 1839
dg_param
1840
f_dg_object_param(dg_idname_option idname, dg_sourcepos_option src_pos,
1841
		  dg_param_mode_option mode, dg_type param_type,
1842
		  dg_default_option deflt)
2 7u83 1843
{
6 7u83 1844
	dg_param ans;
1845
	ans.pnam = idname_chars(idname);
1846
	ans.ppos = shorten_sourcepos(src_pos);
1847
	ans.pmode = mode;
1848
	ans.p_typ = param_type;
1849
	ans.p_dflt = deflt;
1850
	return ans;
2 7u83 1851
}
1852
 
6 7u83 1853
 
1854
dg_param
1855
f_dg_type_param(dg_idname_option idname, dg_sourcepos_option src_pos,
1856
		dg_param_list fparams)
2 7u83 1857
{
6 7u83 1858
	failer("dg_type_param not yet supported");
1859
	UNUSED(idname);
1860
	UNUSED(src_pos);
1861
	UNUSED(fparams);
1862
	return f_dummy_dg_param;
2 7u83 1863
}
1864
 
6 7u83 1865
 
1866
void
1867
init_dg_param(void)
2 7u83 1868
{
6 7u83 1869
	return;
2 7u83 1870
}
1871
 
1872
dg_param_mode f_dummy_dg_param_mode;
1873
 
1874
dg_param_mode f_dg_in_mode = DG_IN_MODE;
1875
 
1876
dg_param_mode f_dg_out_mode = DG_OUT_MODE;
1877
 
1878
dg_param_mode f_dg_inout_mode = DG_INOUT_MODE;
1879
 
6 7u83 1880
 
1881
void
1882
init_dg_param_mode(void)
2 7u83 1883
{
6 7u83 1884
	return;
2 7u83 1885
}
1886
 
1887
dg_accessibility f_dummy_dg_accessibility;
1888
 
1889
dg_accessibility f_dg_public_accessibility = DG_ACC_PUB;
1890
 
1891
dg_accessibility f_dg_private_accessibility = DG_ACC_PRIV;
1892
 
1893
dg_accessibility f_dg_protected_accessibility = DG_ACC_PROT;
1894
 
1895
dg_accessibility f_dg_local_accessibility = DG_ACC_LOC;
1896
 
6 7u83 1897
 
1898
void
1899
init_dg_accessibility(void)
2 7u83 1900
{
6 7u83 1901
	return;
2 7u83 1902
}
1903
 
1904
dg_virtuality f_dummy_dg_virtuality;
1905
 
1906
dg_virtuality f_dg_virtual_virtuality = DG_VIRT_VIRT;
1907
 
1908
dg_virtuality f_dg_abstract_virtuality = DG_VIRT_PURE;
1909
 
6 7u83 1910
 
1911
void
1912
init_dg_virtuality(void)
2 7u83 1913
{
6 7u83 1914
	return;
2 7u83 1915
}
1916
 
6 7u83 1917
 
2 7u83 1918
dg_filename f_dummy_dg_filename;
1919
 
6 7u83 1920
dg_filename
1921
f_dg_filename_apply_token(token token_value, bitstream token_args)
2 7u83 1922
{
6 7u83 1923
	tokval v;
1924
	v = apply_tok(token_value, token_args, DG_FILENAME_SORT, (tokval *)0);
1925
	return v.tk_dg_filename;
2 7u83 1926
}
1927
 
6 7u83 1928
 
1929
dg_filename
1930
f_make_dg_filename(nat date, string machine, string path, string file)
2 7u83 1931
{
6 7u83 1932
	return get_filename((long)(date.nat_val.small_nat), machine.ints.chars,
1933
			    path.ints.chars, file.ints.chars);
2 7u83 1934
}
1935
 
6 7u83 1936
 
1937
void
1938
init_dg_filename(void)
2 7u83 1939
{
6 7u83 1940
	return;
2 7u83 1941
}
1942
 
6 7u83 1943
 
2 7u83 1944
dg_sourcepos f_dummy_dg_sourcepos;
1945
 
6 7u83 1946
dg_sourcepos f_dg_span_sourcepos(dg_filename file, nat from_line,
1947
				 nat from_column, dg_filename_option to_file,
1948
				 nat to_line, nat to_column)
2 7u83 1949
{
6 7u83 1950
	dg_sourcepos ans;
1951
	ans.sp_key = SP_SPAN;
1952
	ans.file = file;
1953
	if (!(ans.to_file = to_file)) {
1954
		ans.to_file = file;
1955
	}
1956
	ans.from_line = from_line.nat_val.small_nat;
1957
	ans.from_column = (short)from_column.nat_val.small_nat;
1958
	ans.to_line = to_line.nat_val.small_nat;
1959
	ans.to_column = (short)to_column.nat_val.small_nat;
1960
	return ans;
2 7u83 1961
}
1962
 
6 7u83 1963
 
1964
dg_sourcepos
1965
f_dg_mark_sourcepos(dg_filename file, nat line, nat column)
2 7u83 1966
{
6 7u83 1967
	dg_sourcepos ans;
1968
	ans.sp_key = SP_SHORT;
1969
	ans.file = file;
1970
	ans.from_line = line.nat_val.small_nat;
1971
	ans.from_column = (short)column.nat_val.small_nat;
1972
	return ans;
2 7u83 1973
}
1974
 
6 7u83 1975
 
1976
dg_sourcepos
1977
f_dg_file_sourcepos(dg_filename file)
2 7u83 1978
{
6 7u83 1979
	dg_sourcepos ans;
1980
	ans.sp_key = SP_FILE;
1981
	ans.file = file;
1982
	return ans;
2 7u83 1983
}
1984
 
6 7u83 1985
 
2 7u83 1986
dg_sourcepos f_dg_global_sourcepos;
1987
 
1988
dg_sourcepos f_dg_null_sourcepos;
1989
 
6 7u83 1990
void
1991
init_dg_sourcepos(void)
2 7u83 1992
{
6 7u83 1993
	f_dg_global_sourcepos.sp_key = SP_GLOB;
1994
	f_dg_null_sourcepos.sp_key = SP_NULL;
1995
	return;
2 7u83 1996
}
1997
 
6 7u83 1998
 
2 7u83 1999
dg_compilation f_dummy_dg_compilation;
2000
 
6 7u83 2001
dg_compilation
2002
f_dg_tag_compilation(dg_tag tg, dg_compilation comp)
2 7u83 2003
{
6 7u83 2004
	if (tg->key) {
2005
		failer("dg_tag defined twice");
2006
	}
2007
	tg->key = DGK_COMP;
2008
	tg->p.comp = comp;
2009
	return comp;
2 7u83 2010
}
2011
 
6 7u83 2012
 
2013
dg_compilation
2014
f_make_dg_compilation(dg_filename primary_file, string_list comp_unit_deps,
2015
		      dg_macro_list macros, dg_filename comp_dir, nat date,
2016
		      nat language, nat id_case, string producer,
2017
		      string_list options, dg_namelist dnames)
2 7u83 2018
{
6 7u83 2019
	dg_compilation ans = (dg_compilation)xmalloc(sizeof(struct dg_comp_t));
2020
	ans->prim_file = primary_file;
2021
	ans->comp_deps = comp_unit_deps;
2022
	ans->date = date.nat_val.small_nat;
2023
	ans->language = language.nat_val.small_nat;
2024
	ans->id_case = id_case.nat_val.small_nat;
2025
	ans->producer = producer.ints.chars;
2026
	ans->comp_dir = comp_dir;
2027
	ans->options = options;
2028
	ans->dn_list = dnames.list;
2029
	if (dnames.tg) {
2030
		dnames.tg->p.nl = &(ans->dn_list);
2031
	}
2032
	ans->another = (dg_compilation)0;
2033
	ans->macros = macros;
2034
	return ans;
2 7u83 2035
}
2036
 
6 7u83 2037
 
2038
void
2039
init_dg_compilation(void)
2 7u83 2040
{
6 7u83 2041
	return;
2 7u83 2042
}
2043
 
6 7u83 2044
 
2 7u83 2045
dg_constraint f_dummy_dg_constraint;
2046
 
6 7u83 2047
dg_constraint
2048
f_dg_type_constraint(dg_tag_option ref_member, dg_type type)
2 7u83 2049
{
6 7u83 2050
	dg_constraint ans = (dg_constraint)xcalloc(1, sizeof(struct dg_con));
2051
	ans->refmem = ref_member;
2052
	ans->is_val = 0;
2053
	ans->u.typ = type;
2054
	ans->next = (dg_constraint)0;
2055
	return ans;
2 7u83 2056
}
2057
 
6 7u83 2058
 
2059
dg_constraint
2060
f_dg_value_constraint(dg_tag_option ref_member, exp value)
2 7u83 2061
{
6 7u83 2062
	dg_constraint ans = (dg_constraint)xcalloc(1, sizeof(struct dg_con));
2063
	ans->refmem = ref_member;
2064
	ans->is_val = 1;
2065
	ans->u.val = value;
2066
	ans->next = (dg_constraint)0;
2067
	return ans;
2 7u83 2068
}
2069
 
6 7u83 2070
 
2071
void
2072
init_dg_constraint(void)
2 7u83 2073
{
6 7u83 2074
	return;
2 7u83 2075
}
2076
 
6 7u83 2077
 
2 7u83 2078
dg_default f_dummy_dg_default;
2079
 
6 7u83 2080
dg_default
2081
f_make_dg_default(exp_option value, dg_sourcepos_option src_span)
2 7u83 2082
{
6 7u83 2083
	dg_default ans;
2084
	if (value.present) {
2085
		ans.val = diaginfo_exp(value.val);
2086
	} else {
2087
		ans.val = nilexp;
2088
	}
2089
	ans.span = src_span;
2090
	ans.lab = (long)0;
2091
	return ans;
2 7u83 2092
}
2093
 
6 7u83 2094
 
2095
void
2096
init_dg_default(void)
2 7u83 2097
{
6 7u83 2098
	return;
2 7u83 2099
}
2100
 
6 7u83 2101
 
2 7u83 2102
dg_idname f_dummy_dg_idname;
2103
 
6 7u83 2104
dg_idname
2105
f_dg_idname_apply_token(token token_value, bitstream token_args)
2 7u83 2106
{
6 7u83 2107
	tokval v;
2108
	v = apply_tok(token_value, token_args, DG_IDNAME_SORT, (tokval *)0);
2109
	return v.tk_dg_idname;
2 7u83 2110
}
2111
 
6 7u83 2112
 
2113
dg_idname
2114
f_dg_sourcestring_idname(string src_name)
2 7u83 2115
{
6 7u83 2116
	dg_idname ans;
2117
	ans.id_key = DG_ID_SRC;
2118
	ans.idd.nam = src_name.ints.chars;
2119
	return ans;
2 7u83 2120
}
2121
 
6 7u83 2122
 
2123
dg_idname
2124
f_dg_anonymous_idname(string_option descr)
2 7u83 2125
{
6 7u83 2126
	dg_idname ans;
2127
	ans.id_key = DG_ID_ANON;
2128
	UNUSED(descr);
2129
	ans.idd.nam = "";
2130
	return ans;
2 7u83 2131
}
2132
 
6 7u83 2133
 
2134
dg_idname
2135
f_dg_artificial_idname(string_option aname)
2 7u83 2136
{
6 7u83 2137
	dg_idname ans;
2138
	ans.id_key = DG_ID_ARTFL;
2139
	if (aname.present) {
2140
		ans.idd.nam = aname.val.ints.chars;
2141
	} else {
2142
		ans.idd.nam = "";
2143
	}
2144
	return ans;
2 7u83 2145
}
2146
 
6 7u83 2147
 
2148
dg_idname
2149
f_dg_instance_idname(dg_idname_option idname, dg_idname spec,
2150
		     dg_sourcepos whence, dg_name_list aparams)
2 7u83 2151
{
6 7u83 2152
	dg_idname ans;
2153
	ans.id_key = DG_ID_INST;
2154
	ans.idd.instance = (dg_instantn *)xcalloc(1, sizeof(dg_instantn));
2155
	ans.idd.instance->nam = idname;
2156
	ans.idd.instance->spec = spec;
2157
	ans.idd.instance->whence = shorten_sourcepos(whence);
2158
	ans.idd.instance->params = aparams;
2159
	if (ans.idd.instance->nam.id_key == DG_ID_INST ||
2160
	    ans.idd.instance->spec.id_key == DG_ID_INST) {
2161
		failer("multiple instantiation");
2162
	}
2163
	return ans;
2 7u83 2164
}
2165
 
6 7u83 2166
 
2167
dg_idname
2168
f_dg_external_idname(string src_name)
2 7u83 2169
{
6 7u83 2170
	dg_idname ans;
2171
	ans.id_key = DG_ID_EXT;
2172
	ans.idd.nam = src_name.ints.chars;
2173
	return ans;
2 7u83 2174
}
2175
 
6 7u83 2176
 
2177
void
2178
init_dg_idname(void)
2 7u83 2179
{
6 7u83 2180
	return;
2 7u83 2181
}
2182
 
6 7u83 2183
 
2 7u83 2184
dg_varpart f_dummy_dg_varpart;
2185
 
6 7u83 2186
dg_varpart
2187
f_dg_discrim_varpart(dg_classmem discrim, dg_variant_list variants)
2 7u83 2188
{
6 7u83 2189
	dg_varpart ans;
2190
	ans.v_key = DG_V_D;
2191
	ans.u.d = discrim;
2192
	ans.vnts = variants;
2193
	return ans;
2 7u83 2194
}
2195
 
6 7u83 2196
 
2197
dg_varpart
2198
f_dg_sibl_discrim_varpart(dg_tag discrim, dg_variant_list variants)
2 7u83 2199
{
6 7u83 2200
	dg_varpart ans;
2201
	ans.v_key = DG_V_S;
2202
	ans.u.s = discrim;
2203
	ans.vnts = variants;
2204
	return ans;
2 7u83 2205
}
2206
 
6 7u83 2207
 
2208
dg_varpart
2209
f_dg_undiscrim_varpart(dg_type tag_type, dg_variant_list variants)
2 7u83 2210
{
6 7u83 2211
	dg_varpart ans;
2212
	ans.v_key = DG_V_T;
2213
	ans.u.t = tag_type;
2214
	ans.vnts = variants;
2215
	return ans;
2 7u83 2216
}
2217
 
6 7u83 2218
 
2219
void
2220
init_dg_varpart(void)
2 7u83 2221
{
6 7u83 2222
	return;
2 7u83 2223
}
2224
 
6 7u83 2225
 
2 7u83 2226
dg_variant f_dummy_dg_variant;
2227
 
6 7u83 2228
dg_variant
2229
f_make_dg_variant(dg_discrim_list discr, dg_classmem_list fields)
2 7u83 2230
{
6 7u83 2231
	dg_variant ans;
2232
	ans.discr = discr;
2233
	ans.fields = fields;
2234
	return ans;
2 7u83 2235
}
2236
 
6 7u83 2237
 
2238
void
2239
init_dg_variant(void)
2 7u83 2240
{
6 7u83 2241
	return;
2 7u83 2242
}
2243
 
6 7u83 2244
 
2 7u83 2245
dg_discrim f_dummy_dg_discrim;
2246
 
6 7u83 2247
dg_discrim
2248
f_make_dg_discrim(exp lower, exp upper)
2 7u83 2249
{
6 7u83 2250
	dg_discrim ans;
2251
	if (name(lower) != val_tag || name(upper) != val_tag ||
2252
	    sh(lower) != sh(upper)) {
2253
		failer("malformed discriminant");
2254
	}
2255
	ans.lower = diaginfo_exp(lower);
2256
	ans.upper = diaginfo_exp(upper);
2257
	return ans;
2 7u83 2258
}
2259
 
6 7u83 2260
 
2261
void
2262
init_dg_discrim(void)
2 7u83 2263
{
6 7u83 2264
	return;
2 7u83 2265
}
2266
 
6 7u83 2267
 
2 7u83 2268
dg_macro f_dummy_dg_macro;
2269
 
6 7u83 2270
dg_macro
2271
f_dg_function_macro(dg_sourcepos src_pos, dg_idname idname,
2272
		    dg_idname_list param, string def)
2 7u83 2273
{
6 7u83 2274
	dg_macro ans;
2275
	ans.key = DGM_FN;
2276
	ans.pos = shorten_sourcepos(src_pos);
2277
	ans.u.d.nam = idname_chars(idname);
2278
	ans.u.d.defn = def.ints.chars;
2279
	ans.u.d.pms = param;
2280
	return ans;
2 7u83 2281
}
2282
 
6 7u83 2283
 
2284
dg_macro
2285
f_dg_include_macro(dg_sourcepos src_pos, dg_filename file, dg_macro_list macros)
2 7u83 2286
{
6 7u83 2287
	dg_macro ans;
2288
	ans.key = DGM_INC;
2289
	ans.pos = shorten_sourcepos(src_pos);
2290
	ans.u.i.file = file;
2291
	ans.u.i.macs = macros;
2292
	return ans;
2 7u83 2293
}
2294
 
6 7u83 2295
 
2296
dg_macro
2297
f_dg_object_macro(dg_sourcepos src_pos, dg_idname idname, string def)
2 7u83 2298
{
6 7u83 2299
	dg_macro ans;
2300
	ans.key = DGM_OBJ;
2301
	ans.pos = shorten_sourcepos(src_pos);
2302
	ans.u.d.nam = idname_chars(idname);
2303
	ans.u.d.defn = def.ints.chars;
2304
	return ans;
2 7u83 2305
}
2306
 
6 7u83 2307
 
2308
dg_macro
2309
f_dg_undef_macro(dg_sourcepos src_pos, dg_idname idname)
2 7u83 2310
{
6 7u83 2311
	dg_macro ans;
2312
	ans.key = DGM_UNDEF;
2313
	ans.pos = shorten_sourcepos(src_pos);
2314
	ans.u.d.nam = idname_chars(idname);
2315
	return ans;
2 7u83 2316
}
2317
 
6 7u83 2318
 
2319
void
2320
init_dg_macro(void)
2 7u83 2321
{
6 7u83 2322
	return;
2 7u83 2323
}
2324
 
6 7u83 2325
 
2326
dg_list
2327
new_dg_list(int n)
2 7u83 2328
{
6 7u83 2329
	UNUSED(n);
2330
	return(dg_list)(0);
2 7u83 2331
}
2332
 
6 7u83 2333
 
2334
dg_list
2335
add_dg_list(dg_list list, dg elem, int index)
2 7u83 2336
{
6 7u83 2337
	if (elem && elem->more == elem) {	/* self ref => copy */
2338
		dg ans = new_dg_info(elem->key);
2339
		elem = ans;
2340
	}
2341
	if (list) {
2342
		dg x = list;
2343
		while (x->more) {
2344
			x = x->more;
2345
		}
2346
		x->more = elem;
2347
		return list;
2348
	}
2349
	return elem;
2 7u83 2350
}
2351
 
6 7u83 2352
 
2353
dg_name_list
2354
new_dg_name_list(int n)
2 7u83 2355
{
6 7u83 2356
	return(dg_name)0;
2 7u83 2357
}
2358
 
6 7u83 2359
 
2360
dg_name_list
2361
add_dg_name_list(dg_name_list list, dg_name elem, int index)
2 7u83 2362
{
6 7u83 2363
	if (list) {
2364
		dg_name x = list;
2365
		while (x->next) {
2366
			x = x->next;
2367
		}
2368
		x->next = elem;
2369
		return list;
2370
	}
2371
	return elem;
2 7u83 2372
}
2373
 
6 7u83 2374
 
2375
dg_tag_list
2376
new_dg_tag_list(int n)
2 7u83 2377
{
6 7u83 2378
	dg_tag_list ans;
2379
	ans.len = n;
2380
	ans.array = (dg_tag *)xcalloc(n, sizeof(dg_tag));
2381
	return ans;
2 7u83 2382
}
2383
 
6 7u83 2384
 
2385
dg_tag_list
2386
add_dg_tag_list(dg_tag_list list, dg_tag elem, int index)
2 7u83 2387
{
6 7u83 2388
	list.array[index] = elem;
2389
	return list;
2 7u83 2390
}
2391
 
6 7u83 2392
 
2393
dg_type_list
2394
new_dg_type_list(int n)
2 7u83 2395
{
6 7u83 2396
	dg_type_list ans;
2397
	ans.len = n;
2398
	ans.array = (dg_type *)xcalloc(n, sizeof(dg_type));
2399
	return ans;
2 7u83 2400
}
2401
 
6 7u83 2402
 
2403
dg_type_list
2404
add_dg_type_list(dg_type_list list, dg_type elem, int index)
2 7u83 2405
{
6 7u83 2406
	list.array[index] = elem;
2407
	return list;
2 7u83 2408
}
2409
 
6 7u83 2410
 
2411
dg_param_list
2412
new_dg_param_list(int n)
2 7u83 2413
{
6 7u83 2414
	dg_param_list ans;
2415
	ans.len = n;
2416
	ans.array = (dg_param *)xcalloc(n, sizeof(dg_param));
2417
	return ans;
2 7u83 2418
}
2419
 
6 7u83 2420
 
2421
dg_param_list
2422
add_dg_param_list(dg_param_list list, dg_param elem, int index)
2 7u83 2423
{
6 7u83 2424
	list.array[index] = elem;
2425
	return list;
2 7u83 2426
}
2427
 
6 7u83 2428
 
2429
dg_dim_list
2430
new_dg_dim_list(int n)
2 7u83 2431
{
6 7u83 2432
	dg_dim_list ans;
2433
	ans.len = n;
2434
	ans.array = (dg_dim *)xcalloc(n, sizeof(dg_dim));
2435
	return ans;
2 7u83 2436
}
2437
 
6 7u83 2438
 
2439
dg_dim_list
2440
add_dg_dim_list(dg_dim_list list, dg_dim elem, int index)
2 7u83 2441
{
6 7u83 2442
	list.array[index] = elem;
2443
	return list;
2 7u83 2444
}
2445
 
6 7u83 2446
 
2447
dg_enum_list
2448
new_dg_enum_list(int n)
2 7u83 2449
{
6 7u83 2450
	dg_enum_list ans;
2451
	ans.len = n;
2452
	ans.array = (dg_enum *)xcalloc(n, sizeof(dg_enum));
2453
	return ans;
2 7u83 2454
}
2455
 
6 7u83 2456
 
2457
dg_enum_list
2458
add_dg_enum_list(dg_enum_list list, dg_enum elem, int index)
2 7u83 2459
{
6 7u83 2460
	list.array[index] = elem;
2461
	return list;
2 7u83 2462
}
2463
 
6 7u83 2464
 
2465
dg_class_base_list
2466
new_dg_class_base_list(int n)
2 7u83 2467
{
6 7u83 2468
	dg_class_base_list ans;
2469
	ans.len = n;
2470
	ans.array = (dg_class_base *)xcalloc(n, sizeof(dg_class_base));
2471
	return ans;
2 7u83 2472
}
2473
 
6 7u83 2474
 
2475
dg_class_base_list
2476
add_dg_class_base_list(dg_class_base_list list, dg_class_base elem, int index)
2 7u83 2477
{
6 7u83 2478
	list.array[index] = elem;
2479
	return list;
2 7u83 2480
}
2481
 
6 7u83 2482
 
2483
dg_classmem_list
2484
new_dg_classmem_list(int n)
2 7u83 2485
{
6 7u83 2486
	dg_classmem_list ans;
2487
	ans.len = n;
2488
	ans.array = (dg_classmem *)xcalloc(n, sizeof(dg_classmem));
2489
	return ans;
2 7u83 2490
}
2491
 
6 7u83 2492
 
2493
dg_classmem_list
2494
add_dg_classmem_list(dg_classmem_list list, dg_classmem elem, int index)
2 7u83 2495
{
6 7u83 2496
	list.array[index] = elem;
2497
	return list;
2 7u83 2498
}
2499
 
6 7u83 2500
 
2501
dg_variant_list
2502
new_dg_variant_list(int n)
2 7u83 2503
{
6 7u83 2504
	dg_variant_list ans;
2505
	ans.len = n;
2506
	ans.array = (dg_variant *)xcalloc(n, sizeof(dg_variant));
2507
	return ans;
2 7u83 2508
}
2509
 
6 7u83 2510
 
2511
dg_variant_list
2512
add_dg_variant_list(dg_variant_list list, dg_variant elem, int index)
2 7u83 2513
{
6 7u83 2514
	list.array[index] = elem;
2515
	return list;
2 7u83 2516
}
2517
 
6 7u83 2518
 
2519
dg_discrim_list
2520
new_dg_discrim_list(int n)
2 7u83 2521
{
6 7u83 2522
	dg_discrim_list ans;
2523
	ans.len = n;
2524
	ans.array = (dg_discrim *)xcalloc(n, sizeof(dg_discrim));
2525
	return ans;
2 7u83 2526
}
2527
 
6 7u83 2528
 
2529
dg_discrim_list
2530
add_dg_discrim_list(dg_discrim_list list, dg_discrim elem, int index)
2 7u83 2531
{
6 7u83 2532
	list.array[index] = elem;
2533
	return list;
2 7u83 2534
}
2535
 
6 7u83 2536
 
2537
dg_constraint_list
2538
new_dg_constraint_list(int n)
2 7u83 2539
{
6 7u83 2540
	return(dg_constraint)0;
2 7u83 2541
}
2542
 
6 7u83 2543
 
2544
dg_constraint_list
2545
add_dg_constraint_list(dg_constraint_list list, dg_constraint elem, int index)
2 7u83 2546
{
6 7u83 2547
	if (list) {
2548
		dg_constraint x = list;
2549
		while (x->next) {
2550
			x = x->next;
2551
		}
2552
		x->next = elem;
2553
		return list;
2554
	}
2555
	return elem;
2 7u83 2556
}
2557
 
6 7u83 2558
 
2 7u83 2559
dg_namelist f_dummy_dg_namelist;
2560
 
6 7u83 2561
dg_namelist
2562
f_make_dg_namelist(dg_name_list items)
2 7u83 2563
{
6 7u83 2564
	dg_namelist ans;
2565
	ans.list = items;
2566
	ans.tg = (dg_tag)0;
2567
	return ans;
2 7u83 2568
}
2569
 
6 7u83 2570
 
2571
dg_namelist
2572
f_dg_tag_namelist(dg_tag tg, dg_namelist nl)
2 7u83 2573
{
6 7u83 2574
	if (tg->key) {
2575
		failer("dg_tag defined twice");
2576
	}
2577
	tg->key = DGK_NAMELIST;
2578
	nl.tg = tg;
2579
	return nl;
2 7u83 2580
}
2581
 
6 7u83 2582
 
2583
void
2584
init_dg_namelist(void)
2 7u83 2585
{
6 7u83 2586
	return;
2 7u83 2587
}
2588
 
6 7u83 2589
 
2 7u83 2590
dg_append f_dummy_dg_append;
2591
 
6 7u83 2592
dg_append
2593
f_dg_name_append(dg_tag tg, dg_name nam)
2 7u83 2594
{
6 7u83 2595
	if (tg->key != DGK_NAMELIST) {
2596
		failer("wrong dg_tag");
2597
	}
2598
	*(tg->p.nl) = add_dg_name_list(*(tg->p.nl), nam, 0);
2599
	return f_dummy_dg_append;
2 7u83 2600
}
2601
 
6 7u83 2602
 
2603
void
2604
init_dg_append(void)
2 7u83 2605
{
6 7u83 2606
	return;
2 7u83 2607
}
2608
 
6 7u83 2609
 
2610
dg_append_list
2611
new_dg_append_list(int n)
2 7u83 2612
{
6 7u83 2613
	return(dg_append_list)0;
2 7u83 2614
}
2615
 
6 7u83 2616
 
2617
dg_append_list
2618
add_dg_append_list(dg_append_list list, dg_append elem, int index)
2 7u83 2619
{
6 7u83 2620
	return list;
2 7u83 2621
}
2622
 
6 7u83 2623
 
2624
dg_macro_list
2625
new_dg_macro_list(int n)
2 7u83 2626
{
6 7u83 2627
	dg_macro_list ans;
2628
	ans.len = n;
2629
	ans.array = (dg_macro *)xcalloc(n, sizeof(dg_macro));
2630
	return ans;
2 7u83 2631
}
2632
 
6 7u83 2633
 
2634
dg_macro_list
2635
add_dg_macro_list(dg_macro_list list, dg_macro elem, int index)
2 7u83 2636
{
6 7u83 2637
	list.array[index] = elem;
2638
	return list;
2 7u83 2639
}
2640
 
6 7u83 2641
 
2642
dg_idname_list
2643
new_dg_idname_list(int n)
2 7u83 2644
{
6 7u83 2645
	return new_string_list(n);
2 7u83 2646
}
2647
 
6 7u83 2648
 
2649
dg_idname_list
2650
add_dg_idname_list(dg_idname_list list, dg_idname elem, int index)
2 7u83 2651
{
6 7u83 2652
	list.array[index] = idname_chars(elem);
2653
	return list;
2 7u83 2654
}
2655
 
6 7u83 2656
 
2 7u83 2657
dg_idname_option no_dg_idname_option;
2658
 
6 7u83 2659
dg_idname_option
2660
yes_dg_idname_option(dg_idname elem)
2 7u83 2661
{
6 7u83 2662
	return elem;
2 7u83 2663
}
2664
 
6 7u83 2665
 
2666
void
2667
init_dg_idname_option(void)
2 7u83 2668
{
6 7u83 2669
	no_dg_idname_option.id_key = DG_ID_NONE;
2670
	no_dg_idname_option.idd.nam = "";
2671
	return;
2 7u83 2672
}
2673
 
6 7u83 2674
 
2 7u83 2675
dg_name_option no_dg_name_option = (dg_name)0;
2676
 
6 7u83 2677
dg_name_option
2678
yes_dg_name_option(dg_name elem)
2 7u83 2679
{
6 7u83 2680
	return elem;
2 7u83 2681
}
2682
 
6 7u83 2683
 
2684
void
2685
init_dg_name_option(void)
2 7u83 2686
{
6 7u83 2687
	return;
2 7u83 2688
}
2689
 
6 7u83 2690
 
2 7u83 2691
dg_accessibility_option no_dg_accessibility_option = DG_ACC_NONE;
2692
 
6 7u83 2693
dg_accessibility_option
2694
yes_dg_accessibility_option(dg_accessibility elem)
2 7u83 2695
{
6 7u83 2696
	return elem;
2 7u83 2697
}
2698
 
6 7u83 2699
 
2700
void
2701
init_dg_accessibility_option(void)
2 7u83 2702
{
6 7u83 2703
	return;
2 7u83 2704
}
2705
 
6 7u83 2706
 
2 7u83 2707
dg_tag_option no_dg_tag_option = (dg_tag)0;
2708
 
6 7u83 2709
dg_tag_option
2710
yes_dg_tag_option(dg_tag elem)
2 7u83 2711
{
6 7u83 2712
	return elem;
2 7u83 2713
}
2714
 
6 7u83 2715
 
2716
void
2717
init_dg_tag_option(void)
2 7u83 2718
{
6 7u83 2719
	return;
2 7u83 2720
}
2721
 
6 7u83 2722
 
2 7u83 2723
dg_virtuality_option no_dg_virtuality_option = DG_VIRT_NONE;
2724
 
6 7u83 2725
dg_virtuality_option
2726
yes_dg_virtuality_option(dg_virtuality elem)
2 7u83 2727
{
6 7u83 2728
	return elem;
2 7u83 2729
}
2730
 
6 7u83 2731
 
2732
void
2733
init_dg_virtuality_option(void)
2 7u83 2734
{
6 7u83 2735
	return;
2 7u83 2736
}
2737
 
6 7u83 2738
 
2 7u83 2739
dg_sourcepos_option no_dg_sourcepos_option;
2740
 
6 7u83 2741
dg_sourcepos_option
2742
yes_dg_sourcepos_option(dg_sourcepos elem)
2 7u83 2743
{
6 7u83 2744
	return elem;
2 7u83 2745
}
2746
 
6 7u83 2747
 
2748
void
2749
init_dg_sourcepos_option(void)
2 7u83 2750
{
6 7u83 2751
	no_dg_sourcepos_option.sp_key = SP_NULL;
2752
	no_short_sourcepos = shorten_sourcepos(no_dg_sourcepos_option);
2753
	return;
2 7u83 2754
}
2755
 
6 7u83 2756
 
2 7u83 2757
dg_type_option no_dg_type_option = (dg_type)0;
2758
 
6 7u83 2759
dg_type_option
2760
yes_dg_type_option(dg_type elem)
2 7u83 2761
{
6 7u83 2762
	return elem;
2 7u83 2763
}
2764
 
6 7u83 2765
 
2766
void
2767
init_dg_type_option(void)
2 7u83 2768
{
6 7u83 2769
	return;
2 7u83 2770
}
2771
 
6 7u83 2772
 
2 7u83 2773
dg_type_list_option no_dg_type_list_option;
2774
 
6 7u83 2775
dg_type_list_option
2776
yes_dg_type_list_option(dg_type_list elem)
2 7u83 2777
{
6 7u83 2778
	return elem;
2 7u83 2779
}
2780
 
6 7u83 2781
 
2782
void
2783
init_dg_type_list_option(void)
2 7u83 2784
{
6 7u83 2785
	no_dg_type_list_option.len = -1;
2786
	no_dg_type_list_option.array = (dg_type *)0;
2787
	return;
2 7u83 2788
}
2789
 
6 7u83 2790
 
2 7u83 2791
dg_constraint_list_option no_dg_constraint_list_option = (dg_constraint)0;
2792
 
6 7u83 2793
dg_constraint_list_option
2794
yes_dg_constraint_list_option(dg_constraint_list elem)
2 7u83 2795
{
6 7u83 2796
	return elem;
2 7u83 2797
}
2798
 
6 7u83 2799
 
2800
void
2801
init_dg_constraint_list_option(void)
2 7u83 2802
{
6 7u83 2803
	return;
2 7u83 2804
}
2805
 
6 7u83 2806
 
2 7u83 2807
dg_varpart_option no_dg_varpart_option = (dg_varpart_option)0;
2808
 
6 7u83 2809
dg_varpart_option
2810
yes_dg_varpart_option(dg_varpart elem)
2 7u83 2811
{
6 7u83 2812
	dg_varpart_option ans =
2813
	    (dg_varpart_option)xcalloc(1, sizeof(dg_varpart));
2814
	*ans = elem;
2815
	return ans;
2 7u83 2816
}
2817
 
6 7u83 2818
 
2819
void
2820
init_dg_varpart_option(void)
2 7u83 2821
{
6 7u83 2822
	return;
2 7u83 2823
}
2824
 
6 7u83 2825
 
2 7u83 2826
dg_param_mode_option no_dg_param_mode_option = DG_NO_MODE;
2827
 
6 7u83 2828
dg_param_mode_option
2829
yes_dg_param_mode_option(dg_param_mode elem)
2 7u83 2830
{
6 7u83 2831
	return elem;
2 7u83 2832
}
2833
 
6 7u83 2834
 
2835
void
2836
init_dg_param_mode_option(void)
2 7u83 2837
{
6 7u83 2838
	return;
2 7u83 2839
}
2840
 
6 7u83 2841
 
2 7u83 2842
dg_dim_option no_dg_dim_option;
2843
 
6 7u83 2844
dg_dim_option
2845
yes_dg_dim_option(dg_dim elem)
2 7u83 2846
{
6 7u83 2847
	failer("dg_dim_option not done yet");
2848
	return no_dg_dim_option;
2 7u83 2849
}
2850
 
6 7u83 2851
 
2852
void
2853
init_dg_dim_option(void)
2 7u83 2854
{
6 7u83 2855
	return;
2 7u83 2856
}
2857
 
6 7u83 2858
 
2 7u83 2859
dg_filename_option no_dg_filename_option = (dg_filename)0;
2860
 
6 7u83 2861
dg_filename_option
2862
yes_dg_filename_option(dg_filename elem)
2 7u83 2863
{
6 7u83 2864
	return elem;
2 7u83 2865
}
2866
 
6 7u83 2867
 
2868
void
2869
init_dg_filename_option(void)
2 7u83 2870
{
6 7u83 2871
	return;
2 7u83 2872
}
2873
 
2874
 
2875
dg_default_option no_dg_default_option = (dg_default *)0;
2876
 
6 7u83 2877
dg_default_option
2878
yes_dg_default_option(dg_default elem)
2 7u83 2879
{
6 7u83 2880
	dg_default_option ans =
2881
	    (dg_default_option)xcalloc(1, sizeof(dg_default));
2882
	*ans = elem;
2883
	return ans;
2 7u83 2884
}
2885
 
6 7u83 2886
 
2887
void
2888
init_dg_default_option(void)
2 7u83 2889
{
6 7u83 2890
	return;
2 7u83 2891
}
2892
 
2893
 
6 7u83 2894
void
2895
init_capsule_dgtags(void)
2 7u83 2896
{
6 7u83 2897
	/* the space has been calloced in read_fns */
2 7u83 2898
 
6 7u83 2899
	int i;
2900
	for (i = 0; i < capsule_no_of_dgtags; ++i) {
2901
		init_dgtag(&capsule_dgtab[i]);
2902
	}
2903
	return;
2 7u83 2904
}
2905
 
6 7u83 2906
 
2907
void
2908
init_unit_dgtags(int n)
2 7u83 2909
{
2910
 
6 7u83 2911
	int i;
2 7u83 2912
 
6 7u83 2913
	unit_dgtagtab = (dgtag_struct *)xcalloc(unit_no_of_dgtags - n,
2914
						sizeof(dgtag_struct));
2 7u83 2915
 
6 7u83 2916
	for (i = 0; i < unit_no_of_dgtags - n; ++i) {
2917
		init_dgtag(&unit_dgtagtab[i]);
2918
	}
2919
	return;
2 7u83 2920
}
2921
 
6 7u83 2922
 
2923
void
2924
start_make_dg_comp_unit(int toks, int tags, int als, int dgnames)
2 7u83 2925
{
6 7u83 2926
	int i;
2 7u83 2927
 
6 7u83 2928
	unit_no_of_tokens = toks;
2929
	unit_ind_tokens = (tok_define **)xcalloc(unit_no_of_tokens,
2930
						 sizeof(tok_define *));
2931
	for (i = 0; i < unit_no_of_tokens; ++i) {
2932
		unit_ind_tokens[i] = (tok_define *)0;
2933
	}
2 7u83 2934
 
6 7u83 2935
	unit_no_of_tags = tags;
2936
	unit_ind_tags = (dec **)xcalloc(unit_no_of_tags, sizeof(dec *));
2937
	for (i = 0; i < unit_no_of_tags; ++i) {
2938
		unit_ind_tags[i] = (dec *)0;
2939
	}
2 7u83 2940
 
6 7u83 2941
	unit_no_of_als = als;
2942
	unit_ind_als = (aldef **)xcalloc(unit_no_of_als, sizeof(aldef *));
2943
	for (i = 0; i < unit_no_of_als; ++i) {
2944
		unit_ind_als[i] = (aldef *)0;
2945
	}
2 7u83 2946
 
6 7u83 2947
	unit_no_of_dgtags = dgnames;
2948
	unit_ind_dgtags = (dgtag_struct **)xcalloc(unit_no_of_dgtags,
2949
						   sizeof(dgtag_struct *));
2950
	for (i = 0; i < unit_no_of_dgtags; ++i) {
2951
		unit_ind_dgtags[i] = (dgtag_struct *)0;
2952
	}
2 7u83 2953
 
6 7u83 2954
	return;
2 7u83 2955
}
2956
 
6 7u83 2957
 
2958
void
2959
f_make_dg_comp_unit(void)
2 7u83 2960
{
6 7u83 2961
	int i;
2962
	int j = 0;
2963
	int no_of_labels;
2 7u83 2964
#ifdef NEWDIAGS
6 7u83 2965
	int was_within_diags;
2 7u83 2966
#endif
2967
 
6 7u83 2968
	for (i = 0; i < unit_no_of_tokens; ++i) {
2969
		if (unit_ind_tokens[i] == (tok_define *)0) {
2970
			unit_ind_tokens[i] = &unit_toktab[j++];
2971
		}
2972
	}
2 7u83 2973
 
6 7u83 2974
	j = 0;
2975
	for (i = 0; i < unit_no_of_tags; ++i) {
2976
		if (unit_ind_tags[i] == (dec *)0) {
2977
			unit_ind_tags[i] = &unit_tagtab[j++];
2978
		}
2979
	}
2 7u83 2980
 
6 7u83 2981
	j = 0;
2982
	for (i = 0; i < unit_no_of_als; ++i) {
2983
		if (unit_ind_als[i] == (aldef *)0)
2984
			unit_ind_als[i] = &unit_altab[j++];
2985
	}
2 7u83 2986
 
6 7u83 2987
	j=0;
2988
	for (i = 0; i < unit_no_of_dgtags; ++i) {
2989
		if (unit_ind_dgtags[i] == (dgtag_struct *)0) {
2990
			unit_ind_dgtags[i] = &unit_dgtagtab[j++];
2991
		}
2992
	}
2 7u83 2993
 
2994
#ifdef NEWDIAGS
6 7u83 2995
	was_within_diags = within_diags;
2996
	within_diags = 1;
2 7u83 2997
#endif
6 7u83 2998
	{
2999
		dg_compilation *comp_unit_ptr = &all_comp_units;
3000
		while (*comp_unit_ptr) {
3001
			comp_unit_ptr = &(*comp_unit_ptr)->another;
3002
		}
3003
		start_bytestream();
3004
		no_of_labels = small_dtdfint();
3005
		unit_no_of_labels = no_of_labels;
3006
		unit_labtab = (exp *)xcalloc(unit_no_of_labels, sizeof(exp));
3007
		(*comp_unit_ptr) = d_dg_compilation();
3008
		IGNORE d_dg_append_list();
3009
		end_bytestream();
3010
	}
2 7u83 3011
#ifdef NEWDIAGS
6 7u83 3012
	within_diags = was_within_diags;
2 7u83 3013
#endif
6 7u83 3014
	return;
2 7u83 3015
}
3016
 
6 7u83 3017
 
3018
void
3019
f_make_dglink(tdfint i, tdfint ext)
2 7u83 3020
{
6 7u83 3021
	unit_ind_dgtags[natint(i)] = &capsule_dgtab[natint(ext)];
3022
	return;
2 7u83 3023
}
3024
 
6 7u83 3025
 
3026
linkextern
3027
f_make_dgtagextern(tdfint internal, external ext)
2 7u83 3028
{
6 7u83 3029
	dg_tag tg = &capsule_dgtab[natint(internal)];
3030
	tg->outref.k = LAB_STR;
3031
	tg->outref.u.s = external_to_string(ext);
3032
	return 0;
2 7u83 3033
}
3034
 
3035
 
6 7u83 3036
exp
3037
f_dg_exp(exp body, dg diagnostic)
2 7u83 3038
{
3039
#ifdef NEWDIAGS
6 7u83 3040
	dgf(body) = add_dg_list(add_dg_list(new_dg_list(2), diagnostic, 0),
3041
				dgf(body), 1);
2 7u83 3042
#endif
6 7u83 3043
	return body;
2 7u83 3044
}
3045
 
6 7u83 3046
 
3047
exp
3048
read_dg_exp(exp body)
2 7u83 3049
{
6 7u83 3050
	dg diag;
2 7u83 3051
#ifdef NEWDIAGS
6 7u83 3052
	int was_within_diags = within_diags;
3053
	within_diags = 1;
3054
	diag = d_dg();
3055
	within_diags = was_within_diags;
2 7u83 3056
#endif
6 7u83 3057
	return f_dg_exp(body, diag);
2 7u83 3058
}