Subversion Repositories tendra.SVN

Rev

Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

/*
                 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 "exp_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 "access.h"
#include "basetype.h"
#include "cast.h"
#include "check.h"
#include "chktype.h"
#include "class.h"
#include "constant.h"
#include "convert.h"
#include "derive.h"
#include "destroy.h"
#include "exception.h"
#include "expression.h"
#include "hash.h"
#include "identifier.h"
#include "initialise.h"
#include "interface.h"
#include "literal.h"
#include "namespace.h"
#include "overload.h"
#include "syntax.h"
#include "template.h"
#include "tok.h"
#include "token.h"
#include "typeid.h"
#include "ustring.h"


/*
    STANDARD CLASS NAMES

    These variables are used to hold the names of the various built-in
    class types.  They are defined here as the majority are concerned
    with run-time type information.
*/

static CONST char *std_name = "std" ;
static NAMESPACE std_namespace = NULL_nspace ;


/*
    FIND THE STANDARD NAMESPACE

    This routine returns the std namespace if this has been declared.
*/

static NAMESPACE find_std_namespace
    PROTO_Z ()
{
    NAMESPACE ns = std_namespace ;
    if ( IS_NULL_nspace ( ns ) ) {
        string s = ustrlit ( std_name ) ;
        if ( s == NULL ) {
            /* Use global namespace if std_name is not given */
            ns = global_namespace ;
        } else {
            /* Look up 'std' in the global namespace */
            unsigned long h = hash ( s ) ;
            HASHID nm = lookup_name ( s, h, 0, lex_identifier ) ;
            MEMBER mem = search_member ( global_namespace, nm, 0 ) ;
            IDENTIFIER id = type_member ( mem, 2 ) ;
            if ( !IS_NULL_id ( id ) && IS_id_nspace_name_etc ( id ) ) {
                ns = DEREF_nspace ( id_nspace_name_etc_defn ( id ) ) ;
            }
        }
        std_namespace = ns ;
    }
    return ( ns ) ;
}


/*
    SET THE STANDARD NAMESPACE

    This routine sets the std namespace according to the identifier id.
    The null identifier is used to indicate the global namespace.
*/

void set_std_namespace
    PROTO_N ( ( id ) )
    PROTO_T ( IDENTIFIER id )
{
    std_name = NULL ;
    std_namespace = NULL_nspace ;
    if ( !IS_NULL_id ( id ) ) {
        HASHID nm = DEREF_hashid ( id_name ( id ) ) ;
        if ( IS_hashid_name_etc ( nm ) ) {
            string s = DEREF_string ( hashid_name_etc_text ( nm ) ) ;
            std_name = strlit ( s ) ;
        }
    }
    IGNORE find_std_namespace () ;
    return ;
}


/*
    LOOK UP A STANDARD CLASS TYPE

    This routine looks up the standard class named s in the std namespace.
    The null type is returned if the type has not been declared and, in
    addition, an error is reported if err is true.
*/

TYPE find_std_type
    PROTO_N ( ( s, type, err ) )
    PROTO_T ( CONST char *s X int type X int err )
{
    string us = ustrlit ( s ) ;
    unsigned long h = hash ( us ) ;
    HASHID nm = lookup_name ( us, h, 0, lex_identifier ) ;
    NAMESPACE ns = find_std_namespace () ;
    if ( !IS_NULL_nspace ( ns ) ) {
        IDENTIFIER id = search_id ( ns, nm, 0, type ) ;
        if ( !IS_NULL_id ( id ) && IS_id_class_name_etc ( id ) ) {
            TYPE t = DEREF_type ( id_class_name_etc_defn ( id ) ) ;
            return ( t ) ;
        }
    }
    if ( err ) {
        us = ustrlit ( std_name ) ;
        report ( crt_loc, ERR_lib_builtin ( us, nm ) ) ;
    }
    return ( NULL_type ) ;
}


/*
    RUN-TIME TYPE INFORMATION ROUTINES

    The run-time type information routines are only included in the
    C++ producer.
*/

#if LANGUAGE_CPP


/*
    STANDARD CLASS TYPES

    The variable type_info_ref represents the type 'const type_info &'
    returned by the typeid operation.  The variables type_bad_cast and
    type_bad_typeid represent the types 'bad_cast' and 'bad_typeid'
    thrown by the dynamic_cast and typeid operators.
*/

