diff -u -r gcc-2.95.orig/gcc/c-decl.c gcc-2.95/gcc/c-decl.c --- gcc-2.95.orig/gcc/c-decl.c Fri Oct 1 14:34:10 1999 +++ gcc-2.95/gcc/c-decl.c Mon Oct 4 23:22:35 1999 @@ -591,6 +591,14 @@ int warn_multichar = 1; +/* enable cplusplus features */ + +int flag_cplusplus = 0; /* enables base-inclusion here */ + +/* enable submorph specialty */ + +int flag_submorph = 0; + /* Nonzero means `$' can be in an identifier. */ #ifndef DOLLARS_IN_IDENTIFIERS @@ -692,10 +700,33 @@ flag_no_asm = 0; flag_no_nonansi_builtin = 0; flag_isoc9x = 1; + flag_cplusplus = 1; /*enables inclusion syntax*/ + } + else if (!strcmp (argstart, "submorph")) + { + flag_traditional = 0; + flag_writable_strings = 0; + flag_no_asm = 0; + flag_no_nonansi_builtin = 0; + flag_isoc9x = 1; + flag_cplusplus = 1; /*enables inclusion syntax*/ + flag_submorph = 1; /*and submorph feature*/ + } + else if (!strcmp (argstart, "submorph+")) + { + flag_traditional = 0; + flag_writable_strings = 0; + flag_no_asm = 0; + flag_no_nonansi_builtin = 0; + flag_isoc9x = 1; + flag_cplusplus = 1; /*enables inclusion syntax*/ + flag_submorph = 2; /*and submorph that does not watch for names*/ } else error ("unknown C standard `%s'", argstart); } + else if (!strcmp (p, "-fsubmorph")) + flag_submorph = 1; else if (!strcmp (p, "-fdollars-in-identifiers")) dollars_in_ident = 1; else if (!strcmp (p, "-fno-dollars-in-identifiers")) @@ -6139,6 +6170,149 @@ return t; } + +char* +get_decl_name (decl) + tree decl; +{ + /* Look inside a declarator for the name being declared + and get it as a string, for an error message. */ + char class; + tree node = decl; + + if (!node) + return "((none))"; + + while (TREE_CODE (node) == ARRAY_REF + || TREE_CODE (node) == INDIRECT_REF + || TREE_CODE (node) == CALL_EXPR ) + { + node = TREE_OPERAND (node, 0); + } + + while (TREE_CODE (node) == POINTER_TYPE) + { + node = TREE_TYPE (node); + } + + if (TREE_CODE (node) == IDENTIFIER_NODE) + return (IDENTIFIER_POINTER (node)); + + class = TREE_CODE_CLASS (TREE_CODE (node)); + + if (DECL_NAME (node) && TREE_CODE(DECL_NAME(node)) == IDENTIFIER_NODE) + return (IDENTIFIER_POINTER (DECL_NAME (node))); + + if (TYPE_NAME (node)) + { + if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE) + return (IDENTIFIER_POINTER (TYPE_NAME (node))); + else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL + && DECL_NAME (TYPE_NAME (node)) + && TREE_CODE(DECL_NAME(TYPE_NAME(node))) == IDENTIFIER_NODE ) + return (IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (node)))); + } + + return "((unknown))"; +} + +/* Puts markers that help the finish part to identify the base class, + emit some warnings/errors right here before scanning the struct definition */ +tree +start_struct_with_base (code, name, base) + enum tree_code code; + tree name; + tree base; +{ + register tree t; + + if (!flag_cplusplus) + { + error ("base type inclusion is disabled (in declaration of `%s')", + IDENTIFIER_POINTER(name)); + return start_struct (code, name); + } + + if (!in_system_header && warn_long_long) /* it is ON by default */ + { + warning ("base type inclusion used to declare `%s'", IDENTIFIER_POINTER(name)); + } + + t = lookup_tag (code, base, current_binding_level, 0); + if (!t) + { + error ("unknown base type `%s' (in declaration of `%s')", + IDENTIFIER_POINTER (base), IDENTIFIER_POINTER (name)); + return start_struct (code, name); + } + else if (TREE_CODE (t) != code) + { + error ("base type `%s' is no struct (in declaration of `%s')", + IDENTIFIER_POINTER (base), IDENTIFIER_POINTER (name)); + pending_xref_error (); + return start_struct (code, name); + } + else + base = t; + + if (TYPE_SIZE (base) == 0) + { + error ("base type `%s' has incomplete type (in declaration of `%s')", + get_decl_name(base), IDENTIFIER_POINTER (name)); + } + if (C_DECL_VARIABLE_SIZE (base)) + { + warning ("base type `%s' has variable size (in declaration of `%s')", + get_decl_name(base), IDENTIFIER_POINTER (name)); + } + + /* atlast, do the real stuff */ + t = start_struct (code, name); + TYPE_CONTEXT(t) = base; /* this is where other backends would put it too*/ + return t; +} + +/* concatenate the base's fields and the parsed fieldlist, + then simply call finish_struct - that's a simple way + to arrive at an inclusion that makes for a derived struct + ... simple, purposeful, efficient, and very german ;-) -gud */ +tree +finish_struct_with_base (t, fieldlist, attributes) + tree t; + tree fieldlist; + tree attributes; +{ + register tree context; + register tree fields; + + if (!flag_cplusplus) + { + return finish_struct (t, fieldlist, attributes); + } + + if (t && TYPE_CONTEXT (t) && TYPE_FIELDS (TYPE_CONTEXT (t))) + { + fields = copy_list (TYPE_FIELDS (TYPE_CONTEXT (t))); + fields = chainon (fields, fieldlist); +#if 0 + /* merge the attributes of the baseclass into the current class ?? how ?? (this is wrong)*/ + attributes = merge_attributes (TYPE_ATTRIBUTES(TYPE_CONTEXT(t)), attributes); +#endif + } + else + { + warning ("base type inclusion failed for `%s'", get_decl_name (t)); + fields = fieldlist; + } + + /* the relay to the older plain defining function can make for non-obvious messages */ + /* we should copy and adapt the finish_struct code to suit the needs + of base type inclusion, emitting more distinctive diagnostics + (esp: "duplicate member name" where one came from a base type) -gud */ + + return finish_struct (t, fields, attributes); +} + /* Lay out the type T, and its element type, and so on. */ diff -u -r gcc-2.95.orig/gcc/c-parse.in gcc-2.95/gcc/c-parse.in --- gcc-2.95.orig/gcc/c-parse.in Fri Oct 1 14:34:10 1999 +++ gcc-2.95/gcc/c-parse.in Mon Oct 4 23:22:35 1999 @@ -1501,9 +1501,20 @@ } component_decl_list '}' maybe_attribute { $$ = finish_struct ($4, $5, chainon ($1, $7)); } + | struct_head identifier ':' identifier '{' + { $$ = start_struct_with_base (RECORD_TYPE, $2, $4); + /* Start scope of tag before parsing components. */ + } + component_decl_list '}' maybe_attribute + { $$ = finish_struct_with_base ($6, $7, chainon ($1, $9)); } | struct_head '{' component_decl_list '}' maybe_attribute { $$ = finish_struct (start_struct (RECORD_TYPE, NULL_TREE), $3, chainon ($1, $5)); + } + | struct_head ':' identifier '{' component_decl_list '}' maybe_attribute + { $$ = finish_struct_with_base ( + start_struct_with_base (RECORD_TYPE, NULL_TREE, $3), + $5, chainon ($1, $7)); } | struct_head identifier { $$ = xref_tag (RECORD_TYPE, $2); } diff -u -r gcc-2.95.orig/gcc/c-parse.y gcc-2.95/gcc/c-parse.y --- gcc-2.95.orig/gcc/c-parse.y Fri Oct 1 14:34:10 1999 +++ gcc-2.95/gcc/c-parse.y Mon Oct 4 23:22:36 1999 @@ -1326,9 +1326,20 @@ } component_decl_list '}' maybe_attribute { $$ = finish_struct ($4, $5, chainon ($1, $7)); } + | struct_head identifier ':' identifier '{' + { $$ = start_struct_with_base (RECORD_TYPE, $2, $4); + /* Start scope of tag before parsing components. */ + } + component_decl_list '}' maybe_attribute + { $$ = finish_struct_with_base ($6, $7, chainon ($1, $9)); } | struct_head '{' component_decl_list '}' maybe_attribute { $$ = finish_struct (start_struct (RECORD_TYPE, NULL_TREE), $3, chainon ($1, $5)); + } + | struct_head ':' identifier '{' component_decl_list '}' maybe_attribute + { $$ = finish_struct_with_base ( + start_struct_with_base (RECORD_TYPE, NULL_TREE, $3), + $5, chainon ($1, $7)); } | struct_head identifier { $$ = xref_tag (RECORD_TYPE, $2); } diff -u -r gcc-2.95.orig/gcc/c-tree.h gcc-2.95/gcc/c-tree.h --- gcc-2.95.orig/gcc/c-tree.h Fri Oct 1 14:34:10 1999 +++ gcc-2.95/gcc/c-tree.h Mon Oct 4 23:22:36 1999 @@ -303,6 +303,7 @@ extern tree finish_enum PROTO((tree, tree, tree)); extern void finish_function PROTO((int)); extern tree finish_struct PROTO((tree, tree, tree)); +extern tree finish_struct_with_base PROTO((tree, tree, tree)); extern tree get_parm_info PROTO((int)); extern tree getdecls PROTO((void)); extern tree gettags PROTO((void)); @@ -347,8 +348,11 @@ extern tree start_decl PROTO((tree, tree, int, tree, tree)); extern tree start_struct PROTO((enum tree_code, tree)); +extern tree start_struct_with_base PROTO((enum tree_code, tree, tree)); extern void store_parm_decls PROTO((void)); extern tree xref_tag PROTO((enum tree_code, tree)); + +extern char* get_decl_name PROTO((tree decl)); /* in c-typeck.c */ extern tree require_complete_type PROTO((tree)); diff -u -r gcc-2.95.orig/gcc/c-typeck.c gcc-2.95/gcc/c-typeck.c --- gcc-2.95.orig/gcc/c-typeck.c Fri Oct 1 14:34:10 1999 +++ gcc-2.95/gcc/c-typeck.c Mon Oct 4 23:22:36 1999 @@ -4017,6 +4017,305 @@ NULL_TREE, NULL_TREE, 0); } + +/* two structures are inclusion-submorph iff + - all simple types of lhs are present in the rhs with the + a) same name + b) same offset + c) same size + d) the qualifiers of lhs's contained type is more or equal restrictive + than the the corresponding rhs contained type that fulfilled a)+b)+c) + - we don't care about record names as long as their simple type members + meet above's condition + - the lhs may be shorter than the rhs struct +*/ + +/* + returns: + return: lhs_tail, if 0 the lhs-tree has been matched, so it is an upmorph atleast + outarg: rhs_tail, if 0 the rhs-tree has been matched completly, + + ie. if rhs_tail-return _and_ lhs_tail-outarg are null + then the structures are isomorph. + if lhs_tail-return is null _and_ rhs_tail is non-null + then the lhs-structure is a upmorph of the rhs-structure + if lhs_tail-return is non-null _and_ rhs_tail is null + then the rhs-structure is *possibly* a upmorph of the lhs-structure + if both lhs_tail and rhs_tail are non-null + then the structure are non-upmorph to each other + ... so checking for if (!tail_submorph(lhs, rhs, &some)) is mostly the thing you want to do... +*/ +extern int flag_submorph; + + /* debugging macro, left here for patch-distribution, use at your option */ +#define notice_lhs_rhs( what, lhs, rhs) \ +{ if (extra_warnings && warn_cast_qual) {\ + notice (what" \tlhs= '%s' <%s %s> rhs= '%s' <%s %s>\n", \ + get_decl_name (lhs), (lhs ? tree_code_name[(int) TREE_CODE(lhs)] : "0"), ((lhs && TREE_TYPE(lhs)) ? tree_code_name[(int) TREE_CODE(TREE_TYPE(lhs))] : "0"), \ + get_decl_name (rhs), (rhs ? tree_code_name[(int) TREE_CODE(rhs)] : "0"), ((rhs && TREE_TYPE(rhs)) ? tree_code_name[(int) TREE_CODE(TREE_TYPE(rhs))] : "0")); \ +} } + +tree +tail_submorph (lhs_, rhs_, tail) + tree lhs_; + tree rhs_; + tree* tail; +{ + register tree lhs = lhs_; + register tree rhs = rhs_; + if (!tail) { + warning ("* internal error: forgot to provide tail-out-arg at tail_submorph function"); + return lhs; + } + + /* check the currents */ + notice_lhs_rhs (" >>>>>> ", lhs, rhs); + + /* if currents are indirections, just go down the indirection + chain till we come to their actual type */ + while (TREE_CODE (lhs) == TREE_CODE (rhs) + && (TREE_CODE (lhs) == POINTER_TYPE + || TREE_CODE (lhs) == ARRAY_REF + || TREE_CODE (lhs) == INDIRECT_REF + || TREE_CODE (lhs) == CALL_EXPR ) + ) + { + // rhs = TREE_OPERAND (rhs, 0); + // lhs = TREE_OPERAND (lhs, 0); + rhs = TREE_TYPE (rhs); + lhs = TREE_TYPE (lhs); + } + + /* if currents happens to be a RECORD_TYPE, then they must be submorph + or we can already fail for the currents */ + if (TREE_CODE (lhs) == TREE_CODE (rhs) + && TREE_CODE (lhs) == RECORD_TYPE) + { + return (tail_submorph (TYPE_FIELDS (lhs), TYPE_FIELDS(rhs), tail)); + /* tail recursion */ + } + + /*if we are at some other field, check each field in turn*/ + while ( (lhs) && (rhs) + && (TREE_CODE(lhs) == FIELD_DECL || TREE_CODE(lhs) == TYPE_DECL) + && (TREE_CODE(rhs) == FIELD_DECL || TREE_CODE(rhs) == TYPE_DECL) + ) { + + notice_lhs_rhs (" check... ", lhs, rhs); + if (TREE_TYPE (lhs) == TREE_TYPE (rhs)) /* identical */ + { + if (TREE_CODE (lhs) == FIELD_DECL && TREE_CODE (rhs) == FIELD_DECL) + { + if (DECL_NAME (lhs) && DECL_NAME (rhs) + && DECL_NAME (lhs) != DECL_NAME (rhs)) + { + if (warn_cast_qual || flag_submorph < 2) + { + warning (" different names for fields `:%s:%s' vs. `:%s:%s'", + lhs_ != lhs ? get_decl_name (lhs_) : "", get_decl_name (lhs), + rhs_ != rhs ? get_decl_name (rhs_) : "", get_decl_name (rhs)); + } + /*no break*/ + } + if (DECL_FIELD_SIZE (lhs) && DECL_FIELD_SIZE (rhs) + && DECL_FIELD_SIZE (lhs) != DECL_FIELD_SIZE (rhs)) + { + warning (" different sizes for fields `:%s:%s' (%i) vs. `:%s:%s' (%i)", + lhs_ != lhs ? get_decl_name (lhs_) : "", get_decl_name (lhs), DECL_FIELD_SIZE(lhs), + rhs_ != rhs ? get_decl_name (rhs_) : "", get_decl_name (rhs), DECL_FIELD_SIZE(rhs)); + break; + } + if (DECL_FIELD_BITPOS (lhs) != DECL_FIELD_BITPOS (rhs) + && TREE_INT_CST_LOW(DECL_FIELD_BITPOS(lhs)) != TREE_INT_CST_LOW(DECL_FIELD_BITPOS(rhs))) + { + warning (" different offsets for fields `:%s:%s' (%i/8) vs. `:%s:%s' (%i/8)", + lhs_ != lhs ? get_decl_name (lhs_) : "", get_decl_name (lhs), TREE_INT_CST_LOW(DECL_FIELD_BITPOS(lhs)), + rhs_ != rhs ? get_decl_name (rhs_) : "", get_decl_name (rhs), TREE_INT_CST_LOW(DECL_FIELD_BITPOS(rhs))); + break; + } + } + + notice_lhs_rhs (" ...ok ", lhs, rhs); + lhs = TREE_CHAIN (lhs), rhs = TREE_CHAIN (rhs); /* next fields */ + continue; + } + + if (TREE_CODE (TREE_TYPE(lhs)) == TREE_CODE (TREE_TYPE(rhs)) + && (TREE_CODE (TREE_TYPE(lhs)) == POINTER_TYPE + || TREE_CODE (TREE_TYPE(lhs)) == ARRAY_REF + || TREE_CODE (TREE_TYPE(lhs)) == INDIRECT_REF + || TREE_CODE (TREE_TYPE(lhs)) == CALL_EXPR ) + ) { + notice_lhs_rhs (" -indirect- ", lhs, rhs); + if (!tail_submorph (TREE_TYPE(lhs), TREE_TYPE(rhs), tail)) + { + lhs = TREE_CHAIN (lhs), rhs = TREE_CHAIN (rhs); + continue; + }else{ + break; + } + } + + if (/*TREE_CODE (TREE_TYPE(lhs)) != RECORD_TYPE &&*/ TREE_CODE(TREE_TYPE(rhs)) == RECORD_TYPE) + { + notice_lhs_rhs (" -rhs-rec- ", lhs, rhs); + lhs = tail_submorph (lhs, TYPE_FIELDS(TREE_TYPE(rhs)), tail); + rhs = (*tail) ? (*tail) : TREE_CHAIN (rhs); + notice_lhs_rhs (" (rhs-rec) ", lhs, rhs); + continue; + } + if (/*TREE_CODE (TREE_TYPE(rhs)) != RECORD_TYPE &&*/ TREE_CODE(TREE_TYPE(lhs)) == RECORD_TYPE) + { + notice_lhs_rhs (" -lhs-rec- ", lhs, rhs); + { register tree x = tail_submorph (TYPE_FIELDS(TREE_TYPE(lhs)), rhs, tail); + lhs = (x) ? (x) : TREE_CHAIN (lhs); + } + rhs = *tail; + notice_lhs_rhs (" (lhs-rec) ", lhs, rhs); + continue; + } + + notice_lhs_rhs (" --none-- ", lhs, rhs); + break; + } /*foreach field*/ + + notice_lhs_rhs (" <<< ", lhs, rhs); + *tail = rhs; + return lhs; +} + +/* a structure is substruct of another iff + - they have the same type + - the type equals (recursivly) some base-type of the other struct + - alternativly, the first record-member instance is also held to be the base-type + if the structure had not been declared with base type inclusion + + the last point makes for a happy living with traditional + C based object-oriented libraries such as GTK -gud + + as an extension, is_substruct may call is_submorph to check if an + assignment would be feasible (as the two struct have similar built) +*/ + +int +is_substruct (lhs_, rhs_) + tree lhs_; + tree rhs_; +{ + register tree lhs = lhs_; + register tree rhs = rhs_; + + /* if currents are indirections, just go down the indirection + chain till we come to their actual type */ + while (TREE_CODE (lhs) == TREE_CODE (rhs) + && (TREE_CODE (lhs) == POINTER_TYPE + || TREE_CODE (lhs) == ARRAY_REF + || TREE_CODE (lhs) == INDIRECT_REF + || TREE_CODE (lhs) == CALL_EXPR ) + ) + { + // rhs = TREE_OPERAND (rhs, 0); + // lhs = TREE_OPERAND (lhs, 0); + rhs = TREE_TYPE (rhs); + lhs = TREE_TYPE (lhs); + } + + /* if currents happen to be a RECORD_TYPEs, they must be derived ones */ + if (TREE_CODE (lhs) == TREE_CODE (rhs) + && TREE_CODE (lhs) == RECORD_TYPE) + { + while (1) + { + if (TREE_TYPE(lhs) && TREE_TYPE(rhs) + && TREE_TYPE(lhs) == TREE_TYPE(rhs)) + { + if (warn_cast_qual) + warning ("upcast ok ('%s' := '%s')", get_decl_name(lhs_), get_decl_name(rhs_)); + return 1; + } + + if (DECL_NAME(lhs) && DECL_NAME(rhs) + && DECL_NAME(lhs) == DECL_NAME(rhs)) + { + if (warn_cast_qual) + warning ("upcast ok (<%s> := <%s>)", get_decl_name(lhs_), get_decl_name(rhs_)); + return 1; + } + + /* type_context is where we put the explicit base-class in */ + if (TYPE_CONTEXT(rhs) + && TREE_CODE(TYPE_CONTEXT(rhs)) == RECORD_TYPE) + { + rhs = TYPE_CONTEXT(rhs); + continue; + } + + /* the first field is a struct? treat as the implicit base-class... */ + if (TYPE_FIELDS(rhs) && TREE_TYPE(TYPE_FIELDS(rhs)) + && TREE_CODE(TREE_TYPE(TYPE_FIELDS(rhs))) == RECORD_TYPE) + { + rhs = TREE_TYPE(TYPE_FIELDS(rhs)); + continue; + } + + /* gone out of base-classes... */ + break; + } + } + + if (TREE_CODE(lhs) == TREE_CODE(rhs) + && (TREE_CODE(lhs) == FUNCTION_DECL + || TREE_CODE(lhs) == FUNCTION_TYPE)) + { + if (warn_cast_qual) + warning ("sorry, cannot match function pointers very well (for upcasts)"); + } + + /* -- no upcast -- */ + + if (warn_cast_qual) + { + if (is_substruct (rhs, lhs)) + { + warning ("downcast! (<%s> := <%s>)", get_decl_name(lhs_), get_decl_name(rhs_)); + return 0; + } + else + { + warning ("NO upcast (<%s> := <%s>)", get_decl_name(lhs_), get_decl_name(rhs_)); + } + } + + if (flag_submorph || warn_cast_qual) + { auto tree tail; + if (!warn_cast_qual) + { + return (!tail_submorph (lhs, rhs, &tail)); + } + else + { + if (!tail_submorph (lhs, rhs, &tail)) + { + if (!tail) { + warning (" isoMORPH ('%s' <=> '%s')", get_decl_name(lhs_), get_decl_name(rhs_)); + }else{ + warning (" subMORPH ('%s' <== '%s')", get_decl_name(lhs_), get_decl_name(rhs_)); + } + return flag_submorph; + }else{ + if (!tail) { + warning (" DOWNcast ('%s' ==> '%s')", get_decl_name(lhs_), get_decl_name(rhs_)); + }else{ + warning (" NONmorph ('%s' >!< '%s')", get_decl_name(lhs_), get_decl_name(rhs_)); + } + return 0; + } + } + } + + return 0; +} + /* Convert value RHS to type TYPE as preparation for an assignment to an lvalue of type TYPE. The real work of conversion is done by `convert'. @@ -4232,8 +4531,14 @@ } } else - warn_for_assignment ("%s from incompatible pointer type", - errtype, funname, parmnum); + { + /* targets don't need to be actually the same, just applicable - + here we look through the list of primary members on the rhs */ + extern int flag_cplusplus; + if (!flag_cplusplus || !is_substruct (ttl, ttr) || pedantic) + warn_for_assignment ("%s from incompatible pointer type", + errtype, funname, parmnum); + } return convert (type, rhs); } else if (codel == POINTER_TYPE && coder == INTEGER_TYPE)