Subversion Repositories tendra.SVN

/*

 * Copyright (c) 2002-2006 The TenDRA Project <http://www.tendra.org/>.

 * All rights reserved.

 *

 * Redistribution and use in source and binary forms, with or without

 * modification, are permitted provided that the following conditions are met:

 *

 * 1. Redistributions of source code must retain the above copyright notice,

 *    this list of conditions and the following disclaimer.

 * 2. Redistributions in binary form must reproduce the above copyright notice,

 *    this list of conditions and the following disclaimer in the documentation

 *    and/or other materials provided with the distribution.

 * 3. Neither the name of The TenDRA Project nor the names of its contributors

 *    may be used to endorse or promote products derived from this software

 *    without specific, prior written permission.

 *

 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS

 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,

 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR

 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR

 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,

 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

 *

 * $Id$

 */

/*

    		 Crown Copyright (c) 1997

    This TenDRA(r) Computer Program is subject to Copyright

    owned by the United Kingdom Secretary of State for Defence

    acting through the Defence Evaluation and Research Agency

    (DERA).  It is made available to Recipients with a

    royalty-free licence for its use, reproduction, transfer

    to other parties and amendment for any purpose not excluding

    product development provided that any such use et cetera

    shall be deemed to be acceptance of the following conditions:-

        (1) Its Recipients shall ensure that this Notice is

        reproduced upon any copies or amended versions of it;

        (2) Any amended version of it shall be clearly marked to

        show both the nature of and the organisation responsible

        for the relevant amendment or amendments;

        (3) Its onward transfer from a recipient to another

        party shall be deemed to be that party's acceptance of

        these conditions;

        (4) DERA gives no warranty or assurance as to its

        quality or suitability for any purpose and DERA accepts

        no liability whatsoever in relation to any use to which

        it may be put.

*/

#include "config.h"

#include "c_types.h"

#include "ctype_ops.h"

#include "graph_ops.h"

#include "hashid_ops.h"

#include "id_ops.h"

#include "type_ops.h"

#include "virt_ops.h"

#include "error.h"

#include "catalog.h"

#include "option.h"

#include "access.h"

#include "capsule.h"

#include "check.h"

#include "chktype.h"

#include "derive.h"

#include "dump.h"

#include "exception.h"

#include "function.h"

#include "namespace.h"

#include "overload.h"

#include "syntax.h"

#include "template.h"

#include "virtual.h"

/*

    COMBINE TWO INHERITED VIRTUAL FUNCTIONS

    This routine is called when the same virtual function is inherited

    via both vp and vq.  It combine the two virtual function table entries

    and returns the result.  Note that one or other may be selected using

    the dominance rule in certain cases.

*/

static VIRTUAL

inherit_duplicate(VIRTUAL vp, VIRTUAL vq)

{

	GRAPH gr;

	IDENTIFIER fn;

	IDENTIFIER gn;

	unsigned long n;

	if (IS_virt_inherit(vq)) {

		DESTROY_virt_inherit(destroy, fn, n, gr, vq, vq);

		UNUSED(fn);

		UNUSED(n);

		UNUSED(gr);

		UNUSED(vq);

		return (vp);

	}

	if (IS_virt_inherit(vp)) {

		DESTROY_virt_inherit(destroy, fn, n, gr, vp, vp);

		UNUSED(fn);

		UNUSED(n);

		UNUSED(gr);

		UNUSED(vp);

		return (vq);

	}

	fn = DEREF_id(virt_func(vp));

	gn = DEREF_id(virt_func(vq));

	if (EQ_id(fn, gn)) {

		return (vp);

	}

	COPY_virt(virt_next(vq), vp);

	return (vq);

}

/*

    INHERIT A VIRTUAL FUNCTION

    This routine inherits the virtual function vq from the direct base

    class gs.  p gives the list of functions already inherited.

*/

static VIRTUAL

inherit_virtual(VIRTUAL vq, GRAPH gs, LIST(VIRTUAL) p)