static TYPE type_info_ref = NULL_type ;
static TYPE type_bad_cast = NULL_type ;
static TYPE type_bad_typeid = NULL_type ;


/*
    GET THE TYPE_INFO TYPE

    This routine returns the type of the typeid operator.  An internal
    error is reported if this has not been initialised.
*/

TYPE get_type_info
    PROTO_N ( ( op, t, err ) )
    PROTO_T ( int op X TYPE t X int err )
{
    TYPE r = NULL_type ;
    if ( op == lex_typeid ) {
        r = type_info_ref ;
        if ( IS_NULL_type ( r ) ) {
            r = find_std_type ( "type_info", 1, err ) ;
            if ( IS_NULL_type ( r ) ) {
                if ( err ) {
                    r = type_error ;
                } else {
                    CV_SPEC cv = ( cv_lvalue | cv_const ) ;
                    MAKE_type_dummy ( cv, TOK_typeid_type, r ) ;
                }
            } else {
                /* Form 'lvalue const type_info' */
                r = qualify_type ( r, ( cv_lvalue | cv_const ), 0 ) ;
                type_info_ref = r ;
            }
        }
    } else {
        if ( IS_type_compound ( t ) ) {
            CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
            VIRTUAL vt = DEREF_virt ( ctype_virt ( ct ) ) ;
            if ( !IS_NULL_virt ( vt ) ) {
                /* Form array of pointers to members */
                unsigned long m = DEREF_ulong ( virt_no ( vt ) ) ;
                NAT n = make_nat_value ( m + VIRTUAL_EXTRA ) ;
                r = copy_typedef ( NULL_id, type_func_void, cv_none ) ;
                MAKE_type_ptr_mem ( cv_const, ct, r, r ) ;
                MAKE_type_array ( cv_lvalue, r, n, r ) ;
            }
        } else {
            if ( is_templ_type ( t ) ) r = t ;
        }
        if ( IS_NULL_type ( r ) ) {
            /* No virtual function table */
            report ( crt_loc, ERR_expr_typeid_vtable ( op ) ) ;
        }
    }
    return ( r ) ;
}


/*
    THROW A STANDARD EXCEPTION

    This routine returns an expression corresponding to throwing the
    'bad_cast' or 'bad_typeid' types (as indicated by s and pr).  An
    error is reported if this type has not been declared.
*/

static EXP throw_bad_op
    PROTO_N ( ( s, pr ) )
    PROTO_T ( CONST char *s X TYPE *pr )
{
    EXP e ;
    TYPE r = *pr ;
    if ( IS_NULL_type ( r ) ) {
        r = find_std_type ( s, 1, 1 ) ;
        if ( IS_NULL_type ( r ) ) return ( NULL_exp ) ;
        *pr = r ;
    }
    e = make_func_cast_exp ( r, NULL_list ( EXP ) ) ;
    e = make_throw_exp ( e, 0 ) ;
    return ( e ) ;
}


/*
    FIND A TYPEID ARGUMENT

    This routine simplifies the typeid argument expression a according to
    the rule 'p [i]' -> '*p'.  Unfortunately '*( p + i )' which is otherwise
    identical to 'p [i]' is not treated in the same manner.  The result
    is the address of a.
*/

static EXP typeid_arg
    PROTO_N ( ( op, a ) )
    PROTO_T ( int op X EXP a )
{
    while ( IS_exp_paren ( a ) ) {
        /* Remove any brackets */
        a = DEREF_exp ( exp_paren_arg ( a ) ) ;
    }
    if ( IS_exp_indir ( a ) ) {
        int i = DEREF_int ( exp_indir_index ( a ) ) ;
        a = DEREF_exp ( exp_indir_ptr ( a ) ) ;
        if ( i && IS_exp_add_ptr ( a ) ) {
            OFFSET off = DEREF_off ( exp_add_ptr_off ( a ) ) ;
            if ( !is_const_offset ( off, 2, 0 ) ) {
                report ( crt_loc, ERR_expr_typeid_index ( op ) ) ;
            }
            a = DEREF_exp ( exp_add_ptr_ptr ( a ) ) ;
        }
    } else {
        TYPE t = DEREF_type ( exp_type ( a ) ) ;
        MAKE_type_ptr ( cv_none, t, t ) ;
        MAKE_exp_address ( t, a, a ) ;
    }
    return ( a ) ;
}


