Subversion Repositories tendra.SVN

Rev

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

Rev Author Line No. Line
2 7u83 1
/*
2
    		 Crown Copyright (c) 1997
3
 
4
    This TenDRA(r) Computer Program is subject to Copyright
5
    owned by the United Kingdom Secretary of State for Defence
6
    acting through the Defence Evaluation and Research Agency
7
    (DERA).  It is made available to Recipients with a
8
    royalty-free licence for its use, reproduction, transfer
9
    to other parties and amendment for any purpose not excluding
10
    product development provided that any such use et cetera
11
    shall be deemed to be acceptance of the following conditions:-
12
 
13
        (1) Its Recipients shall ensure that this Notice is
14
        reproduced upon any copies or amended versions of it;
15
 
16
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
18
        for the relevant amendment or amendments;
19
 
20
        (3) Its onward transfer from a recipient to another
21
        party shall be deemed to be that party's acceptance of
22
        these conditions;
23
 
24
        (4) DERA gives no warranty or assurance as to its
25
        quality or suitability for any purpose and DERA accepts
26
        no liability whatsoever in relation to any use to which
27
        it may be put.
28
*/
29
 
30
 
31
#include "config.h"
32
#include "c_types.h"
33
#include "ctype_ops.h"
34
#include "graph_ops.h"
35
#include "hashid_ops.h"
36
#include "id_ops.h"
37
#include "type_ops.h"
38
#include "virt_ops.h"
39
#include "error.h"
40
#include "catalog.h"
41
#include "option.h"
42
#include "access.h"
43
#include "capsule.h"
44
#include "check.h"
45
#include "chktype.h"
46
#include "derive.h"
47
#include "dump.h"
48
#include "exception.h"
49
#include "function.h"
50
#include "namespace.h"
51
#include "overload.h"
52
#include "syntax.h"
53
#include "template.h"
54
#include "virtual.h"
55
 
56
 
57
/*
58
    COMBINE TWO INHERITED VIRTUAL FUNCTIONS
59
 
60
    This routine is called when the same virtual function is inherited
61
    via both vp and vq.  It combine the two virtual function table entries
62
    and returns the result.  Note that one or other may be selected using
63
    the dominance rule in certain cases.
64
*/
65
 
66
static VIRTUAL inherit_duplicate
67
    PROTO_N ( ( vp, vq ) )
68
    PROTO_T ( VIRTUAL vp X VIRTUAL vq )
69
{
70
    GRAPH gr ;
71
    IDENTIFIER fn ;
72
    IDENTIFIER gn ;
73
    unsigned long n ;
74
    if ( IS_virt_inherit ( vq ) ) {
75
	DESTROY_virt_inherit ( destroy, fn, n, gr, vq, vq ) ;
76
	UNUSED ( fn ) ;
77
	UNUSED ( n ) ;
78
	UNUSED ( gr ) ;
79
	UNUSED ( vq ) ;
80
	return ( vp ) ;
81
    }
82
    if ( IS_virt_inherit ( vp ) ) {
83
	DESTROY_virt_inherit ( destroy, fn, n, gr, vp, vp ) ;
84
	UNUSED ( fn ) ;
85
	UNUSED ( n ) ;
86
	UNUSED ( gr ) ;
87
	UNUSED ( vp ) ;
88
	return ( vq ) ;
89
    }
90
    fn = DEREF_id ( virt_func ( vp ) ) ;
91
    gn = DEREF_id ( virt_func ( vq ) ) ;
92
    if ( EQ_id ( fn, gn ) ) return ( vp ) ;
93
    COPY_virt ( virt_next ( vq ), vp ) ;
94
    return ( vq ) ;
95
}
96
 
97
 
98
/*
99
    INHERIT A VIRTUAL FUNCTION
100
 
101
    This routine inherits the virtual function vq from the direct base
102
    class gs.  p gives the list of functions already inherited.
103
*/
104
 
105
static VIRTUAL inherit_virtual
106
    PROTO_N ( ( vq, gs, p ) )
107
    PROTO_T ( VIRTUAL vq X GRAPH gs X LIST ( VIRTUAL ) p )
