Resend: [RFC] p-exp.y enhancements.

[Pierre Muller <muller@cerbere.u-strasbg.fr>]

[-- Attachment #1: Type: text/plain, Size: 1922 bytes --]

(Second posting with the patch attached,
this way you should have less problems to 
apply the patch).

This patch has several benefits:

1) it adds support for S[exp] if S is a pascal string.
I must admit that this only works for Free Pascal Compiler
  for now, because GPC uses BITSTRING type
for the array containg the chars which confuses GDB.
I informed the GPC developper team, but their answer 
seems to be that they didn't really directly change any code
regarding debug information output for pascal...

2) it adds support for  case insensitive searches of record
(pascal struct) fields.

3) It prepares to a more simple RFC
about the enhancement to the completer for
structure field that I sent some time ago. See
http://sources.redhat.com/ml/gdb-patches/2002-04/msg00774.html

The way current_type is treated in my patch is 
not completely correct, in the sense that 
current_type is often non NULL when it should be NULL
(like for instance after an operator like '+' or '*',
but this has no influence on its functionallity, so I did not
add all the rules that would reset current_type
(which would have made the patch much bigger).

If I get no observations about this patch, I will commit it
in the next days.


2002-05-02  Pierre Muller  <muller@ics.u-strasbg.fr>

	* p-exp.y (current_type): New static variable.
	Carries the type of the expression at the position that is parsed.
	(push_current_type, pop_current_type): Two new functions. Used
	to store/restore current_type in expression on specific tokens.
	(search_filed): New static variable. Set to one after parsing a point as
	at that point only a FIELDNAME token should be searched.
	(FIELDNAME): New token. After a point only a token belonging to 
	current_type type definition is allowed.
	(all over token rules): reset and change current_type according
	to rules.
	(exp '[' rule): insert implicit array index field if exp is a pascal string type.

[-- Attachment #2: p-exp.dif --]
[-- Type: text/plain, Size: 9767 bytes --]

Index: p-exp.y
===================================================================
RCS file: /cvs/src/src/gdb/p-exp.y,v
retrieving revision 1.10
diff -u -p -r1.10 p-exp.y
--- p-exp.y	25 Apr 2002 14:51:29 -0000	1.10
+++ p-exp.y	2 May 2002 12:33:26 -0000
@@ -150,9 +150,15 @@ static char * uptok (char *, int);
 /* YYSTYPE gets defined by %union */
 static int
 parse_number (char *, int, int, YYSTYPE *);
+
+static struct type *current_type;
+
+static void push_current_type ();
+static void pop_current_type ();
+static int search_field;
 %}
 
-%type <voidval> exp exp1 type_exp start variable qualified_name
+%type <voidval> exp exp1 type_exp start normal_start variable qualified_name
 %type <tval> type typebase
 /* %type <bval> block */
 
@@ -170,7 +176,8 @@ parse_number (char *, int, int, YYSTYPE 
    Contexts where this distinction is not important can use the
    nonterminal "name", which matches either NAME or TYPENAME.  */
 
-%token <sval> STRING
+%token <sval> STRING 
+%token <sval> FIELDNAME
 %token <ssym> NAME /* BLOCKNAME defined below to give it higher precedence. */
 %token <tsym> TYPENAME
 %type <sval> name
@@ -219,15 +226,21 @@ parse_number (char *, int, int, YYSTYPE 
 \f
 %%
 
-start   :	exp1
+start   :	{ current_type = NULL;
+		  search_field = 0;
+		}
+		normal_start;
+
+normal_start	:
+		exp1
 	|	type_exp
 	;
 
 type_exp:	type
 			{ write_exp_elt_opcode(OP_TYPE);
 			  write_exp_elt_type($1);
-			  write_exp_elt_opcode(OP_TYPE);}
-	;
+			  write_exp_elt_opcode(OP_TYPE);
+			  current_type = $1; } ;
 
 /* Expressions, including the comma operator.  */
 exp1	:	exp
@@ -237,10 +250,14 @@ exp1	:	exp
 
 /* Expressions, not including the comma operator.  */
 exp	:	exp '^'   %prec UNARY
-			{ write_exp_elt_opcode (UNOP_IND); }
+			{ write_exp_elt_opcode (UNOP_IND);
+			  if (current_type) 
+			    current_type = TYPE_TARGET_TYPE (current_type); }
 
 exp	:	'@' exp    %prec UNARY
-			{ write_exp_elt_opcode (UNOP_ADDR); }
+			{ write_exp_elt_opcode (UNOP_ADDR); 
+			  if (current_type)
+			    current_type = TYPE_POINTER_TYPE (current_type); }
 
 exp	:	'-' exp    %prec UNARY
 			{ write_exp_elt_opcode (UNOP_NEG); }
@@ -258,24 +275,55 @@ exp	:	DECREMENT  '(' exp ')'   %prec UNA
 			{ write_exp_elt_opcode (UNOP_PREDECREMENT); }
 	;
 
-exp	:	exp '.' name
+exp	:	exp '.' { search_field = 1; } 
+		FIELDNAME 
+		/* name */
 			{ write_exp_elt_opcode (STRUCTOP_STRUCT);
-			  write_exp_string ($3);
-			  write_exp_elt_opcode (STRUCTOP_STRUCT); }
-	;
-
-exp	:	exp '[' exp1 ']'
-			{ write_exp_elt_opcode (BINOP_SUBSCRIPT); }
-	;
+			  write_exp_string ($4); 
+			  write_exp_elt_opcode (STRUCTOP_STRUCT);
+			  search_field = 0; 
+			  if (current_type)
+			    { while (TYPE_CODE (current_type) == TYPE_CODE_PTR)
+				current_type = TYPE_TARGET_TYPE (current_type);
+			      current_type = lookup_struct_elt_type (
+				current_type, $4.ptr, false); };
+			 } ; 
+exp	:	exp '['
+			/* We need to save the current_type value */
+			{ char *arrayname; 
+			  int arrayfieldindex;
+			  arrayfieldindex = is_pascal_string_type (
+				current_type, NULL, NULL,
+				NULL, NULL, &arrayname); 
+			  if (arrayfieldindex) 
+			    {
+			      struct stoken stringsval;
+			      stringsval.ptr = alloca (strlen (arrayname) + 1);
+			      stringsval.length = strlen (arrayname);
+			      strcpy (stringsval.ptr, arrayname);
+			      current_type = TYPE_FIELD_TYPE (current_type,
+				arrayfieldindex - 1); 
+			      write_exp_elt_opcode (STRUCTOP_STRUCT);
+			      write_exp_string (stringsval); 
+			      write_exp_elt_opcode (STRUCTOP_STRUCT);
+			    }
+			  push_current_type ();  }
+		exp1 ']'
+			{ pop_current_type ();
+			  write_exp_elt_opcode (BINOP_SUBSCRIPT);
+			  if (current_type)
+			    current_type = TYPE_TARGET_TYPE (current_type); }
 
 exp	:	exp '('
 			/* This is to save the value of arglist_len
 			   being accumulated by an outer function call.  */
-			{ start_arglist (); }
+			{ push_current_type ();
+			  start_arglist (); }
 		arglist ')'	%prec ARROW
 			{ write_exp_elt_opcode (OP_FUNCALL);
 			  write_exp_elt_longcst ((LONGEST) end_arglist ());
-			  write_exp_elt_opcode (OP_FUNCALL); }
+			  write_exp_elt_opcode (OP_FUNCALL); 
+			  pop_current_type (); }
 	;
 
 arglist	:
@@ -288,7 +336,8 @@ arglist	:
 exp	:	type '(' exp ')' %prec UNARY
 			{ write_exp_elt_opcode (UNOP_CAST);
 			  write_exp_elt_type ($1);
-			  write_exp_elt_opcode (UNOP_CAST); }
+			  write_exp_elt_opcode (UNOP_CAST); 
+			  current_type = $1; }
 	;
 
 exp	:	'(' exp1 ')'
@@ -567,9 +616,11 @@ variable:	name_not_typename
 			      write_exp_elt_block (NULL);
 			      write_exp_elt_sym (sym);
 			      write_exp_elt_opcode (OP_VAR_VALUE);
-			    }
+			      current_type = sym->type; }
 			  else if ($1.is_a_field_of_this)
 			    {
+			      struct value * this_val;
+			      struct type * this_type;
 			      /* Object pascal: it hangs off of `this'.  Must
 			         not inadvertently convert from a method call
 				 to data ref.  */
@@ -581,6 +632,18 @@ variable:	name_not_typename
 			      write_exp_elt_opcode (STRUCTOP_PTR);
 			      write_exp_string ($1.stoken);
 			      write_exp_elt_opcode (STRUCTOP_PTR);
+			      /* we need type of this */
+			      this_val = value_of_this (0); 
+			      if (this_val)
+				this_type = this_val->type;
+			      else
+				this_type = NULL;
+			      if (this_type)
+				current_type = lookup_struct_elt_type (
+				  this_type,
+				  $1.stoken.ptr, false);
+			      else
+				current_type = NULL; 
 			    }
 			  else
 			    {
@@ -881,6 +944,36 @@ parse_number (p, len, parsed_float, puti
    return INT;
 }
 
+
+struct type_push
+{
+  struct type *stored;
+  struct type_push *next;
+};
+
+static struct type_push *tp_top = NULL;
+
+static void push_current_type ()
+{
+  struct type_push *tpnew;
+  tpnew = (struct type_push *) malloc (sizeof (struct type_push));
+  tpnew->next = tp_top;
+  tpnew->stored = current_type;
+  current_type = NULL;
+  tp_top = tpnew; 
+}
+
+static void pop_current_type ()
+{
+  struct type_push *tp = tp_top;
+  if (tp)
+    {
+      current_type = tp->stored;
+      tp_top = tp->next;
+      xfree (tp);
+    }
+}
+
 struct token
 {
   char *operator;
@@ -907,8 +1000,8 @@ static const struct token tokentab2[] =
     {"<>", NOTEQUAL, BINOP_END},
     {"<=", LEQ, BINOP_END},
     {">=", GEQ, BINOP_END},
-    {":=", ASSIGN, BINOP_END}
-  };
+    {":=", ASSIGN, BINOP_END},
+    {"::", COLONCOLON, BINOP_END} };
 
 /* Allocate uppercased var */
 /* make an uppercased copy of tokstart */