/*
    CONSTRUCT A TYPEID EXPRESSION

    This routine constructs the type identification expression 'op ( a )'
    for an expression a.  n gives the number of side effects in a.  Note
    that suppress_usage is true during the evaluation of a and in this
    routine.  If it turns out that the expression is used (because it is
    an lvalue of polymorphic type) then mark_used needs to be called
    to mark any variable uses which have been missed.
*/

EXP make_typeid_exp
    PROTO_N ( ( op, a, n ) )
    PROTO_T ( int op X EXP a X int n )
{
    EXP e ;
    TYPE t ;
    CV_SPEC cv ;
    a = convert_reference ( a, REF_NORMAL ) ;
    a = convert_none ( a ) ;
    a = convert_bitfield ( a ) ;
    t = DEREF_type ( exp_type ( a ) ) ;
    if ( is_templ_type ( t ) ) {
        /* Allow for template types */
        TYPE r = get_type_info ( op, t, 1 ) ;
        MAKE_exp_op ( r, op, a, NULL_exp, e ) ;
        return ( e ) ;
    }
    cv = DEREF_cv ( type_qual ( t ) ) ;
    if ( ( cv & cv_lvalue ) && IS_type_compound ( t ) ) {
        CLASS_TYPE ct = DEREF_ctype ( type_compound_defn ( t ) ) ;
        CLASS_INFO ci = DEREF_cinfo ( ctype_info ( ct ) ) ;
        if ( ci & cinfo_polymorphic ) {
            /* lvalue of polymorphic type */
            TYPE r = get_type_info ( op, t, 1 ) ;
            int use = suppress_usage ;
            if ( use ) suppress_usage-- ;
            a = typeid_arg ( op, a ) ;
            mark_used ( a ) ;
            if ( know_type ( a ) != 1 ) {
                /* Can throw 'bad_typeid' */
                EXP b = throw_bad_op ( "bad_typeid", &type_bad_typeid ) ;
                t = DEREF_type ( exp_type ( a ) ) ;
                MAKE_exp_dummy ( t, a, LINK_NONE, NULL_off, 1, a ) ;
                MAKE_exp_rtti ( r, a, b, op, e ) ;
                suppress_usage = use ;
                return ( e ) ;
            }
            suppress_usage = use ;
        }
    }
    if ( n ) report ( crt_loc, ERR_expr_typeid_side ( op ) ) ;
    free_exp ( a, 2 ) ;
    e = make_typeid_type ( op, t, 0 ) ;
    return ( e ) ;
}


/*
    CONSTRUCT A TYPEID TYPE EXPRESSION

    This routine constructs the type identification expression 'op ( t )'
    for a type t.  The argument n gives the number of types defined in t.
*/

EXP make_typeid_type
    PROTO_N ( ( op, t, n ) )
    PROTO_T ( int op X TYPE t X int n )
{
    EXP e ;
    TYPE r ;
    if ( n ) report ( crt_loc, ERR_expr_typeid_typedef ( op ) ) ;
    if ( IS_type_ref ( t ) ) {
        /* Remove reference component */
        t = DEREF_type ( type_ref_sub ( t ) ) ;
    }
    if ( IS_type_compound ( t ) ) {
        /* Check for incomplete class types */
        ERROR err = check_incomplete ( t ) ;
        if ( !IS_NULL_err ( err ) ) {
            err = concat_error ( err, ERR_expr_typeid_incompl ( op ) ) ;
            report ( crt_loc, err ) ;
        }
    }
    t = qualify_type ( t, cv_none, 0 ) ;
    r = get_type_info ( op, t, 1 ) ;
    MAKE_exp_rtti_type ( r, t, op, e ) ;
    return ( e ) ;
}


/*
    CONSTRUCT A TEMPLATE DEPENDENT DYNAMIC CAST EXPRESSION

    This routine constructs a template dependent dynamic cast of the
    expression a to the type t.
*/

static EXP dynamic_cast_templ
    PROTO_N ( ( t, a ) )
    PROTO_T ( TYPE t X EXP a )
{
    EXP e ;
    MAKE_exp_op ( t, lex_dynamic_Hcast, a, NULL_exp, e ) ;
    return ( e ) ;
}


/*
    CONSTRUCT A DYNAMIC CAST EXPRESSION

    This routine constructs the expression 'dynamic_cast < t > ( a )'.
    The argument n gives the number of types defined in t.
*/