108
{
109
    VIRTUAL vp = NULL_virt ;
110
    CLASS_TYPE cs = DEREF_ctype ( graph_head ( gs ) ) ;
111
    CLASS_INFO ci = DEREF_cinfo ( ctype_info ( cs ) ) ;
112
    GRAPH gt = DEREF_graph ( ctype_base ( cs ) ) ;
113
    IDENTIFIER fn = DEREF_id ( virt_func ( vq ) ) ;
114
    switch ( TAG_virt ( vq ) ) {
115
	case virt_simple_tag : {
116
	    /* Simple inheritance */
117
	    MAKE_virt_inherit ( fn, 0, gs, vp ) ;
118
	    return ( vp ) ;
119
	}
120
	case virt_override_tag : {
121
	    /* Override inheritance */
122
	    IDENTIFIER bn = DEREF_id ( virt_override_orig ( vq ) ) ;
123
	    GRAPH rq = DEREF_graph ( virt_override_ret ( vq ) ) ;
124
	    GRAPH sq = DEREF_graph ( virt_override_src ( vq ) ) ;
125
	    GRAPH sp = find_subgraph ( gs, gt, sq ) ;
126
	    MAKE_virt_complex ( fn, 0, gs, rq, bn, sp, vp ) ;
127
	    fn = bn ;
128
	    gs = sp ;
129
	    break ;
130
	}
131
	case virt_inherit_tag : {
132
	    /* Nested inheritance */
133
	    GRAPH gq = DEREF_graph ( virt_base ( vq ) ) ;
134
	    GRAPH gp = find_subgraph ( gs, gt, gq ) ;
135
	    MAKE_virt_inherit ( fn, 0, gp, vp ) ;
136
	    gs = gp ;
137
	    break ;
138
	}
139
	case virt_complex_tag : {
140
	    /* Complex inheritance */
141
	    IDENTIFIER bn = DEREF_id ( virt_complex_orig ( vq ) ) ;
142
	    GRAPH rq = DEREF_graph ( virt_complex_ret ( vq ) ) ;
143
	    GRAPH sq = DEREF_graph ( virt_complex_src ( vq ) ) ;
144
	    GRAPH sp = find_subgraph ( gs, gt, sq ) ;
145
	    GRAPH gq = DEREF_graph ( virt_base ( vq ) ) ;
146
	    GRAPH gp = find_subgraph ( gs, gt, gq ) ;
147
	    MAKE_virt_complex ( fn, 0, gp, rq, bn, sp, vp ) ;
148
	    fn = bn ;
149
	    gs = sp ;
150
	    break ;
151
	}
152
	case virt_link_tag : {
153
	    /* Symbolic link */
154
	    PTR ( VIRTUAL ) pv = DEREF_ptr ( virt_link_to ( vq ) ) ;
155
	    vq = DEREF_virt ( pv ) ;
156
	    vp = inherit_virtual ( vq, gs, p ) ;
157
	    return ( vp ) ;
158
	}
159
	default : {
160
	    /* Shouldn't occur */
161
	    return ( vp ) ;
162
	}
163
    }
164
 
165
    /* Check previous cases */
166
    if ( ci & cinfo_virtual_base ) {
167
	while ( !IS_NULL_list ( p ) ) {
168
	    VIRTUAL vr = DEREF_virt ( HEAD_list ( p ) ) ;
169
	    switch ( TAG_virt ( vr ) ) {
170
		case virt_inherit_tag : {
171
		    /* Previous simple inheritance */
172
		    IDENTIFIER bn = DEREF_id ( virt_func ( vr ) ) ;
173
		    GRAPH gr = DEREF_graph ( virt_base ( vr ) ) ;
174
		    if ( EQ_id ( bn, fn ) && eq_graph ( gr, gs ) ) {
175
			unsigned long n = DEREF_ulong ( virt_no ( vr ) ) ;
176
			vp = inherit_duplicate ( vr, vp ) ;
177
			COPY_ulong ( virt_no ( vr ), n ) ;
178
			COPY_virt ( HEAD_list ( p ), vp ) ;
179
			MAKE_virt_link ( bn, n, gr, HEAD_list ( p ), vp ) ;
180
			return ( vp ) ;
181
		    }
182
		    break ;
183
		}
184
		case virt_complex_tag : {
185
		    /* Previous complex inheritance */
186
		    IDENTIFIER bn = DEREF_id ( virt_complex_orig ( vr ) ) ;
187
		    GRAPH gr = DEREF_graph ( virt_complex_src ( vr ) ) ;
188
		    if ( EQ_id ( bn, fn ) && eq_graph ( gr, gs ) ) {
189
			unsigned long n = DEREF_ulong ( virt_no ( vr ) ) ;
190
			vp = inherit_duplicate ( vr, vp ) ;
191
			COPY_ulong ( virt_no ( vr ), n ) ;
192
			COPY_virt ( HEAD_list ( p ), vp ) ;
193
			MAKE_virt_link ( bn, n, gr, HEAD_list ( p ), vp ) ;
194
			return ( vp ) ;
195
		    }
196
		    break ;
197
		}
198
	    }
199
	    p = TAIL_list ( p ) ;
200
	}
201
    }
202
    return ( vp ) ;
203
}
204
 
