-- Waldek Hebisch hebisch@math.uni.wroc.pl or hebisch@hera.math.uni.wroc.pl diff -u gpc-20021111/p/Make-lang.in gpc-20021111-my/p/Make-lang.in --- gpc-20021111/p/Make-lang.in Sat Nov 9 07:53:24 2002 +++ gpc-20021111-my/p/Make-lang.in Sun Nov 17 15:54:54 2002 @@ -525,7 +525,7 @@ $(srcdir)/p/parse.h: $(srcdir)/p/parse.c $(srcdir)/p/parse.c: $(srcdir)/p/parse.y - cd $(srcdir)/p && $(BISON) $(BISONFLAGS) -d -o parse.c parse.y + cd $(srcdir)/p && $(BISON) $(BISONFLAGS) -p pascal_ -d -o parse.c parse.y $(srcdir)/p/pexp.c: $(srcdir)/p/pexp.y cd $(srcdir)/p && $(BISON) $(BISONFLAGS) -o pexp.c pexp.y diff -u gpc-20021111/p/gpc-decl.c gpc-20021111-my/p/gpc-decl.c --- gpc-20021111/p/gpc-decl.c Mon Nov 11 05:25:24 2002 +++ gpc-20021111-my/p/gpc-decl.c Tue Nov 19 02:40:09 2002 @@ -2925,14 +2925,14 @@ /* If this decl is `static' and an `extern' was seen previously, that is erroneous. */ - if (TREE_PUBLIC (name) + if (TREE_PUBLIC (name) && (!t || TREE_CODE (t) == FUNCTION_DECL) && !TREE_PUBLIC (x) && !DECL_EXTERNAL (x)) { /* Okay to redeclare an ANSI built-in as static. */ - if (t && DECL_BUILT_IN (t)) + if (t && TREE_CODE (t) == FUNCTION_DECL && DECL_BUILT_IN (t)) ; /* Okay to declare a non-ANSI built-in as anything. */ - else if (t && DECL_BUILT_IN_NONANSI (t)) + else if (t && TREE_CODE (t) == FUNCTION_DECL && DECL_BUILT_IN_NONANSI (t)) ; /* Okay to have global type decl after an earlier extern declaration inside a lexical block. */ @@ -3792,6 +3792,8 @@ build_common_tree_nodes_2 (0); /* These are needed for WCHAR_TYPE and perhaps more. */ + pushdecl (build_decl (TYPE_DECL, GET_IDENTIFIER ("char"), + char_type_node)); pushdecl (build_decl (TYPE_DECL, GET_IDENTIFIER ("byte int"), byte_integer_type_node)); pushdecl (build_decl (TYPE_DECL, GET_IDENTIFIER ("byte unsigned int"), @@ -8580,7 +8582,12 @@ build_unary_op (ADDR_EXPR, element, 0))); parent = build_indirect_ref (rec_addr, "`with'"); } - shadow_one_level (parent, TYPE_FIELDS (TREE_TYPE (parent)), structors); + { + tree fieldlist = chainon ( + copy_list (TYPE_FIELDS (TREE_TYPE (parent))), + TYPE_METHODS (TREE_TYPE (parent))); + shadow_one_level (parent, fieldlist, structors); + } return 1; default: error ("`with' element must be of record, schema, or object type"); diff -u gpc-20021111/p/gpc-lex.c gpc-20021111-my/p/gpc-lex.c --- gpc-20021111/p/gpc-lex.c Sat Nov 9 04:48:09 2002 +++ gpc-20021111-my/p/gpc-lex.c Sun Nov 17 04:42:08 2002 @@ -24,6 +24,15 @@ Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +#define yyparse pascal_parse +#define yylex pascal_lex +#define yyerror pascal_error +#define yylval pascal_lval +#define yychar pascal_char +#define yydebug pascal_debug +#define yynerrs pascal_nerrs + + #include "gpc.h" #ifdef MULTIBYTE_CHARS diff -u gpc-20021111/p/gpc-typeck.c gpc-20021111-my/p/gpc-typeck.c --- gpc-20021111/p/gpc-typeck.c Sun Nov 10 08:59:01 2002 +++ gpc-20021111-my/p/gpc-typeck.c Fri Nov 15 04:54:26 2002 @@ -68,7 +68,9 @@ static int type_lists_compatible_p PARAMS ((tree, tree)); static tree c_size_in_bytes PARAMS ((tree)); static tree decl_constant_value PARAMS ((tree)); +#if 0 static tree lookup_field PARAMS ((tree, tree, tree *)); +#endif static tree convert_arguments PARAMS ((tree, tree, tree, tree)); static int is_discriminant_of PARAMS ((tree, tree)); static tree fold_b PARAMS ((tree)); @@ -356,6 +358,7 @@ TREE_VALUE (n) = TREE_VALUE (p1); goto parm_done; +#if 0 /* @@@ Only needed in C? */ /* Given wait (union {union wait *u; int *i} *) and wait (union wait *), @@ -389,6 +392,7 @@ } } TREE_VALUE (n) = common_type (TREE_VALUE (p1), TREE_VALUE (p2)); +#endif parm_done: ; } @@ -1181,6 +1185,7 @@ return exp; } +#if 0 /* Look up component name in the structure type definition. If this component name is found indirectly within an anonymous union, store in *INDIRECT the component which directly contains @@ -1281,6 +1286,8 @@ return field; } +#endif + /* Convert ARRAY_TYPE to POINTER_TYPE. This code is equivalent to the code for C-arrays in default_conversion () above. */ tree @@ -1372,7 +1379,10 @@ if (form == RECORD_TYPE || form == UNION_TYPE) { - for (field = TYPE_FIELDS (basetype); field; field = TREE_CHAIN (field)) + tree ftab[2] = { TYPE_FIELDS (basetype), TYPE_METHODS (basetype)}; + int iteration; + for (iteration=0; iteration<2; iteration++) + for (field = ftab[iteration]; field; field = TREE_CHAIN (field)) { if (DECL_NAME (field) == component) return build_tree_list (NULL_TREE, field); diff -u gpc-20021111/p/gpc.h gpc-20021111-my/p/gpc.h --- gpc-20021111/p/gpc.h Wed Nov 6 06:51:56 2002 +++ gpc-20021111-my/p/gpc.h Sun Nov 17 05:06:02 2002 @@ -1360,6 +1360,7 @@ /* parse.y */ +extern int pascal_parse PARAMS ((void)); extern void set_yydebug PARAMS ((int)); #ifdef EGCS97 diff -u gpc-20021111/p/lang.c gpc-20021111-my/p/lang.c --- gpc-20021111/p/lang.c Sat Nov 9 09:40:54 2002 +++ gpc-20021111-my/p/lang.c Tue Nov 19 14:59:41 2002 @@ -224,7 +224,6 @@ #ifdef EGCS97 init_decl_processing (); - pascal_init (); filename = init_parse (filename); #endif @@ -297,6 +296,16 @@ return filename; #endif } + +int +yyparse() +{ +#ifdef EGCS97 + pascal_init (); +#endif + return pascal_parse(); +} + #ifndef EGCS97 extern void lang_finish PARAMS ((void)); diff -u gpc-20021111/p/objects.c gpc-20021111-my/p/objects.c --- gpc-20021111/p/objects.c Wed Nov 6 03:40:23 2002 +++ gpc-20021111-my/p/objects.c Sat Nov 16 02:56:30 2002 @@ -23,6 +23,8 @@ #include "gpc.h" +static void setup_object_fields_and_methods PARAMS((tree, tree)); + /* Get a FIELD_DECL node of structured type OBJ. This is only applied for structures with no variant part, so it is much simpler than find_field(). */ @@ -35,6 +37,11 @@ tree field = TYPE_FIELDS (obj); while (field && DECL_NAME (field) != name) field = TREE_CHAIN (field); + if (field) + return field; + field = TYPE_METHODS (obj); + while (field && DECL_NAME (field) != name) + field = TREE_CHAIN (field); if (!field && errmsg) error (errmsg, IDENTIFIER_POINTER (name)); return field; @@ -170,6 +177,33 @@ return vmt; } +static void +setup_object_fields_and_methods (type, fields) + tree type, fields; +{ + tree * dp = &(TYPE_FIELDS (type)), + * mp = &(TYPE_METHODS (type)); + tree cp = fields; + *mp = NULL_TREE; + *dp = NULL_TREE; + while (cp) + { + tree ncp = TREE_CHAIN (cp); + TREE_CHAIN (cp) = NULL_TREE; + if (TREE_CODE (cp) == FUNCTION_DECL) + { + *mp = cp; + mp = &(TREE_CHAIN (cp)); + } + else + { + *dp = cp; + dp = &(TREE_CHAIN (cp)); + } + cp = ncp; + } +} + tree build_object_type (parent, fields, abstract) tree parent, fields; @@ -199,6 +233,7 @@ TYPE_LANG_SPECIFIC (type) = allocate_type_lang_specific (); TYPE_LANG_CODE (type) = PASCAL_LANG_OBJECT; TYPE_LANG_OBJECT_NAME (type) = type_name; + TYPE_NAME (type) = type_name; TYPE_LANG_BASE (type) = NULL_TREE; /* base type */ if (parent) @@ -213,8 +248,11 @@ else { /* Method inheritance. */ - tree dest_fields = TYPE_FIELDS (type); - tree parent_fields = copy_list (TYPE_FIELDS (TREE_TYPE (parent_decl))); + tree dest_fields = chainon (TYPE_FIELDS (type), + TYPE_METHODS(type)); + tree parent_fields = chainon ( + copy_list (TYPE_FIELDS (TREE_TYPE (parent_decl))), + copy_list (TYPE_METHODS(TREE_TYPE (parent_decl)))); tree *df, *pf, t; for (pf = &parent_fields; *pf; pf = &TREE_CHAIN (*pf)) { @@ -252,7 +290,8 @@ } } } - TYPE_FIELDS (type) = chainon (parent_fields, dest_fields); + setup_object_fields_and_methods (type, + chainon (parent_fields, dest_fields)); TYPE_SIZE (type) = NULL_TREE; #ifdef EGCS TYPE_SIZE_UNIT (type) = NULL_TREE; @@ -271,6 +310,9 @@ vmt_field = build_decl (FIELD_DECL, get_identifier ("vmt"), vmt_pointer_type); TYPE_FIELDS (type) = chainon (vmt_field, TYPE_FIELDS (type)); + setup_object_fields_and_methods (type, + chainon (TYPE_FIELDS (type), + TYPE_METHODS (type))); TYPE_SIZE (type) = NULL_TREE; #ifdef EGCS TYPE_SIZE_UNIT (type) = NULL_TREE; @@ -282,22 +324,21 @@ /* Check whether the formal parameters of the method conflict with fields of the object. @@ This could be done faster if the fields of the object are sorted. */ - for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field)) - if (TREE_CODE (field) == FUNCTION_DECL - && DECL_CONTEXT (field) == type) /* do not check inherited methods */ + for (field = TYPE_METHODS (type); field; field = TREE_CHAIN (field)) + if (DECL_CONTEXT (field) == type) /* do not check inherited methods */ for (parm = DECL_LANG_PARMS (field); parm; parm = TREE_CHAIN (parm)) - for (field2 = TYPE_FIELDS (type); field2; field2 = TREE_CHAIN (field2)) - if (DECL_NAME (parm) == DECL_NAME (field2)) - { - if (TREE_CODE (field2) == FUNCTION_DECL) + { + for (field2 = TYPE_METHODS (type); field2; field2 = TREE_CHAIN (field2)) + if (DECL_NAME (parm) == DECL_NAME (field2)) error ("formal parameter `%s' of method `%s' conflicts with object method", IDENTIFIER_POINTER (DECL_NAME (parm)), IDENTIFIER_POINTER (DECL_NAME (field))); - else + for (field2 = TYPE_FIELDS (type); field2; field2 = TREE_CHAIN (field2)) + if (DECL_NAME (parm) == DECL_NAME (field2)) error ("formal parameter `%s' of method `%s' conflicts with object field", IDENTIFIER_POINTER (DECL_NAME (parm)), IDENTIFIER_POINTER (DECL_NAME (field))); - } + } /* If abstract is set or any abstract method is found, set TYPE_LANG_CODE (dest) to PASCAL_LANG_ABSTRACT_OBJECT. @@ -309,7 +350,7 @@ /* Create a record type for the VMT. The fields will contain pointers to all virtual methods. */ vmt_entry = copy_list (gpc_fields_PObjectType); - for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field)) + for (field = TYPE_METHODS (type); field; field = TREE_CHAIN (field)) if (TREE_CODE (field) == FUNCTION_DECL && PASCAL_VIRTUAL_METHOD (field)) { /* The real type of this pointer is not needed for type checking @@ -349,7 +390,11 @@ vmt_entry = chainon (vmt_entry, build_tree_list (NULL_TREE, field)); /* Methods */ - for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field)) + { + tree ftab[2] = {TYPE_FIELDS (type), TYPE_METHODS (type)}; + int iteration; + for(iteration = 0; iteration<2 ; iteration++) + for (field = ftab[iteration]; field; field = TREE_CHAIN (field)) if (TREE_CODE (field) == FUNCTION_DECL && PASCAL_VIRTUAL_METHOD (field)) { @@ -383,6 +428,7 @@ method = build_unary_op (ADDR_EXPR, method, 0); vmt_entry = chainon (vmt_entry, build_tree_list (NULL_TREE, method)); } + } if (TYPE_LANG_CODE (type) == PASCAL_LANG_ABSTRACT_OBJECT) { diff -u gpc-20021111/p/parse.c gpc-20021111-my/p/parse.c --- gpc-20021111/p/parse.c Sun Nov 10 10:46:02 2002 +++ gpc-20021111-my/p/parse.c Tue Nov 19 15:04:39 2002 @@ -4,6 +4,13 @@ #define YYBISON 1 /* Identify Bison output. */ +#define yyparse pascal_parse +#define yylex pascal_lex +#define yyerror pascal_error +#define yylval pascal_lval +#define yychar pascal_char +#define yydebug pascal_debug +#define yynerrs pascal_nerrs #define prec_if 257 #define LEX_ELSE 258 #define lower_than_error 259 diff -u gpc-20021111/p/parse.h gpc-20021111-my/p/parse.h --- gpc-20021111/p/parse.h Sun Nov 10 10:46:02 2002 +++ gpc-20021111-my/p/parse.h Tue Nov 19 15:04:39 2002 @@ -353,4 +353,4 @@ #define gpc_CASE_ERROR 601 -extern YYSTYPE yylval; +extern YYSTYPE pascal_lval; diff -u gpc-20021111/p/util.c gpc-20021111-my/p/util.c --- gpc-20021111/p/util.c Sun Nov 10 13:37:08 2002 +++ gpc-20021111-my/p/util.c Sat Nov 16 12:50:25 2002 @@ -2317,6 +2317,8 @@ return NULL_TREE; decl = build_decl (code, id, type ? type : integer_type_node /* @@ why? */); PASCAL_REDEFINABLE_DECL (decl) = 1; + if (code == VAR_DECL) + TREE_PUBLIC (decl) = 1; if (value) DECL_INITIAL (decl) = build_int_2 (value, 0); pushdecl (decl);