{

	VIRTUAL vp = NULL_virt;

	CLASS_TYPE cs = DEREF_ctype(graph_head(gs));

	CLASS_INFO ci = DEREF_cinfo(ctype_info(cs));

	GRAPH gt = DEREF_graph(ctype_base(cs));

	IDENTIFIER fn = DEREF_id(virt_func(vq));

	switch (TAG_virt(vq)) {

	case virt_simple_tag:

		/* Simple inheritance */

		MAKE_virt_inherit(fn, 0, gs, vp);

		return (vp);

	case virt_override_tag: {

		/* Override inheritance */

		IDENTIFIER bn = DEREF_id(virt_override_orig(vq));

		GRAPH rq = DEREF_graph(virt_override_ret(vq));

		GRAPH sq = DEREF_graph(virt_override_src(vq));

		GRAPH sp = find_subgraph(gs, gt, sq);

		MAKE_virt_complex(fn, 0, gs, rq, bn, sp, vp);

		fn = bn;

		gs = sp;

		break;

	}

	case virt_inherit_tag: {

		/* Nested inheritance */

		GRAPH gq = DEREF_graph(virt_base(vq));

		GRAPH gp = find_subgraph(gs, gt, gq);

		MAKE_virt_inherit(fn, 0, gp, vp);

		gs = gp;

		break;

	}

	case virt_complex_tag: {

		/* Complex inheritance */

		IDENTIFIER bn = DEREF_id(virt_complex_orig(vq));

		GRAPH rq = DEREF_graph(virt_complex_ret(vq));

		GRAPH sq = DEREF_graph(virt_complex_src(vq));

		GRAPH sp = find_subgraph(gs, gt, sq);

		GRAPH gq = DEREF_graph(virt_base(vq));

		GRAPH gp = find_subgraph(gs, gt, gq);

		MAKE_virt_complex(fn, 0, gp, rq, bn, sp, vp);

		fn = bn;

		gs = sp;

		break;

	}

	case virt_link_tag: {

		/* Symbolic link */

		PTR(VIRTUAL)pv = DEREF_ptr(virt_link_to(vq));

		vq = DEREF_virt(pv);

		vp = inherit_virtual(vq, gs, p);

		return (vp);

	}

	default:

		/* Shouldn't occur */

		return (vp);

	}

	/* Check previous cases */

	if (ci & cinfo_virtual_base) {

		while (!IS_NULL_list(p)) {

			VIRTUAL vr = DEREF_virt(HEAD_list(p));

			switch (TAG_virt(vr)) {

			case virt_inherit_tag: {

				/* Previous simple inheritance */

				IDENTIFIER bn = DEREF_id(virt_func(vr));

				GRAPH gr = DEREF_graph(virt_base(vr));

				if (EQ_id(bn, fn) && eq_graph(gr, gs)) {

					unsigned long n =

					    DEREF_ulong(virt_no(vr));

					vp = inherit_duplicate(vr, vp);

					COPY_ulong(virt_no(vr), n);

					COPY_virt(HEAD_list(p), vp);

					MAKE_virt_link(bn, n, gr, HEAD_list(p),

						       vp);

					return (vp);

				}

				break;

			}

			case virt_complex_tag: {

				/* Previous complex inheritance */

				IDENTIFIER bn = DEREF_id(virt_complex_orig(vr));

				GRAPH gr = DEREF_graph(virt_complex_src(vr));

				if (EQ_id(bn, fn) && eq_graph(gr, gs)) {

					unsigned long n =

					    DEREF_ulong(virt_no(vr));

					vp = inherit_duplicate(vr, vp);

					COPY_ulong(virt_no(vr), n);

					COPY_virt(HEAD_list(p), vp);

					MAKE_virt_link(bn, n, gr, HEAD_list(p),

						       vp);

					return (vp);

				}

				break;

			}

			}

			p = TAIL_list(p);

		}

	}

	return (vp);

}

/*

    INHERIT A VIRTUAL FUNCTION TABLE

    This routine inherits the virtual function table vs to the class

    corresponding to the graph gt.  vt gives any previous virtual function

    tables.

*/

static VIRTUAL