205
 
206
/*
207
    INHERIT A VIRTUAL FUNCTION TABLE
208
 
209
    This routine inherits the virtual function table vs to the class
210
    corresponding to the graph gt.  vt gives any previous virtual function
211
    tables.
212
*/
213
 
214
static VIRTUAL inherit_table
215
    PROTO_N ( ( vs, vt, gt ) )
216
    PROTO_T ( VIRTUAL vs X VIRTUAL vt X GRAPH gt )
217
{
218
    if ( !IS_NULL_virt ( vs ) ) {
219
	OFFSET off ;
220
	VIRTUAL vp ;
221
	IDENTIFIER id = DEREF_id ( virt_func ( vs ) ) ;
222
	GRAPH gr = DEREF_graph ( virt_base ( vs ) ) ;
223
	GRAPH gs = DEREF_graph ( graph_top ( gr ) ) ;
224
	VIRTUAL vr = DEREF_virt ( virt_next ( vs ) ) ;
225
	vr = inherit_table ( vr, vt, gt ) ;
226
	gr = find_subgraph ( gt, gs, gr ) ;
227
	off = DEREF_off ( graph_off ( gr ) ) ;
228
	vp = vr ;
229
	while ( !IS_NULL_virt ( vp ) ) {
230
	    /* Check for previous use of this base */
231
	    GRAPH gp = DEREF_graph ( virt_base ( vp ) ) ;
232
	    if ( eq_graph ( gp, gr ) ) {
233
		COPY_off ( virt_table_off ( vp ), off ) ;
234
		COPY_graph ( virt_base ( vp ), gr ) ;
235
		return ( vt ) ;
236
	    }
237
	    vp = DEREF_virt ( virt_next ( vp ) ) ;
238
	}
239
	MAKE_virt_table ( id, 0, gr, off, vt ) ;
240
	COPY_virt ( virt_next ( vt ), vr ) ;
241
    }
242
    return ( vt ) ;
243
}
244
 
245
 
246
/*
247
    INHERIT VIRTUAL FUNCTION TABLES
248
 
249
    This routine inherits the virtual function tables from the list of
250
    base classes br.
251
*/
252
 
253
static VIRTUAL inherit_base_tables
254
    PROTO_N ( ( br ) )
255
    PROTO_T ( LIST ( GRAPH ) br )
256
{
257
    if ( !IS_NULL_list ( br ) ) {
258
	VIRTUAL vt = inherit_base_tables ( TAIL_list ( br ) ) ;
259
	GRAPH gs = DEREF_graph ( HEAD_list ( br ) ) ;
260
	CLASS_TYPE cs = DEREF_ctype ( graph_head ( gs ) ) ;
261
	VIRTUAL vs = DEREF_virt ( ctype_virt ( cs ) ) ;
262
	vt = inherit_table ( vs, vt, gs ) ;
263
	return ( vt ) ;
264
    }
265
    return ( NULL_virt ) ;
266
}
267
 
268
 
269
/*
270
    CREATE A VIRTUAL FUNCTION TABLES
271
 
272
    This routine creates the virtual function tables for the class ct.
273
    If code generation is not enabled then this is just a simple table
274
    corresponding to ct.  Otherwise it may be necessary to create a
275
    number of tables, corresponding to the base classes of ct.  If the
276
    first base class is not virtual then its inherited table is used
277
    for ct, otherwise a new table needs to be created.  If bases is
278
    false then a single table is created.
279
*/
280
 
281
static VIRTUAL make_virt_table
282
    PROTO_N ( ( ct, cj, bases ) )
283
    PROTO_T ( CLASS_TYPE ct X CLASS_INFO cj X int bases )
284
{
285
    VIRTUAL vt = NULL_virt ;
286
    VIRTUAL vs = NULL_virt ;
287
    GRAPH gr = DEREF_graph ( ctype_base ( ct ) ) ;
288
    CLASS_INFO ci = DEREF_cinfo ( ctype_info ( ct ) ) ;
289
 
290
    /* Inherit tables from base classes */
291
    if ( bases ) {
292
	LIST ( GRAPH ) br = DEREF_list ( graph_tails ( gr ) ) ;
293
	vs = inherit_base_tables ( br ) ;
294
	if ( !IS_NULL_virt ( vs ) ) {
295
	    OFFSET off = DEREF_off ( virt_table_off ( vs ) ) ;
296
	    if ( is_zero_offset ( off ) ) {
297
		/* Use inherited virtual function table */
298
		vt = vs ;
299
	    }
300
	}
301
    }
302
 
303
    /* Create new virtual function table */
304
    if ( IS_NULL_virt ( vt ) ) {
305
	IDENTIFIER id = DEREF_id ( ctype_name ( ct ) ) ;
306
	MAKE_virt_table ( id, 0, gr, NULL_off, vt ) ;
307
	COPY_virt ( virt_next ( vt ), vs ) ;
308
    }
309
    COPY_virt ( ctype_virt ( ct ), vt ) ;
310
    COPY_cinfo ( ctype_info ( ct ), ( ci | cj ) ) ;
311
    return ( vt ) ;
312
}
313
 