EXP make_dynamic_cast_exp
    PROTO_N ( ( t, a, n ) )
    PROTO_T ( TYPE t X EXP a X int n )
{
    TYPE s ;
    CV_SPEC cv ;
    int ok = 1 ;
    int ptr = 0 ;
    unsigned qual ;
    EXP e = NULL_exp ;
    TYPE p = NULL_type ;
    ERROR err = NULL_err ;
    CLASS_TYPE ct = NULL_ctype ;
    CLASS_TYPE cs = NULL_ctype ;

    /* Can't define types */
    if ( n ) report ( crt_loc, ERR_expr_cast_dynam_typedef () ) ;

    /* Do reference conversion */
    a = convert_reference ( a, REF_NORMAL ) ;
    s = DEREF_type ( exp_type ( a ) ) ;
    cv = DEREF_cv ( type_qual ( s ) ) ;

    /* Check target type */
    if ( IS_type_token ( t ) ) {
        if ( is_templ_type ( t ) ) {
            e = dynamic_cast_templ ( t, a ) ;
            return ( e ) ;
        }
        t = expand_type ( t, 1 ) ;
    }
    if ( IS_type_ptr ( t ) ) {
        /* Pointer types */
        p = DEREF_type ( type_ptr_sub ( t ) ) ;
        if ( IS_type_token ( p ) ) {
            if ( is_templ_type ( p ) ) {
                e = dynamic_cast_templ ( t, a ) ;
                return ( e ) ;
            }
            p = expand_type ( p, 1 ) ;
        }
        if ( IS_type_top_etc ( p ) ) {
            /* 'void *' allowed */
            ptr = 2 ;
        } else if ( IS_type_compound ( p ) ) {
            ct = DEREF_ctype ( type_compound_defn ( p ) ) ;
            err = check_incomplete ( p ) ;
            if ( !IS_NULL_err ( err ) ) ok = 0 ;
            ptr = 1 ;
        } else {
            ok = 0 ;
        }
    } else if ( IS_type_ref ( t ) ) {
        p = DEREF_type ( type_ref_sub ( t ) ) ;
        if ( IS_type_token ( p ) ) {
            if ( is_templ_type ( p ) ) {
                e = dynamic_cast_templ ( t, a ) ;
                return ( e ) ;
            }
            p = expand_type ( p, 1 ) ;
        }
        if ( IS_type_compound ( p ) ) {
            ct = DEREF_ctype ( type_compound_defn ( p ) ) ;
            err = check_incomplete ( p ) ;
            if ( !IS_NULL_err ( err ) ) ok = 0 ;
        } else {
            ok = 0 ;
        }
    } else {
        ok = 0 ;
    }
    if ( !ok ) {
        /* Invalid target type */
        IGNORE convert_lvalue ( e ) ;
        err = concat_error ( err, ERR_expr_cast_dynam_type ( t ) ) ;
        report ( crt_loc, err ) ;
        e = make_error_exp ( 0 ) ;
        return ( e ) ;
    }

    /* Check operand type */
    if ( is_templ_type ( s ) ) {
        e = dynamic_cast_templ ( t, a ) ;
        return ( e ) ;
    }
    if ( ptr ) {
        if ( cv & cv_lvalue ) {
            a = convert_lvalue ( a ) ;
        }
        if ( IS_type_token ( s ) ) {
            s = expand_type ( s, 1 ) ;
        }
        if ( IS_type_ptr ( s ) ) {
            /* Argument must be a pointer */
            TYPE q = DEREF_type ( type_ptr_sub ( s ) ) ;
            if ( IS_type_token ( q ) ) {
                if ( is_templ_type ( q ) ) {
                    e = dynamic_cast_templ ( t, a ) ;
                    return ( e ) ;
                }
                q = expand_type ( q, 1 ) ;
            }
            if ( IS_type_compound ( q ) ) {
                cs = DEREF_ctype ( type_compound_defn ( q ) ) ;
                err = check_incomplete ( q ) ;
                if ( !IS_NULL_err ( err ) ) ok = 0 ;
            } else {
                ok = 0 ;
            }
        } else {
            ok = 0 ;
        }
        if ( !ok ) {
            err = concat_error ( err, ERR_expr_cast_dynam_ptr ( s ) ) ;
            report ( crt_loc, err ) ;
            e = make_error_exp ( 0 ) ;
            return ( e ) ;
        }
    } else {
        /* Reference types */
        if ( cv & cv_lvalue ) {
            /* Argument must be an lvalue */
            if ( IS_type_token ( s ) ) {
                s = expand_type ( s, 1 ) ;
            }
            if ( IS_type_compound ( s ) ) {
                cs = DEREF_ctype ( type_compound_defn ( s ) ) ;
                err = check_incomplete ( s ) ;
                if ( !IS_NULL_err ( err ) ) ok = 0 ;
            } else {
                ok = 0 ;
            }
        } else {
            err = ERR_basic_lval_not () ;
            ok = 0 ;
        }
        if ( !ok ) {
            err = concat_error ( err, ERR_expr_cast_dynam_ref ( s ) ) ;
            report ( crt_loc, err ) ;
            e = make_error_exp ( 1 ) ;
            return ( e ) ;
        }

        /* Convert to pointers */
        t = rvalue_type ( p ) ;
        MAKE_type_ptr ( cv_none, t, t ) ;
        s = rvalue_type ( s ) ;
        MAKE_type_ptr ( cv_none, s, s ) ;
        MAKE_exp_address ( s, a, a ) ;
    }

    /* Check for qualification conversions */
    qual = check_qualifier ( t, s, 0 ) ;
    if ( qual == QUAL_OK ) {
        /* Exact match */
        e = a ;
    } else {
        if ( IS_exp_null ( a ) ) {
            /* Null pointer conversion */
            e = make_null_exp ( t ) ;
        } else if ( qual & QUAL_SIMILAR ) {
            /* Qualification conversion */
            MAKE_exp_cast ( t, CONV_QUAL, a, e ) ;
        } else {
            /* Check for base class conversions */
            if ( ptr != 2 ) {
                GRAPH gr = find_base_class ( cs, ct, 1 ) ;
                if ( !IS_NULL_graph ( gr ) ) {
                    /* Base class conversion */
                    OFFSET off ;
                    err = check_ambig_base ( gr ) ;
                    if ( !IS_NULL_err ( err ) ) {
                        ERROR err2 = ERR_conv_ptr_ambiguous () ;
                        err = concat_error ( err, err2 ) ;
                        err2 = ERR_expr_cast_dynam_bad () ;
                        err = concat_error ( err, err2 ) ;
                        report ( crt_loc, err ) ;
                    }
                    check_base_access ( gr ) ;
                    off = DEREF_off ( graph_off ( gr ) ) ;
                    e = make_base_cast ( t, a, off ) ;
                }
            }

            /* Otherwise cs must be polymorphic */
            if ( IS_NULL_exp ( e ) ) {
                CLASS_INFO ci = DEREF_cinfo ( ctype_info ( cs ) ) ;
                if ( ci & cinfo_polymorphic ) {
                    if ( ptr == 2 ) {
                        /* Conversion to 'void *' */
                        MAKE_exp_cast ( t, CONV_PTR_VOID, a, e ) ;
                    } else {
                        /* Dynamic cast */
                        EXP b = NULL_exp ;
                        if ( ptr == 0 ) {
                            /* Can throw 'bad_cast' for references */
                            b = throw_bad_op ( "bad_cast", &type_bad_cast ) ;
                        }
                        MAKE_exp_dummy ( s, a, LINK_NONE, NULL_off, 0, a ) ;
                        MAKE_exp_dyn_cast ( t, a, b, e ) ;
                    }
                } else {
                    err = ERR_expr_cast_dynam_poly ( cs ) ;
                    report ( crt_loc, err ) ;
                    e = make_error_exp ( 0 ) ;
                    return ( e ) ;
                }
            }
        }

        /* Check for casting away const-ness */
        if ( qual != QUAL_OK ) {
            err = NULL_err ;
            cast_away_const ( qual, &err, CAST_DYNAMIC ) ;
            if ( !IS_NULL_err ( err ) ) {
                err = concat_error ( err, ERR_expr_cast_dynam_bad () ) ;
                report ( crt_loc, err ) ;
            }
        }
    }
    if ( ptr == 0 ) {
        /* Take indirection for references */
        MAKE_exp_indir ( p, e, e ) ;
    }
    return ( e ) ;
}


#endif /* LANGUAGE_CPP */