inherit_table(VIRTUAL vs, VIRTUAL vt, GRAPH gt)

{

	if (!IS_NULL_virt(vs)) {

		OFFSET off;

		VIRTUAL vp;

		IDENTIFIER id = DEREF_id(virt_func(vs));

		GRAPH gr = DEREF_graph(virt_base(vs));

		GRAPH gs = DEREF_graph(graph_top(gr));

		VIRTUAL vr = DEREF_virt(virt_next(vs));

		vr = inherit_table(vr, vt, gt);

		gr = find_subgraph(gt, gs, gr);

		off = DEREF_off(graph_off(gr));

		vp = vr;

		while (!IS_NULL_virt(vp)) {

			/* Check for previous use of this base */

			GRAPH gp = DEREF_graph(virt_base(vp));

			if (eq_graph(gp, gr)) {

				COPY_off(virt_table_off(vp), off);

				COPY_graph(virt_base(vp), gr);

				return (vt);

			}

			vp = DEREF_virt(virt_next(vp));

		}

		MAKE_virt_table(id, 0, gr, off, vt);

		COPY_virt(virt_next(vt), vr);

	}

	return (vt);

}

/*

    INHERIT VIRTUAL FUNCTION TABLES

    This routine inherits the virtual function tables from the list of

    base classes br.

*/

static VIRTUAL

inherit_base_tables(LIST(GRAPH) br)

{

	if (!IS_NULL_list(br)) {

		VIRTUAL vt = inherit_base_tables(TAIL_list(br));

		GRAPH gs = DEREF_graph(HEAD_list(br));

		CLASS_TYPE cs = DEREF_ctype(graph_head(gs));

		VIRTUAL vs = DEREF_virt(ctype_virt(cs));

		vt = inherit_table(vs, vt, gs);

		return (vt);

	}

	return (NULL_virt);

}

/*

    CREATE A VIRTUAL FUNCTION TABLES

    This routine creates the virtual function tables for the class ct.

    If code generation is not enabled then this is just a simple table

    corresponding to ct.  Otherwise it may be necessary to create a

    number of tables, corresponding to the base classes of ct.  If the

    first base class is not virtual then its inherited table is used

    for ct, otherwise a new table needs to be created.  If bases is

    false then a single table is created.

*/

static VIRTUAL

make_virt_table(CLASS_TYPE ct, CLASS_INFO cj, int bases)

{

	VIRTUAL vt = NULL_virt;

	VIRTUAL vs = NULL_virt;

	GRAPH gr = DEREF_graph(ctype_base(ct));

	CLASS_INFO ci = DEREF_cinfo(ctype_info(ct));

	/* Inherit tables from base classes */

	if (bases) {

		LIST(GRAPH) br = DEREF_list(graph_tails(gr));

		vs = inherit_base_tables(br);

		if (!IS_NULL_virt(vs)) {

			OFFSET off = DEREF_off(virt_table_off(vs));

			if (is_zero_offset(off)) {

				/* Use inherited virtual function table */

				vt = vs;

			}

		}

	}

	/* Create new virtual function table */

	if (IS_NULL_virt(vt)) {

		IDENTIFIER id = DEREF_id(ctype_name(ct));

		MAKE_virt_table(id, 0, gr, NULL_off, vt);

		COPY_virt(virt_next(vt), vs);

	}

	COPY_virt(ctype_virt(ct), vt);

	COPY_cinfo(ctype_info(ct), (ci | cj));

	return (vt);

}

/*

    INITIALISE A VIRTUAL FUNCTION TABLE

    This routine initialises the virtual function table for the class

    type ct.

*/

void

begin_virtual(CLASS_TYPE ct)