314
 
315
/*
316
    INITIALISE A VIRTUAL FUNCTION TABLE
317
 
318
    This routine initialises the virtual function table for the class
319
    type ct.
320
*/
321
 
322
void begin_virtual
323
    PROTO_N ( ( ct ) )
324
    PROTO_T ( CLASS_TYPE ct )
325
{
326
    unsigned long n = 0 ;
327
    LIST ( VIRTUAL ) p = NULL_list ( VIRTUAL ) ;
328
    GRAPH gr = DEREF_graph ( ctype_base ( ct ) ) ;
329
    LIST ( GRAPH ) br = DEREF_list ( graph_tails ( gr ) ) ;
330
 
331
    /* Scan through direct base classes */
332
    while ( !IS_NULL_list ( br ) ) {
333
	GRAPH gs = DEREF_graph ( HEAD_list ( br ) ) ;
334
	CLASS_TYPE cs = DEREF_ctype ( graph_head ( gs ) ) ;
335
	VIRTUAL vs = DEREF_virt ( ctype_virt ( cs ) ) ;
336
	if ( !IS_NULL_virt ( vs ) ) {
337
	    LIST ( VIRTUAL ) q = DEREF_list ( virt_table_entries ( vs ) ) ;
338
	    while ( !IS_NULL_list ( q ) ) {
339
		VIRTUAL vq = DEREF_virt ( HEAD_list ( q ) ) ;
340
		VIRTUAL vp = inherit_virtual ( vq, gs, p ) ;
341
		if ( !IS_NULL_virt ( vp ) ) {
342
		    /* Add inherited function to list */
343
		    CONS_virt ( vp, p, p ) ;
344
		    COPY_ulong ( virt_no ( vp ), n ) ;
345
		    n++ ;
346
		}
347
		q = TAIL_list ( q ) ;
348
	    }
349
	}
350
	br = TAIL_list ( br ) ;
351
    }
352
 
353
    /* Construct the virtual function table */
354
    if ( !IS_NULL_list ( p ) ) {
355
	CLASS_INFO ci = ( cinfo_polymorphic | cinfo_poly_base ) ;
356
	VIRTUAL vt = make_virt_table ( ct, ci, output_capsule ) ;
357
	p = REVERSE_list ( p ) ;
358
	COPY_list ( virt_table_entries ( vt ), p ) ;
359
	COPY_ulong ( virt_no ( vt ), n ) ;
360
    }
361
    return ;
362
}
363
 
364
 
365
/*
366
    COMPLETE A VIRTUAL FUNCTION TABLE
367
 
368
    This routine is called at the end of a class definition to complete
369
    the construction of the virtual function table.  It checks for
370
    inherited pure virtual functions and for final overriding functions.
371
    Also if any overriding virtual function involves a non-trivial base
372
    class conversion then an inherited virtual function table cannot be
373
    used as the main virtual function table for ct.
374
*/
375
 
376
void end_virtual
377
    PROTO_N ( ( ct ) )
378
    PROTO_T ( CLASS_TYPE ct )