@@ -1149,6 +1242,7 @@ yylex ()
 	  {
 	    tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
 	  }
+
 	switch (*tokptr)
 	  {
 	  case '\0':
@@ -1295,25 +1389,37 @@ yylex ()
     char *tmp = copy_name (yylval.sval);
     struct symbol *sym;
     int is_a_field_of_this = 0;
+    int is_a_field = 0;
     int hextype;
 
-    sym = lookup_symbol (tmp, expression_context_block,
-			 VAR_NAMESPACE,
-			 &is_a_field_of_this,
-			 (struct symtab **) NULL);
+
+    if (search_field && current_type)
+      is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);	
+    if (is_a_field)
+      sym = NULL;
+    else
+      sym = lookup_symbol (tmp, expression_context_block,
+			   VAR_NAMESPACE,
+			   &is_a_field_of_this,
+			   (struct symtab **) NULL);
     /* second chance uppercased (as Free Pascal does).  */
-    if (!sym && !is_a_field_of_this)
+    if (!sym && !is_a_field_of_this && !is_a_field)
       {
        for (i = 0; i <= namelen; i++)
          {
            if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
              tmp[i] -= ('a'-'A');
          }
-       sym = lookup_symbol (tmp, expression_context_block,
+       if (search_field && current_type)
+	 is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);	
+       if (is_a_field)
+	 sym = NULL;
+       else
+	 sym = lookup_symbol (tmp, expression_context_block,
                         VAR_NAMESPACE,
                         &is_a_field_of_this,
                         (struct symtab **) NULL);
-       if (sym || is_a_field_of_this)
+       if (sym || is_a_field_of_this || is_a_field)
          for (i = 0; i <= namelen; i++)
            {
              if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
@@ -1321,7 +1427,7 @@ yylex ()
            }
       }
     /* Third chance Capitalized (as GPC does).  */
-    if (!sym && !is_a_field_of_this)
+    if (!sym && !is_a_field_of_this && !is_a_field)
       {
        for (i = 0; i <= namelen; i++)
          {
@@ -1334,11 +1440,16 @@ yylex ()
            if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
              tmp[i] -= ('A'-'a');
           }
-       sym = lookup_symbol (tmp, expression_context_block,
+       if (search_field && current_type)
+	 is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);	
+       if (is_a_field)
+	 sym = NULL;
+       else
+	 sym = lookup_symbol (tmp, expression_context_block,
                          VAR_NAMESPACE,
                          &is_a_field_of_this,
                          (struct symtab **) NULL);
-        if (sym || is_a_field_of_this)
+       if (sym || is_a_field_of_this || is_a_field)
           for (i = 0; i <= namelen; i++)
             {
               if (i == 0)
@@ -1351,6 +1462,15 @@ yylex ()
                   tokstart[i] -= ('A'-'a');
             }
       }
+
+    if (is_a_field)
+      {
+	tempbuf = (char *) realloc (tempbuf, namelen + 1);
+	strncpy (tempbuf, tokstart, namelen); tempbuf [namelen] = 0;
+	yylval.sval.ptr = tempbuf;
+	yylval.sval.length = namelen; 
+	return FIELDNAME;
+      } 
     /* Call lookup_symtab, not lookup_partial_symtab, in case there are
        no psymtabs (coff, xcoff, or some future change to blow away the
        psymtabs once once symbols are read).  */

[-- Attachment #3: Type: text/plain, Size: 176 bytes --]



Pierre Muller
Institut Charles Sadron
6,rue Boussingault
F 67083 STRASBOURG CEDEX (France)
mailto:muller@ics.u-strasbg.fr
Phone : (33)-3-88-41-40-07  Fax : (33)-3-88-41-40-99