{

	unsigned long n = 0;

	LIST(VIRTUAL) p = NULL_list(VIRTUAL);

	GRAPH gr = DEREF_graph(ctype_base(ct));

	LIST(GRAPH) br = DEREF_list(graph_tails(gr));

	/* Scan through direct base classes */

	while (!IS_NULL_list(br)) {

		GRAPH gs = DEREF_graph(HEAD_list(br));

		CLASS_TYPE cs = DEREF_ctype(graph_head(gs));

		VIRTUAL vs = DEREF_virt(ctype_virt(cs));

		if (!IS_NULL_virt(vs)) {

			LIST(VIRTUAL)q = DEREF_list(virt_table_entries(vs));

			while (!IS_NULL_list(q)) {

				VIRTUAL vq = DEREF_virt(HEAD_list(q));

				VIRTUAL vp = inherit_virtual(vq, gs, p);

				if (!IS_NULL_virt(vp)) {

					/* Add inherited function to list */

					CONS_virt(vp, p, p);

					COPY_ulong(virt_no(vp), n);

					n++;

				}

				q = TAIL_list(q);

			}

		}

		br = TAIL_list(br);

	}

	/* Construct the virtual function table */

	if (!IS_NULL_list(p)) {

		CLASS_INFO ci = (cinfo_polymorphic | cinfo_poly_base);

		VIRTUAL vt = make_virt_table(ct, ci, output_capsule);

		p = REVERSE_list(p);

		COPY_list(virt_table_entries(vt), p);

		COPY_ulong(virt_no(vt), n);

	}

	return;

}

/*

    COMPLETE A VIRTUAL FUNCTION TABLE

    This routine is called at the end of a class definition to complete

    the construction of the virtual function table.  It checks for

    inherited pure virtual functions and for final overriding functions.

    Also if any overriding virtual function involves a non-trivial base

    class conversion then an inherited virtual function table cannot be

    used as the main virtual function table for ct.

*/

void

end_virtual(CLASS_TYPE ct)

{

	VIRTUAL vt = DEREF_virt(ctype_virt(ct));

	if (!IS_NULL_virt(vt)) {

		int destr = 0;

		int trivial = 1;

		OFFSET off = DEREF_off(virt_table_off(vt));

		CLASS_INFO ci = DEREF_cinfo(ctype_info(ct));

		LIST(VIRTUAL) p = DEREF_list(virt_table_entries(vt));

		LIST(VIRTUAL) q = p;

		unsigned long n = DEREF_ulong(virt_no(vt));

		IGNORE check_value(OPT_VAL_virtual_funcs, n);

		while (!IS_NULL_list(q)) {

			VIRTUAL vf = DEREF_virt(HEAD_list(q));

			IDENTIFIER id = DEREF_id(virt_func(vf));

			HASHID nm = DEREF_hashid(id_name(id));

			DECL_SPEC ds = DEREF_dspec(id_storage(id));

			if (ds & dspec_pure) {

				ci |= cinfo_abstract;

			}

			if (IS_hashid_destr(nm)) {

				destr = 1;

			}

			if (IS_virt_override(vf)) {

				/* Check for non-trivial return conversions */

				GRAPH gr = DEREF_graph(virt_override_ret(vf));

				if (!IS_NULL_graph(gr)) {

					DECL_SPEC acc =

					    DEREF_dspec(graph_access(gr));

					if (!(acc & dspec_ignore)) {

						trivial = 0;

					}

				}

			} else if (IS_virt_complex(vf)) {

				/* Check for final overrider */

				GRAPH gr = DEREF_graph(virt_complex_ret(vf));

				VIRTUAL vn = DEREF_virt(virt_next(vf));

				if (!IS_NULL_virt(vn)) {

					id = DEREF_id(virt_complex_orig(vf));

					report(crt_loc,

					       ERR_class_virtual_final(id, ct));

				}

				if (!IS_NULL_graph(gr)) {

					DECL_SPEC acc =

					    DEREF_dspec(graph_access(gr));

					if (!(acc & dspec_ignore)) {

						trivial = 0;

					}

				}

			}

			q = TAIL_list(q);

		}

		if (!IS_NULL_off(off) && !trivial && output_capsule) {

			/* Can't use inherited virtual function table */

			VIRTUAL vs = make_virt_table(ct, cinfo_none, 0);

			COPY_virt(virt_next(vs), vt);

			COPY_ulong(virt_no(vs), n);

			COPY_list(virt_table_entries(vs), p);

		}

		if (!destr) {

			/* Warn about non-virtual destructors */

			report(crt_loc, ERR_class_virtual_destr(ct));

		}

		ci |= cinfo_polymorphic;

		COPY_cinfo(ctype_info(ct), ci);

	}

	return;

}