379
{
380
    VIRTUAL vt = DEREF_virt ( ctype_virt ( ct ) ) ;
381
    if ( !IS_NULL_virt ( vt ) ) {
382
	int destr = 0 ;
383
	int trivial = 1 ;
384
	OFFSET off = DEREF_off ( virt_table_off ( vt ) ) ;
385
	CLASS_INFO ci = DEREF_cinfo ( ctype_info ( ct ) ) ;
386
	LIST ( VIRTUAL ) p = DEREF_list ( virt_table_entries ( vt ) ) ;
387
	LIST ( VIRTUAL ) q = p ;
388
	unsigned long n = DEREF_ulong ( virt_no ( vt ) ) ;
389
	IGNORE check_value ( OPT_VAL_virtual_funcs, n ) ;
390
	while ( !IS_NULL_list ( q ) ) {
391
	    VIRTUAL vf = DEREF_virt ( HEAD_list ( q ) ) ;
392
	    IDENTIFIER id = DEREF_id ( virt_func ( vf ) ) ;
393
	    HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
394
	    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
395
	    if ( ds & dspec_pure ) ci |= cinfo_abstract ;
396
	    if ( IS_hashid_destr ( nm ) ) destr = 1 ;
397
	    if ( IS_virt_override ( vf ) ) {
398
		/* Check for non-trivial return conversions */
399
		GRAPH gr = DEREF_graph ( virt_override_ret ( vf ) ) ;
400
		if ( !IS_NULL_graph ( gr ) ) {
401
		    DECL_SPEC acc = DEREF_dspec ( graph_access ( gr ) ) ;
402
		    if ( !( acc & dspec_ignore ) ) trivial = 0 ;
403
		}
404
	    } else if ( IS_virt_complex ( vf ) ) {
405
		/* Check for final overrider */
406
		GRAPH gr = DEREF_graph ( virt_complex_ret ( vf ) ) ;
407
		VIRTUAL vn = DEREF_virt ( virt_next ( vf ) ) ;
408
		if ( !IS_NULL_virt ( vn ) ) {
409
		    id = DEREF_id ( virt_complex_orig ( vf ) ) ;
410
		    report ( crt_loc, ERR_class_virtual_final ( id, ct ) ) ;
411
		}
412
		if ( !IS_NULL_graph ( gr ) ) {
413
		    DECL_SPEC acc = DEREF_dspec ( graph_access ( gr ) ) ;
414
		    if ( !( acc & dspec_ignore ) ) trivial = 0 ;
415
		}
416
	    }
417
	    q = TAIL_list ( q ) ;
418
	}
419
	if ( !IS_NULL_off ( off ) && !trivial && output_capsule ) {
420
	    /* Can't use inherited virtual function table */
421
	    VIRTUAL vs = make_virt_table ( ct, cinfo_none, 0 ) ;
422
	    COPY_virt ( virt_next ( vs ), vt ) ;
423
	    COPY_ulong ( virt_no ( vs ), n ) ;
424
	    COPY_list ( virt_table_entries ( vs ), p ) ;
425
	}
426
	if ( !destr ) {
427
	    /* Warn about non-virtual destructors */
428
	    report ( crt_loc, ERR_class_virtual_destr ( ct ) ) ;
429
	}
430
	ci |= cinfo_polymorphic ;
431
	COPY_cinfo ( ctype_info ( ct ), ci ) ;
432
    }
433
    return ;
434
}
435
 
436
 
437
/*
438
    CHECK VIRTUAL FUNCTION RETURN TYPES
439
 
440
    This routine checks whether the return type of the function type s is
441
    valid for a virtual function which overrides a function of type t.
442
    If the return types differ by a base class conversion then the
443
    corresponding base class graph is returned via pgr.
444
*/
445
 
446
static int virtual_return
447
    PROTO_N ( ( s, t, pgr ) )
448
    PROTO_T ( TYPE s X TYPE t X GRAPH *pgr )
449
{
450
    if ( IS_type_func ( s ) && IS_type_func ( t ) ) {
451
	TYPE p = DEREF_type ( type_func_ret ( s ) ) ;
452
	TYPE q = DEREF_type ( type_func_ret ( t ) ) ;
453
	unsigned np = TAG_type ( p ) ;
454
	unsigned nq = TAG_type ( q ) ;
455
	if ( np == nq ) {
456
	    if ( eq_type ( p, q ) ) return ( 1 ) ;
457
	    if ( np == type_ptr_tag || nq == type_ref_tag ) {
458
		p = DEREF_type ( type_ptr_etc_sub ( p ) ) ;
459
		np = TAG_type ( p ) ;
460
		if ( np == type_compound_tag ) {
461
		    q = DEREF_type ( type_ptr_etc_sub ( q ) ) ;
462
		    nq = TAG_type ( q ) ;
463
		    if ( nq == type_compound_tag ) {
464
			/* Both pointer or reference to class */
465
			GRAPH gr ;
466
			CLASS_TYPE cp, cq ;
467
			cp = DEREF_ctype ( type_compound_defn ( p ) ) ;
468
			cq = DEREF_ctype ( type_compound_defn ( q ) ) ;
469
			gr = find_base_class ( cp, cq, 1 ) ;
470
			if ( !IS_NULL_graph ( gr ) ) {
471
			    /* Base class conversion */
472
			    CV_SPEC cv = cv_compare ( q, p ) ;
473
			    if ( cv == cv_none ) {
474
				/* Qualification conversion */
475
				*pgr = gr ;
476
				return ( 1 ) ;
477
			    }
478
			}
479
		    }
480
		}
481
	    }
482
	}
483
 
484
	/* Allow for template types */
485
	if ( np == type_token_tag && is_templ_type ( p ) ) return ( 1 ) ;
486
	if ( nq == type_token_tag && is_templ_type ( q ) ) return ( 1 ) ;
487
	if ( np == type_error_tag || nq == type_error_tag ) return ( 1 ) ;
488
    }
489
    return ( 0 ) ;
490
}
491
 
