/*
 * Copyright (c) 2002, The Tendra Project <http://www.ten15.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 unmodified, 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.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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.
 *
 *
 *    		 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.
 *
 * $TenDRA: tendra/src/producers/common/construct/virtual.c,v 1.7 2004/08/14 15:15:37 bp Exp $
 */


#include "config.h"
#include "producer.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);
}