/*

    CHECK VIRTUAL FUNCTION RETURN TYPES

    This routine checks whether the return type of the function type s is

    valid for a virtual function which overrides a function of type t.

    If the return types differ by a base class conversion then the

    corresponding base class graph is returned via pgr.

*/

static int

virtual_return(TYPE s, TYPE t, GRAPH *pgr)

{

    if (IS_type_func(s) && IS_type_func(t)) {

	TYPE p = DEREF_type(type_func_ret(s));

	TYPE q = DEREF_type(type_func_ret(t));

	unsigned np = TAG_type(p);

	unsigned nq = TAG_type(q);

	if (np == nq) {

	    if (eq_type(p, q)) {

		    return (1);

	    }

	    if (np == type_ptr_tag || nq == type_ref_tag) {

		p = DEREF_type(type_ptr_etc_sub(p));

		np = TAG_type(p);

		if (np == type_compound_tag) {

		    q = DEREF_type(type_ptr_etc_sub(q));

		    nq = TAG_type(q);

		    if (nq == type_compound_tag) {

			/* Both pointer or reference to class */

			GRAPH gr;

			CLASS_TYPE cp, cq;

			cp = DEREF_ctype(type_compound_defn(p));

			cq = DEREF_ctype(type_compound_defn(q));

			gr = find_base_class(cp, cq, 1);

			if (!IS_NULL_graph(gr)) {

			    /* Base class conversion */

			    CV_SPEC cv = cv_compare(q, p);

			    if (cv == cv_none) {

				/* Qualification conversion */

				*pgr = gr;

				return (1);

			    }

			}

		    }

		}

	    }

	}

	/* Allow for template types */

	if (np == type_token_tag && is_templ_type(p)) {

		return (1);

	}

	if (nq == type_token_tag && is_templ_type(q)) {

		return (1);

	}

	if (np == type_error_tag || nq == type_error_tag) {

		return (1);

	}

    }

    return (0);

}

/*

    DOES A FUNCTION OVERRIDE A VIRTUAL FUNCTION?

    This routine checks whether a member function nm of type t overrides

    a virtual function in some base class of ct.  It returns a list of

    all such functions.  The function return types are not checked at

    this stage.  If the function is not an overriding virtual function

    but has the same name as a virtual function then this is returned

    via pid.

*/

LIST(VIRTUAL)

overrides_virtual(CLASS_TYPE ct, HASHID nm, TYPE t, IDENTIFIER *pid)

{

	LIST(VIRTUAL) res = NULL_list(VIRTUAL);

	VIRTUAL vt = DEREF_virt(ctype_virt(ct));

	if (!IS_NULL_virt(vt)) {

		unsigned nt = TAG_hashid(nm);

		LIST(VIRTUAL) p = DEREF_list(virt_table_entries(vt));

		while (!IS_NULL_list(p)) {

			VIRTUAL vf = DEREF_virt(HEAD_list(p));

			switch (TAG_virt(vf)) {

			case virt_inherit_tag:

			case virt_complex_tag: {

				/* Only check inherited functions */

				IDENTIFIER fid = DEREF_id(virt_func(vf));

				HASHID fnm = DEREF_hashid(id_name(fid));

				if (EQ_hashid(fnm, nm)) {

					/* Names match */

					TYPE s;

					s = DEREF_type(id_function_etc_type(fid));

					if (eq_func_type(t, s, 1, 0)) {

						/* Types basically match */

						CONS_virt(vf, res, res);

					} else {

						*pid = fid;

					}

				} else if (nt == hashid_destr_tag) {

					/* Check for virtual destructors */

					if (IS_hashid_destr(fnm)) {

						CONS_virt(vf, res, res);

					}

				}

				break;

			}

			}

			p = TAIL_list(p);

		}

		res = REVERSE_list(res);

	}

	return (res);

}