492
 
493
/*
494
    DOES A FUNCTION OVERRIDE A VIRTUAL FUNCTION?
495
 
496
    This routine checks whether a member function nm of type t overrides
497
    a virtual function in some base class of ct.  It returns a list of
498
    all such functions.  The function return types are not checked at
499
    this stage.  If the function is not an overriding virtual function
500
    but has the same name as a virtual function then this is returned
501
    via pid.
502
*/
503
 
504
LIST ( VIRTUAL ) overrides_virtual
505
    PROTO_N ( ( ct, nm, t, pid ) )
506
    PROTO_T ( CLASS_TYPE ct X HASHID nm X TYPE t X IDENTIFIER *pid )
507
{
508
    LIST ( VIRTUAL ) res = NULL_list ( VIRTUAL ) ;
509
    VIRTUAL vt = DEREF_virt ( ctype_virt ( ct ) ) ;
510
    if ( !IS_NULL_virt ( vt ) ) {
511
	unsigned nt = TAG_hashid ( nm ) ;
512
	LIST ( VIRTUAL ) p = DEREF_list ( virt_table_entries ( vt ) ) ;
513
	while ( !IS_NULL_list ( p ) ) {
514
	    VIRTUAL vf = DEREF_virt ( HEAD_list ( p ) ) ;
515
	    switch ( TAG_virt ( vf ) ) {
516
		case virt_inherit_tag :
517
		case virt_complex_tag : {
518
		    /* Only check inherited functions */
519
		    IDENTIFIER fid = DEREF_id ( virt_func ( vf ) ) ;
520
		    HASHID fnm = DEREF_hashid ( id_name ( fid ) ) ;
521
		    if ( EQ_hashid ( fnm, nm ) ) {
522
			/* Names match */
523
			TYPE s ;
524
			s = DEREF_type ( id_function_etc_type ( fid ) ) ;
525
			if ( eq_func_type ( t, s, 1, 0 ) ) {
526
			    /* Types basically match */
527
			    CONS_virt ( vf, res, res ) ;
528
			} else {
529
			    *pid = fid ;
530
			}
531
		    } else if ( nt == hashid_destr_tag ) {
532
			/* Check for virtual destructors */
533
			if ( IS_hashid_destr ( fnm ) ) {
534
			    CONS_virt ( vf, res, res ) ;
535
			}
536
		    }
537
		    break ;
538
		}
539
	    }
540
	    p = TAIL_list ( p ) ;
541
	}
542
	res = REVERSE_list ( res ) ;
543
    }
544
    return ( res ) ;
545
}
546
 
547
 
548
/*
549
    FIND AN OVERRIDING VIRTUAL FUNCTION
550
 
551
    This routine finds an overriding virtual function for the virtual
552
    function id inherited from the base class gr of ct.  If the return
553
    types do not match then the base class conversion is assigned to pgr.
554
*/
555
 
556
VIRTUAL find_overrider
557
    PROTO_N ( ( ct, id, gr, pgr ) )
558
    PROTO_T ( CLASS_TYPE ct X IDENTIFIER id X GRAPH gr X GRAPH *pgr )
559
{
560
    HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
561
    unsigned nt = TAG_hashid ( nm ) ;
562
    TYPE t = DEREF_type ( id_function_etc_type ( id ) ) ;
563
 
564
    /* Scan through virtual functions */
565
    VIRTUAL vs = DEREF_virt ( ctype_virt ( ct ) ) ;
566
    if ( !IS_NULL_virt ( vs ) ) {
567
	LIST ( VIRTUAL ) p = DEREF_list ( virt_table_entries ( vs ) ) ;
568
	while ( !IS_NULL_list ( p ) ) {
569
	    VIRTUAL vf = DEREF_virt ( HEAD_list ( p ) ) ;
570
	    if ( !IS_virt_link ( vf ) ) {
571
		GRAPH gs = DEREF_graph ( virt_base ( vf ) ) ;
572
		if ( is_subgraph ( gs, gr ) ) {
573
		    HASHID fnm ;
574
		    IDENTIFIER fid = DEREF_id ( virt_func ( vf ) ) ;
575
		    if ( EQ_id ( fid, id ) ) {
576
			/* Identical functions */
577
			return ( vf ) ;
578
		    }
579
		    fnm = DEREF_hashid ( id_name ( fid ) ) ;
580
		    if ( EQ_hashid ( fnm, nm ) ) {
581
			/* Names match */
582
			TYPE s ;
583
			s = DEREF_type ( id_function_etc_type ( fid ) ) ;
584
			if ( eq_func_type ( s, t, 1, 0 ) ) {
585
			    /* Types basically match */
586
			    IGNORE virtual_return ( s, t, pgr ) ;
587
			    return ( vf ) ;
588
			}
589
		    } else if ( nt == hashid_destr_tag ) {
590
			/* Check for virtual destructors */
591
			if ( IS_hashid_destr ( fnm ) ) return ( vf ) ;
592
		    }
593
		}
594
	    }
595
	    p = TAIL_list ( p ) ;
596
	}
597
    }
598
    return ( NULL_virt ) ;
599
}
600
 
601
 
602
/*
603
    FIND THE START OF A VIRTUAL FUNCTION TABLE SECTION
604
 
605
    This routine finds the offset within the main virtual function table
606
    for a class of those functions inherited from the base class gr.
607
*/
608
 
609
unsigned long virtual_start
610
    PROTO_N ( ( gr ) )
611
    PROTO_T ( GRAPH gr )
612
{
613
    DECL_SPEC acc = DEREF_dspec ( graph_access ( gr ) ) ;
614
    if ( !( acc & dspec_ignore ) ) {
615
	GRAPH gu = DEREF_graph ( graph_up ( gr ) ) ;
616
	if ( !IS_NULL_graph ( gu ) ) {
617
	    unsigned long n = virtual_start ( gu ) ;
618
	    LIST ( GRAPH ) br = DEREF_list ( graph_tails ( gu ) ) ;
619
	    while ( !IS_NULL_list ( br ) ) {
620
		VIRTUAL vs ;
621
		CLASS_TYPE cs ;
622
		GRAPH gs = DEREF_graph ( HEAD_list ( br ) ) ;
623
		if ( eq_graph ( gs, gr ) ) return ( n ) ;
624
		cs = DEREF_ctype ( graph_head ( gs ) ) ;
625
		vs = DEREF_virt ( ctype_virt ( cs ) ) ;
626
		if ( !IS_NULL_virt ( vs ) ) {
627
		    /* Add virtual functions from cs */
628
		    unsigned long m = DEREF_ulong ( virt_no ( vs ) ) ;
629
		    n += m ;
630
		}
631
		br = TAIL_list ( br ) ;
632
	    }
633
	    return ( n ) ;
634
	}
635
    }
636
    return ( 0 ) ;
637
}
638
 
639
 
640
/*
641
    CREATE AN OVERRIDING VIRTUAL FUNCTION
642
 
643
    This routine creates an overriding virtual function id for vq.  gs gives
644
    the base class graph of the underlying type.
645
*/
646
 
647
static VIRTUAL override_virtual
648
    PROTO_N ( ( id, vq, gs ) )
649
    PROTO_T ( IDENTIFIER id X VIRTUAL vq X GRAPH gs )
650
{
651
    GRAPH gt ;
652
    VIRTUAL vp ;
653
    GRAPH gr = NULL_graph ;
654
    IDENTIFIER fn = DEREF_id ( virt_func ( vq ) ) ;
655
    unsigned long n = DEREF_ulong ( virt_no ( vq ) ) ;
656
 
657
    /* Check function return types */
658
    TYPE t = DEREF_type ( id_function_etc_type ( id ) ) ;
659
    TYPE s = DEREF_type ( id_function_etc_type ( fn ) ) ;
660
    if ( virtual_return ( t, s, &gr ) ) {
661
	if ( !IS_NULL_graph ( gr ) ) {
662
	    ERROR err = check_ambig_base ( gr ) ;
663
	    if ( !IS_NULL_err ( err ) ) {
664
		/* Can't be ambiguous */
665
		ERROR err2 = ERR_class_virtual_ambig ( id, fn ) ;
666
		err = concat_error ( err, err2 ) ;
667
		report ( crt_loc, err ) ;
668
	    }
669
	    check_base_access ( gr ) ;
670
	}
671
	if ( !eq_except ( t, s ) ) {
672
	    /* Check exception specifiers */
673
	    PTR ( LOCATION ) loc = id_loc ( fn ) ;
674
	    report ( crt_loc, ERR_except_spec_virtual ( id, fn, loc ) ) ;
675
	}
676
    } else {
677
	PTR ( LOCATION ) loc = id_loc ( fn ) ;
678
	report ( crt_loc, ERR_class_virtual_ret ( id, fn, loc ) ) ;
679
    }
680
 
681
    /* Find the result components */
682
    switch ( TAG_virt ( vq ) ) {
683
	case virt_override_tag : {
684
	    fn = DEREF_id ( virt_override_orig ( vq ) ) ;
685
	    gs = DEREF_graph ( virt_override_src ( vq ) ) ;
686
	    break ;
687
	}
688
	case virt_inherit_tag : {
689
	    gs = DEREF_graph ( virt_base ( vq ) ) ;
690
	    break ;
691
	}
692
	case virt_complex_tag : {
693
	    fn = DEREF_id ( virt_complex_orig ( vq ) ) ;
694
	    gs = DEREF_graph ( virt_complex_src ( vq ) ) ;
695
	    break ;
696
	}
697
    }
698
    gt = DEREF_graph ( graph_top ( gs ) ) ;
699
    MAKE_virt_override ( id, n, gt, gr, fn, gs, vp ) ;
700
    if ( do_dump ) dump_override ( id, fn ) ;
701
    return ( vp ) ;
702
}
703
 