/*

    FIND AN OVERRIDING VIRTUAL FUNCTION

    This routine finds an overriding virtual function for the virtual

    function id inherited from the base class gr of ct.  If the return

    types do not match then the base class conversion is assigned to pgr.

*/

VIRTUAL

find_overrider(CLASS_TYPE ct, IDENTIFIER id, GRAPH gr, GRAPH *pgr)

{

	HASHID nm = DEREF_hashid(id_name(id));

	unsigned nt = TAG_hashid(nm);

	TYPE t = DEREF_type(id_function_etc_type(id));

	/* Scan through virtual functions */

	VIRTUAL vs = DEREF_virt(ctype_virt(ct));

	if (!IS_NULL_virt(vs)) {

		LIST(VIRTUAL) p = DEREF_list(virt_table_entries(vs));

		while (!IS_NULL_list(p)) {

			VIRTUAL vf = DEREF_virt(HEAD_list(p));

			if (!IS_virt_link(vf)) {

				GRAPH gs = DEREF_graph(virt_base(vf));

				if (is_subgraph(gs, gr)) {

					HASHID fnm;

					IDENTIFIER fid =

					    DEREF_id(virt_func(vf));

					if (EQ_id(fid, id)) {

						/* Identical functions */

						return (vf);

					}

					fnm = DEREF_hashid(id_name(fid));

					if (EQ_hashid(fnm, nm)) {

						/* Names match */

						TYPE s;

						s = DEREF_type(id_function_etc_type(fid));

						if (eq_func_type(s, t, 1, 0)) {

							/* Types basically

							 * match */

							IGNORE virtual_return(s, t, pgr);

							return (vf);

						}

					} else if (nt == hashid_destr_tag) {

						/* Check for virtual

						 * destructors */

						if (IS_hashid_destr(fnm)) {

							return (vf);

						}

					}

				}

			}

			p = TAIL_list(p);

		}

	}

	return (NULL_virt);

}

/*

    FIND THE START OF A VIRTUAL FUNCTION TABLE SECTION

    This routine finds the offset within the main virtual function table

    for a class of those functions inherited from the base class gr.

*/

unsigned long

virtual_start(GRAPH gr)

{

	DECL_SPEC acc = DEREF_dspec(graph_access(gr));

	if (!(acc & dspec_ignore)) {

		GRAPH gu = DEREF_graph(graph_up(gr));

		if (!IS_NULL_graph(gu)) {

			unsigned long n = virtual_start(gu);

			LIST(GRAPH) br = DEREF_list(graph_tails(gu));

			while (!IS_NULL_list(br)) {

				VIRTUAL vs;

				CLASS_TYPE cs;

				GRAPH gs = DEREF_graph(HEAD_list(br));

				if (eq_graph(gs, gr)) {

					return (n);

				}

				cs = DEREF_ctype(graph_head(gs));

				vs = DEREF_virt(ctype_virt(cs));

				if (!IS_NULL_virt(vs)) {

					/* Add virtual functions from cs */

					unsigned long m =

					    DEREF_ulong(virt_no(vs));

					n += m;

				}

				br = TAIL_list(br);

			}

			return (n);

		}

	}

	return (0);

}

/*

    CREATE AN OVERRIDING VIRTUAL FUNCTION

    This routine creates an overriding virtual function id for vq.  gs gives

    the base class graph of the underlying type.

*/

static VIRTUAL

override_virtual(IDENTIFIER id, VIRTUAL vq, GRAPH gs)