704
 
705
/*
706
    ADD A VIRTUAL FUNCTION
707
 
708
    This routine adds the virtual function id to the virtual function
709
    table for the class ct.  r is the result of a call to overrides_virtual
710
    on id.
711
*/
712
 
713
void add_virtual
714
    PROTO_N ( ( ct, id, r ) )
715
    PROTO_T ( CLASS_TYPE ct X IDENTIFIER id X LIST ( VIRTUAL ) r )
716
{
717
    VIRTUAL vf ;
718
    unsigned long n ;
719
    LIST ( VIRTUAL ) p, q ;
720
    GRAPH gr = DEREF_graph ( ctype_base ( ct ) ) ;
721
 
722
    /* Create the virtual function table if necessary */
723
    VIRTUAL vt = DEREF_virt ( ctype_virt ( ct ) ) ;
724
    if ( IS_NULL_virt ( vt ) ) {
725
	vt = make_virt_table ( ct, cinfo_polymorphic, output_capsule ) ;
726
	p = NULL_list ( VIRTUAL ) ;
727
	n = 0 ;
728
    } else {
729
	p = DEREF_list ( virt_table_entries ( vt ) ) ;
730
	n = DEREF_ulong ( virt_no ( vt ) ) ;
731
    }
732
 
733
    /* Create the table entry */
734
    if ( IS_NULL_list ( r ) ) {
735
	/* New virtual function */
736
	MAKE_virt_simple ( id, n, gr, vf ) ;
737
	CONS_virt ( vf, NULL_list ( VIRTUAL ), q ) ;
738
	p = APPEND_list ( p, q ) ;
739
	COPY_list ( virt_table_entries ( vt ), p ) ;
740
	COPY_ulong ( virt_no ( vt ), n + 1 ) ;
741
    } else {
742
	/* Overriding virtual function */
743
	q = r ;
744
	while ( !IS_NULL_list ( q ) ) {
745
	    VIRTUAL vq = DEREF_virt ( HEAD_list ( q ) ) ;
746
	    for ( ; ; ) {
747
		VIRTUAL vp = DEREF_virt ( HEAD_list ( p ) ) ;
748
		if ( EQ_virt ( vp, vq ) ) break ;
749
		p = TAIL_list ( p ) ;
750
	    }
751
	    vf = override_virtual ( id, vq, gr ) ;
752
	    COPY_virt ( HEAD_list ( p ), vf ) ;
753
	    p = TAIL_list ( p ) ;
754
	    q = TAIL_list ( q ) ;
755
	}
756
	DESTROY_list ( r, SIZE_virt ) ;
757
    }
758
    return ;
759
}
760
 
761
 
762
/*
763
    FIND A PURE VIRTUAL FUNCTION OF A CLASS
764
 
765
    This routine returns a pure virtual function of the class ct if such
766
    exists.  Otherwise the null identifier is returned.
767
*/
768
 
769
IDENTIFIER find_pure_function
770
    PROTO_N ( ( ct ) )
771
    PROTO_T ( CLASS_TYPE ct )
772
{
773
    VIRTUAL vt = DEREF_virt ( ctype_virt ( ct ) ) ;
774
    if ( !IS_NULL_virt ( vt ) ) {
775
	LIST ( VIRTUAL ) p = DEREF_list ( virt_table_entries ( vt ) ) ;
776
	while ( !IS_NULL_list ( p ) ) {
777
	    VIRTUAL vf = DEREF_virt ( HEAD_list ( p ) ) ;
778
	    IDENTIFIER id = DEREF_id ( virt_func ( vf ) ) ;
779
	    DECL_SPEC ds = DEREF_dspec ( id_storage ( id ) ) ;
780
	    if ( ds & dspec_pure ) return ( id ) ;
781
	    p = TAIL_list ( p ) ;
782
	}
783
    }
784
    return ( NULL_id ) ;
785
}