{

	GRAPH gt;

	VIRTUAL vp;

	GRAPH gr = NULL_graph;

	IDENTIFIER fn = DEREF_id(virt_func(vq));

	unsigned long n = DEREF_ulong(virt_no(vq));

	/* Check function return types */

	TYPE t = DEREF_type(id_function_etc_type(id));

	TYPE s = DEREF_type(id_function_etc_type(fn));

	if (virtual_return(t, s, &gr)) {

		if (!IS_NULL_graph(gr)) {

			ERROR err = check_ambig_base(gr);

			if (!IS_NULL_err(err)) {

				/* Can't be ambiguous */

				ERROR err2 = ERR_class_virtual_ambig(id, fn);

				err = concat_error(err, err2);

				report(crt_loc, err);

			}

			check_base_access(gr);

		}

		if (!eq_except(t, s)) {

			/* Check exception specifiers */

			PTR(LOCATION)loc = id_loc(fn);

			report(crt_loc, ERR_except_spec_virtual(id, fn, loc));

		}

	} else {

		PTR(LOCATION)loc = id_loc(fn);

		report(crt_loc, ERR_class_virtual_ret(id, fn, loc));

	}

	/* Find the result components */

	switch (TAG_virt(vq)) {

	case virt_override_tag:

		fn = DEREF_id(virt_override_orig(vq));

		gs = DEREF_graph(virt_override_src(vq));

		break;

	case virt_inherit_tag:

		gs = DEREF_graph(virt_base(vq));

		break;

	case virt_complex_tag:

		fn = DEREF_id(virt_complex_orig(vq));

		gs = DEREF_graph(virt_complex_src(vq));

		break;

	}

	gt = DEREF_graph(graph_top(gs));

	MAKE_virt_override(id, n, gt, gr, fn, gs, vp);

	if (do_dump) {

		dump_override(id, fn);

	}

	return (vp);

}

/*

    ADD A VIRTUAL FUNCTION

    This routine adds the virtual function id to the virtual function

    table for the class ct.  r is the result of a call to overrides_virtual

    on id.

*/

void

add_virtual(CLASS_TYPE ct, IDENTIFIER id, LIST(VIRTUAL) r)

{

	VIRTUAL vf;

	unsigned long n;

	LIST(VIRTUAL)p, q;

	GRAPH gr = DEREF_graph(ctype_base(ct));

	/* Create the virtual function table if necessary */

	VIRTUAL vt = DEREF_virt(ctype_virt(ct));

	if (IS_NULL_virt(vt)) {

		vt = make_virt_table(ct, cinfo_polymorphic, output_capsule);

		p = NULL_list(VIRTUAL);

		n = 0;

	} else {

		p = DEREF_list(virt_table_entries(vt));

		n = DEREF_ulong(virt_no(vt));

	}

	/* Create the table entry */

	if (IS_NULL_list(r)) {

		/* New virtual function */

		MAKE_virt_simple(id, n, gr, vf);

		CONS_virt(vf, NULL_list(VIRTUAL), q);

		p = APPEND_list(p, q);

		COPY_list(virt_table_entries(vt), p);

		COPY_ulong(virt_no(vt), n + 1);

	} else {

		/* Overriding virtual function */

		q = r;

		while (!IS_NULL_list(q)) {

			VIRTUAL vq = DEREF_virt(HEAD_list(q));

			for (;;) {

				VIRTUAL vp = DEREF_virt(HEAD_list(p));

				if (EQ_virt(vp, vq)) {

					break;

				}

				p = TAIL_list(p);

			}

			vf = override_virtual(id, vq, gr);

			COPY_virt(HEAD_list(p), vf);

			p = TAIL_list(p);

			q = TAIL_list(q);

		}

		DESTROY_list(r, SIZE_virt);

	}

	return;

}

/*

    FIND A PURE VIRTUAL FUNCTION OF A CLASS

    This routine returns a pure virtual function of the class ct if such

    exists.  Otherwise the null identifier is returned.

*/

IDENTIFIER

find_pure_function(CLASS_TYPE ct)

{

	VIRTUAL vt = DEREF_virt(ctype_virt(ct));

	if (!IS_NULL_virt(vt)) {

		LIST(VIRTUAL) p = DEREF_list(virt_table_entries(vt));

		while (!IS_NULL_list(p)) {

			VIRTUAL vf = DEREF_virt(HEAD_list(p));

			IDENTIFIER id = DEREF_id(virt_func(vf));

			DECL_SPEC ds = DEREF_dspec(id_storage(id));

			if (ds & dspec_pure) {

				return (id);

			}

			p = TAIL_list(p);

		}

	}

	return (NULL_id);

}