OpenCores
URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gdb/] [gdb-6.8/] [gdb/] [p-exp.y] - Blame information for rev 27

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 25 jlechner
/* YACC parser for Pascal expressions, for GDB.
2
   Copyright (C) 2000, 2006, 2007, 2008 Free Software Foundation, Inc.
3
 
4
This file is part of GDB.
5
 
6
This program is free software; you can redistribute it and/or modify
7
it under the terms of the GNU General Public License as published by
8
the Free Software Foundation; either version 2 of the License, or
9
(at your option) any later version.
10
 
11
This program is distributed in the hope that it will be useful,
12
but WITHOUT ANY WARRANTY; without even the implied warranty of
13
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14
GNU General Public License for more details.
15
 
16
You should have received a copy of the GNU General Public License
17
along with this program; if not, write to the Free Software
18
Foundation, Inc., 51 Franklin Street, Fifth Floor,
19
Boston, MA 02110-1301, USA.  */
20
 
21
/* This file is derived from c-exp.y */
22
 
23
/* Parse a Pascal expression from text in a string,
24
   and return the result as a  struct expression  pointer.
25
   That structure contains arithmetic operations in reverse polish,
26
   with constants represented by operations that are followed by special data.
27
   See expression.h for the details of the format.
28
   What is important here is that it can be built up sequentially
29
   during the process of parsing; the lower levels of the tree always
30
   come first in the result.
31
 
32
   Note that malloc's and realloc's in this file are transformed to
33
   xmalloc and xrealloc respectively by the same sed command in the
34
   makefile that remaps any other malloc/realloc inserted by the parser
35
   generator.  Doing this with #defines and trying to control the interaction
36
   with include files ( and  for example) just became
37
   too messy, particularly when such includes can be inserted at random
38
   times by the parser generator.  */
39
 
40
/* Known bugs or limitations:
41
    - pascal string operations are not supported at all.
42
    - there are some problems with boolean types.
43
    - Pascal type hexadecimal constants are not supported
44
      because they conflict with the internal variables format.
45
   Probably also lots of other problems, less well defined PM */
46
%{
47
 
48
#include "defs.h"
49
#include "gdb_string.h"
50
#include 
51
#include "expression.h"
52
#include "value.h"
53
#include "parser-defs.h"
54
#include "language.h"
55
#include "p-lang.h"
56
#include "bfd.h" /* Required by objfiles.h.  */
57
#include "symfile.h" /* Required by objfiles.h.  */
58
#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
59
#include "block.h"
60
 
61
/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
62
   as well as gratuitiously global symbol names, so we can have multiple
63
   yacc generated parsers in gdb.  Note that these are only the variables
64
   produced by yacc.  If other parser generators (bison, byacc, etc) produce
65
   additional global names that conflict at link time, then those parser
66
   generators need to be fixed instead of adding those names to this list. */
67
 
68
#define yymaxdepth pascal_maxdepth
69
#define yyparse pascal_parse
70
#define yylex   pascal_lex
71
#define yyerror pascal_error
72
#define yylval  pascal_lval
73
#define yychar  pascal_char
74
#define yydebug pascal_debug
75
#define yypact  pascal_pact
76
#define yyr1    pascal_r1
77
#define yyr2    pascal_r2
78
#define yydef   pascal_def
79
#define yychk   pascal_chk
80
#define yypgo   pascal_pgo
81
#define yyact   pascal_act
82
#define yyexca  pascal_exca
83
#define yyerrflag pascal_errflag
84
#define yynerrs pascal_nerrs
85
#define yyps    pascal_ps
86
#define yypv    pascal_pv
87
#define yys     pascal_s
88
#define yy_yys  pascal_yys
89
#define yystate pascal_state
90
#define yytmp   pascal_tmp
91
#define yyv     pascal_v
92
#define yy_yyv  pascal_yyv
93
#define yyval   pascal_val
94
#define yylloc  pascal_lloc
95
#define yyreds  pascal_reds             /* With YYDEBUG defined */
96
#define yytoks  pascal_toks             /* With YYDEBUG defined */
97
#define yyname  pascal_name             /* With YYDEBUG defined */
98
#define yyrule  pascal_rule             /* With YYDEBUG defined */
99
#define yylhs   pascal_yylhs
100
#define yylen   pascal_yylen
101
#define yydefred pascal_yydefred
102
#define yydgoto pascal_yydgoto
103
#define yysindex pascal_yysindex
104
#define yyrindex pascal_yyrindex
105
#define yygindex pascal_yygindex
106
#define yytable  pascal_yytable
107
#define yycheck  pascal_yycheck
108
 
109
#ifndef YYDEBUG
110
#define YYDEBUG 1               /* Default to yydebug support */
111
#endif
112
 
113
#define YYFPRINTF parser_fprintf
114
 
115
int yyparse (void);
116
 
117
static int yylex (void);
118
 
119
void
120
yyerror (char *);
121
 
122
static char * uptok (char *, int);
123
%}
124
 
125
/* Although the yacc "value" of an expression is not used,
126
   since the result is stored in the structure being created,
127
   other node types do have values.  */
128
 
129
%union
130
  {
131
    LONGEST lval;
132
    struct {
133
      LONGEST val;
134
      struct type *type;
135
    } typed_val_int;
136
    struct {
137
      DOUBLEST dval;
138
      struct type *type;
139
    } typed_val_float;
140
    struct symbol *sym;
141
    struct type *tval;
142
    struct stoken sval;
143
    struct ttype tsym;
144
    struct symtoken ssym;
145
    int voidval;
146
    struct block *bval;
147
    enum exp_opcode opcode;
148
    struct internalvar *ivar;
149
 
150
    struct type **tvec;
151
    int *ivec;
152
  }
153
 
154
%{
155
/* YYSTYPE gets defined by %union */
156
static int
157
parse_number (char *, int, int, YYSTYPE *);
158
 
159
static struct type *current_type;
160
static int leftdiv_is_integer;
161
static void push_current_type (void);
162
static void pop_current_type (void);
163
static int search_field;
164
%}
165
 
166
%type  exp exp1 type_exp start normal_start variable qualified_name
167
%type  type typebase
168
/* %type  block */
169
 
170
/* Fancy type parsing.  */
171
%type  ptype
172
 
173
%token  INT
174
%token  FLOAT
175
 
176
/* Both NAME and TYPENAME tokens represent symbols in the input,
177
   and both convey their data as strings.
178
   But a TYPENAME is a string that happens to be defined as a typedef
179
   or builtin type name (such as int or char)
180
   and a NAME is any other symbol.
181
   Contexts where this distinction is not important can use the
182
   nonterminal "name", which matches either NAME or TYPENAME.  */
183
 
184
%token  STRING
185
%token  FIELDNAME
186
%token  NAME /* BLOCKNAME defined below to give it higher precedence. */
187
%token  TYPENAME
188
%type  name
189
%type  name_not_typename
190
 
191
/* A NAME_OR_INT is a symbol which is not known in the symbol table,
192
   but which would parse as a valid number in the current input radix.
193
   E.g. "c" when input_radix==16.  Depending on the parse, it will be
194
   turned into a name or into a number.  */
195
 
196
%token  NAME_OR_INT
197
 
198
%token STRUCT CLASS SIZEOF COLONCOLON
199
%token ERROR
200
 
201
/* Special type cases, put in to allow the parser to distinguish different
202
   legal basetypes.  */
203
 
204
%token  VARIABLE
205
 
206
 
207
/* Object pascal */
208
%token THIS
209
%token  TRUEKEYWORD FALSEKEYWORD
210
 
211
%left ','
212
%left ABOVE_COMMA
213
%right ASSIGN
214
%left NOT
215
%left OR
216
%left XOR
217
%left ANDAND
218
%left '=' NOTEQUAL
219
%left '<' '>' LEQ GEQ
220
%left LSH RSH DIV MOD
221
%left '@'
222
%left '+' '-'
223
%left '*' '/'
224
%right UNARY INCREMENT DECREMENT
225
%right ARROW '.' '[' '('
226
%left '^'
227
%token  BLOCKNAME
228
%type  block
229
%left COLONCOLON
230
 
231
 
232
%%
233
 
234
start   :       { current_type = NULL;
235
                  search_field = 0;
236
                  leftdiv_is_integer = 0;
237
                }
238
                normal_start {}
239
        ;
240
 
241
normal_start    :
242
                exp1
243
        |       type_exp
244
        ;
245
 
246
type_exp:       type
247
                        { write_exp_elt_opcode(OP_TYPE);
248
                          write_exp_elt_type($1);
249
                          write_exp_elt_opcode(OP_TYPE);
250
                          current_type = $1; } ;
251
 
252
/* Expressions, including the comma operator.  */
253
exp1    :       exp
254
        |       exp1 ',' exp
255
                        { write_exp_elt_opcode (BINOP_COMMA); }
256
        ;
257
 
258
/* Expressions, not including the comma operator.  */
259
exp     :       exp '^'   %prec UNARY
260
                        { write_exp_elt_opcode (UNOP_IND);
261
                          if (current_type)
262
                            current_type = TYPE_TARGET_TYPE (current_type); }
263
        ;
264
 
265
exp     :       '@' exp    %prec UNARY
266
                        { write_exp_elt_opcode (UNOP_ADDR);
267
                          if (current_type)
268
                            current_type = TYPE_POINTER_TYPE (current_type); }
269
        ;
270
 
271
exp     :       '-' exp    %prec UNARY
272
                        { write_exp_elt_opcode (UNOP_NEG); }
273
        ;
274
 
275
exp     :       NOT exp    %prec UNARY
276
                        { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
277
        ;
278
 
279
exp     :       INCREMENT '(' exp ')'   %prec UNARY
280
                        { write_exp_elt_opcode (UNOP_PREINCREMENT); }
281
        ;
282
 
283
exp     :       DECREMENT  '(' exp ')'   %prec UNARY
284
                        { write_exp_elt_opcode (UNOP_PREDECREMENT); }
285
        ;
286
 
287
exp     :       exp '.' { search_field = 1; }
288
                FIELDNAME
289
                /* name */
290
                        { write_exp_elt_opcode (STRUCTOP_STRUCT);
291
                          write_exp_string ($4);
292
                          write_exp_elt_opcode (STRUCTOP_STRUCT);
293
                          search_field = 0;
294
                          if (current_type)
295
                            { while (TYPE_CODE (current_type) == TYPE_CODE_PTR)
296
                                current_type = TYPE_TARGET_TYPE (current_type);
297
                              current_type = lookup_struct_elt_type (
298
                                current_type, $4.ptr, 0); };
299
                         } ;
300
exp     :       exp '['
301
                        /* We need to save the current_type value */
302
                        { char *arrayname;
303
                          int arrayfieldindex;
304
                          arrayfieldindex = is_pascal_string_type (
305
                                current_type, NULL, NULL,
306
                                NULL, NULL, &arrayname);
307
                          if (arrayfieldindex)
308
                            {
309
                              struct stoken stringsval;
310
                              stringsval.ptr = alloca (strlen (arrayname) + 1);
311
                              stringsval.length = strlen (arrayname);
312
                              strcpy (stringsval.ptr, arrayname);
313
                              current_type = TYPE_FIELD_TYPE (current_type,
314
                                arrayfieldindex - 1);
315
                              write_exp_elt_opcode (STRUCTOP_STRUCT);
316
                              write_exp_string (stringsval);
317
                              write_exp_elt_opcode (STRUCTOP_STRUCT);
318
                            }
319
                          push_current_type ();  }
320
                exp1 ']'
321
                        { pop_current_type ();
322
                          write_exp_elt_opcode (BINOP_SUBSCRIPT);
323
                          if (current_type)
324
                            current_type = TYPE_TARGET_TYPE (current_type); }
325
        ;
326
 
327
exp     :       exp '('
328
                        /* This is to save the value of arglist_len
329
                           being accumulated by an outer function call.  */
330
                        { push_current_type ();
331
                          start_arglist (); }
332
                arglist ')'     %prec ARROW
333
                        { write_exp_elt_opcode (OP_FUNCALL);
334
                          write_exp_elt_longcst ((LONGEST) end_arglist ());
335
                          write_exp_elt_opcode (OP_FUNCALL);
336
                          pop_current_type ();
337
                          if (current_type)
338
                            current_type = TYPE_TARGET_TYPE (current_type);
339
                        }
340
        ;
341
 
342
arglist :
343
         | exp
344
                        { arglist_len = 1; }
345
         | arglist ',' exp   %prec ABOVE_COMMA
346
                        { arglist_len++; }
347
        ;
348
 
349
exp     :       type '(' exp ')' %prec UNARY
350
                        { if (current_type)
351
                            {
352
                              /* Allow automatic dereference of classes.  */
353
                              if ((TYPE_CODE (current_type) == TYPE_CODE_PTR)
354
                                  && (TYPE_CODE (TYPE_TARGET_TYPE (current_type)) == TYPE_CODE_CLASS)
355
                                  && (TYPE_CODE ($1) == TYPE_CODE_CLASS))
356
                                write_exp_elt_opcode (UNOP_IND);
357
                            }
358
                          write_exp_elt_opcode (UNOP_CAST);
359
                          write_exp_elt_type ($1);
360
                          write_exp_elt_opcode (UNOP_CAST);
361
                          current_type = $1; }
362
        ;
363
 
364
exp     :       '(' exp1 ')'
365
                        { }
366
        ;
367
 
368
/* Binary operators in order of decreasing precedence.  */
369
 
370
exp     :       exp '*' exp
371
                        { write_exp_elt_opcode (BINOP_MUL); }
372
        ;
373
 
374
exp     :       exp '/' {
375
                          if (current_type && is_integral_type (current_type))
376
                            leftdiv_is_integer = 1;
377
                        }
378
                exp
379
                        {
380
                          if (leftdiv_is_integer && current_type
381
                              && is_integral_type (current_type))
382
                            {
383
                              write_exp_elt_opcode (UNOP_CAST);
384
                              write_exp_elt_type (builtin_type_long_double);
385
                              current_type = builtin_type_long_double;
386
                              write_exp_elt_opcode (UNOP_CAST);
387
                              leftdiv_is_integer = 0;
388
                            }
389
 
390
                          write_exp_elt_opcode (BINOP_DIV);
391
                        }
392
        ;
393
 
394
exp     :       exp DIV exp
395
                        { write_exp_elt_opcode (BINOP_INTDIV); }
396
        ;
397
 
398
exp     :       exp MOD exp
399
                        { write_exp_elt_opcode (BINOP_REM); }
400
        ;
401
 
402
exp     :       exp '+' exp
403
                        { write_exp_elt_opcode (BINOP_ADD); }
404
        ;
405
 
406
exp     :       exp '-' exp
407
                        { write_exp_elt_opcode (BINOP_SUB); }
408
        ;
409
 
410
exp     :       exp LSH exp
411
                        { write_exp_elt_opcode (BINOP_LSH); }
412
        ;
413
 
414
exp     :       exp RSH exp
415
                        { write_exp_elt_opcode (BINOP_RSH); }
416
        ;
417
 
418
exp     :       exp '=' exp
419
                        { write_exp_elt_opcode (BINOP_EQUAL);
420
                          current_type = builtin_type_bool;
421
                        }
422
        ;
423
 
424
exp     :       exp NOTEQUAL exp
425
                        { write_exp_elt_opcode (BINOP_NOTEQUAL);
426
                          current_type = builtin_type_bool;
427
                        }
428
        ;
429
 
430
exp     :       exp LEQ exp
431
                        { write_exp_elt_opcode (BINOP_LEQ);
432
                          current_type = builtin_type_bool;
433
                        }
434
        ;
435
 
436
exp     :       exp GEQ exp
437
                        { write_exp_elt_opcode (BINOP_GEQ);
438
                          current_type = builtin_type_bool;
439
                        }
440
        ;
441
 
442
exp     :       exp '<' exp
443
                        { write_exp_elt_opcode (BINOP_LESS);
444
                          current_type = builtin_type_bool;
445
                        }
446
        ;
447
 
448
exp     :       exp '>' exp
449
                        { write_exp_elt_opcode (BINOP_GTR);
450
                          current_type = builtin_type_bool;
451
                        }
452
        ;
453
 
454
exp     :       exp ANDAND exp
455
                        { write_exp_elt_opcode (BINOP_BITWISE_AND); }
456
        ;
457
 
458
exp     :       exp XOR exp
459
                        { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
460
        ;
461
 
462
exp     :       exp OR exp
463
                        { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
464
        ;
465
 
466
exp     :       exp ASSIGN exp
467
                        { write_exp_elt_opcode (BINOP_ASSIGN); }
468
        ;
469
 
470
exp     :       TRUEKEYWORD
471
                        { write_exp_elt_opcode (OP_BOOL);
472
                          write_exp_elt_longcst ((LONGEST) $1);
473
                          current_type = builtin_type_bool;
474
                          write_exp_elt_opcode (OP_BOOL); }
475
        ;
476
 
477
exp     :       FALSEKEYWORD
478
                        { write_exp_elt_opcode (OP_BOOL);
479
                          write_exp_elt_longcst ((LONGEST) $1);
480
                          current_type = builtin_type_bool;
481
                          write_exp_elt_opcode (OP_BOOL); }
482
        ;
483
 
484
exp     :       INT
485
                        { write_exp_elt_opcode (OP_LONG);
486
                          write_exp_elt_type ($1.type);
487
                          current_type = $1.type;
488
                          write_exp_elt_longcst ((LONGEST)($1.val));
489
                          write_exp_elt_opcode (OP_LONG); }
490
        ;
491
 
492
exp     :       NAME_OR_INT
493
                        { YYSTYPE val;
494
                          parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
495
                          write_exp_elt_opcode (OP_LONG);
496
                          write_exp_elt_type (val.typed_val_int.type);
497
                          current_type = val.typed_val_int.type;
498
                          write_exp_elt_longcst ((LONGEST)val.typed_val_int.val);
499
                          write_exp_elt_opcode (OP_LONG);
500
                        }
501
        ;
502
 
503
 
504
exp     :       FLOAT
505
                        { write_exp_elt_opcode (OP_DOUBLE);
506
                          write_exp_elt_type ($1.type);
507
                          current_type = $1.type;
508
                          write_exp_elt_dblcst ($1.dval);
509
                          write_exp_elt_opcode (OP_DOUBLE); }
510
        ;
511
 
512
exp     :       variable
513
        ;
514
 
515
exp     :       VARIABLE
516
                        /* Already written by write_dollar_variable. */
517
        ;
518
 
519
exp     :       SIZEOF '(' type ')'     %prec UNARY
520
                        { write_exp_elt_opcode (OP_LONG);
521
                          write_exp_elt_type (builtin_type_int);
522
                          CHECK_TYPEDEF ($3);
523
                          write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
524
                          write_exp_elt_opcode (OP_LONG); }
525
        ;
526
 
527
exp     :       STRING
528
                        { /* C strings are converted into array constants with
529
                             an explicit null byte added at the end.  Thus
530
                             the array upper bound is the string length.
531
                             There is no such thing in C as a completely empty
532
                             string. */
533
                          char *sp = $1.ptr; int count = $1.length;
534
                          while (count-- > 0)
535
                            {
536
                              write_exp_elt_opcode (OP_LONG);
537
                              write_exp_elt_type (builtin_type_char);
538
                              write_exp_elt_longcst ((LONGEST)(*sp++));
539
                              write_exp_elt_opcode (OP_LONG);
540
                            }
541
                          write_exp_elt_opcode (OP_LONG);
542
                          write_exp_elt_type (builtin_type_char);
543
                          write_exp_elt_longcst ((LONGEST)'\0');
544
                          write_exp_elt_opcode (OP_LONG);
545
                          write_exp_elt_opcode (OP_ARRAY);
546
                          write_exp_elt_longcst ((LONGEST) 0);
547
                          write_exp_elt_longcst ((LONGEST) ($1.length));
548
                          write_exp_elt_opcode (OP_ARRAY); }
549
        ;
550
 
551
/* Object pascal  */
552
exp     :       THIS
553
                        {
554
                          struct value * this_val;
555
                          struct type * this_type;
556
                          write_exp_elt_opcode (OP_THIS);
557
                          write_exp_elt_opcode (OP_THIS);
558
                          /* we need type of this */
559
                          this_val = value_of_this (0);
560
                          if (this_val)
561
                            this_type = value_type (this_val);
562
                          else
563
                            this_type = NULL;
564
                          if (this_type)
565
                            {
566
                              if (TYPE_CODE (this_type) == TYPE_CODE_PTR)
567
                                {
568
                                  this_type = TYPE_TARGET_TYPE (this_type);
569
                                  write_exp_elt_opcode (UNOP_IND);
570
                                }
571
                            }
572
 
573
                          current_type = this_type;
574
                        }
575
        ;
576
 
577
/* end of object pascal.  */
578
 
579
block   :       BLOCKNAME
580
                        {
581
                          if ($1.sym != 0)
582
                              $$ = SYMBOL_BLOCK_VALUE ($1.sym);
583
                          else
584
                            {
585
                              struct symtab *tem =
586
                                  lookup_symtab (copy_name ($1.stoken));
587
                              if (tem)
588
                                $$ = BLOCKVECTOR_BLOCK (BLOCKVECTOR (tem), STATIC_BLOCK);
589
                              else
590
                                error ("No file or function \"%s\".",
591
                                       copy_name ($1.stoken));
592
                            }
593
                        }
594
        ;
595
 
596
block   :       block COLONCOLON name
597
                        { struct symbol *tem
598
                            = lookup_symbol (copy_name ($3), $1,
599
                                             VAR_DOMAIN, (int *) NULL,
600
                                             (struct symtab **) NULL);
601
                          if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
602
                            error ("No function \"%s\" in specified context.",
603
                                   copy_name ($3));
604
                          $$ = SYMBOL_BLOCK_VALUE (tem); }
605
        ;
606
 
607
variable:       block COLONCOLON name
608
                        { struct symbol *sym;
609
                          sym = lookup_symbol (copy_name ($3), $1,
610
                                               VAR_DOMAIN, (int *) NULL,
611
                                               (struct symtab **) NULL);
612
                          if (sym == 0)
613
                            error ("No symbol \"%s\" in specified context.",
614
                                   copy_name ($3));
615
 
616
                          write_exp_elt_opcode (OP_VAR_VALUE);
617
                          /* block_found is set by lookup_symbol.  */
618
                          write_exp_elt_block (block_found);
619
                          write_exp_elt_sym (sym);
620
                          write_exp_elt_opcode (OP_VAR_VALUE); }
621
        ;
622
 
623
qualified_name: typebase COLONCOLON name
624
                        {
625
                          struct type *type = $1;
626
                          if (TYPE_CODE (type) != TYPE_CODE_STRUCT
627
                              && TYPE_CODE (type) != TYPE_CODE_UNION)
628
                            error ("`%s' is not defined as an aggregate type.",
629
                                   TYPE_NAME (type));
630
 
631
                          write_exp_elt_opcode (OP_SCOPE);
632
                          write_exp_elt_type (type);
633
                          write_exp_string ($3);
634
                          write_exp_elt_opcode (OP_SCOPE);
635
                        }
636
        ;
637
 
638
variable:       qualified_name
639
        |       COLONCOLON name
640
                        {
641
                          char *name = copy_name ($2);
642
                          struct symbol *sym;
643
                          struct minimal_symbol *msymbol;
644
 
645
                          sym =
646
                            lookup_symbol (name, (const struct block *) NULL,
647
                                           VAR_DOMAIN, (int *) NULL,
648
                                           (struct symtab **) NULL);
649
                          if (sym)
650
                            {
651
                              write_exp_elt_opcode (OP_VAR_VALUE);
652
                              write_exp_elt_block (NULL);
653
                              write_exp_elt_sym (sym);
654
                              write_exp_elt_opcode (OP_VAR_VALUE);
655
                              break;
656
                            }
657
 
658
                          msymbol = lookup_minimal_symbol (name, NULL, NULL);
659
                          if (msymbol != NULL)
660
                            {
661
                              write_exp_msymbol (msymbol,
662
                                                 lookup_function_type (builtin_type_int),
663
                                                 builtin_type_int);
664
                            }
665
                          else
666
                            if (!have_full_symbols () && !have_partial_symbols ())
667
                              error ("No symbol table is loaded.  Use the \"file\" command.");
668
                            else
669
                              error ("No symbol \"%s\" in current context.", name);
670
                        }
671
        ;
672
 
673
variable:       name_not_typename
674
                        { struct symbol *sym = $1.sym;
675
 
676
                          if (sym)
677
                            {
678
                              if (symbol_read_needs_frame (sym))
679
                                {
680
                                  if (innermost_block == 0
681
                                      || contained_in (block_found,
682
                                                       innermost_block))
683
                                    innermost_block = block_found;
684
                                }
685
 
686
                              write_exp_elt_opcode (OP_VAR_VALUE);
687
                              /* We want to use the selected frame, not
688
                                 another more inner frame which happens to
689
                                 be in the same block.  */
690
                              write_exp_elt_block (NULL);
691
                              write_exp_elt_sym (sym);
692
                              write_exp_elt_opcode (OP_VAR_VALUE);
693
                              current_type = sym->type; }
694
                          else if ($1.is_a_field_of_this)
695
                            {
696
                              struct value * this_val;
697
                              struct type * this_type;
698
                              /* Object pascal: it hangs off of `this'.  Must
699
                                 not inadvertently convert from a method call
700
                                 to data ref.  */
701
                              if (innermost_block == 0
702
                                  || contained_in (block_found,
703
                                                   innermost_block))
704
                                innermost_block = block_found;
705
                              write_exp_elt_opcode (OP_THIS);
706
                              write_exp_elt_opcode (OP_THIS);
707
                              write_exp_elt_opcode (STRUCTOP_PTR);
708
                              write_exp_string ($1.stoken);
709
                              write_exp_elt_opcode (STRUCTOP_PTR);
710
                              /* we need type of this */
711
                              this_val = value_of_this (0);
712
                              if (this_val)
713
                                this_type = value_type (this_val);
714
                              else
715
                                this_type = NULL;
716
                              if (this_type)
717
                                current_type = lookup_struct_elt_type (
718
                                  this_type,
719
                                  copy_name ($1.stoken), 0);
720
                              else
721
                                current_type = NULL;
722
                            }
723
                          else
724
                            {
725
                              struct minimal_symbol *msymbol;
726
                              char *arg = copy_name ($1.stoken);
727
 
728
                              msymbol =
729
                                lookup_minimal_symbol (arg, NULL, NULL);
730
                              if (msymbol != NULL)
731
                                {
732
                                  write_exp_msymbol (msymbol,
733
                                                     lookup_function_type (builtin_type_int),
734
                                                     builtin_type_int);
735
                                }
736
                              else if (!have_full_symbols () && !have_partial_symbols ())
737
                                error ("No symbol table is loaded.  Use the \"file\" command.");
738
                              else
739
                                error ("No symbol \"%s\" in current context.",
740
                                       copy_name ($1.stoken));
741
                            }
742
                        }
743
        ;
744
 
745
 
746
ptype   :       typebase
747
        ;
748
 
749
/* We used to try to recognize more pointer to member types here, but
750
   that didn't work (shift/reduce conflicts meant that these rules never
751
   got executed).  The problem is that
752
     int (foo::bar::baz::bizzle)
753
   is a function type but
754
     int (foo::bar::baz::bizzle::*)
755
   is a pointer to member type.  Stroustrup loses again!  */
756
 
757
type    :       ptype
758
        ;
759
 
760
typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
761
        :       '^' typebase
762
                        { $$ = lookup_pointer_type ($2); }
763
        |       TYPENAME
764
                        { $$ = $1.type; }
765
        |       STRUCT name
766
                        { $$ = lookup_struct (copy_name ($2),
767
                                              expression_context_block); }
768
        |       CLASS name
769
                        { $$ = lookup_struct (copy_name ($2),
770
                                              expression_context_block); }
771
        /* "const" and "volatile" are curently ignored.  A type qualifier
772
           after the type is handled in the ptype rule.  I think these could
773
           be too.  */
774
        ;
775
 
776
name    :       NAME { $$ = $1.stoken; }
777
        |       BLOCKNAME { $$ = $1.stoken; }
778
        |       TYPENAME { $$ = $1.stoken; }
779
        |       NAME_OR_INT  { $$ = $1.stoken; }
780
        ;
781
 
782
name_not_typename :     NAME
783
        |       BLOCKNAME
784
/* These would be useful if name_not_typename was useful, but it is just
785
   a fake for "variable", so these cause reduce/reduce conflicts because
786
   the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
787
   =exp) or just an exp.  If name_not_typename was ever used in an lvalue
788
   context where only a name could occur, this might be useful.
789
        |       NAME_OR_INT
790
 */
791
        ;
792
 
793
%%
794
 
795
/* Take care of parsing a number (anything that starts with a digit).
796
   Set yylval and return the token type; update lexptr.
797
   LEN is the number of characters in it.  */
798
 
799
/*** Needs some error checking for the float case ***/
800
 
801
static int
802
parse_number (p, len, parsed_float, putithere)
803
     char *p;
804
     int len;
805
     int parsed_float;
806
     YYSTYPE *putithere;
807
{
808
  /* FIXME: Shouldn't these be unsigned?  We don't deal with negative values
809
     here, and we do kind of silly things like cast to unsigned.  */
810
  LONGEST n = 0;
811
  LONGEST prevn = 0;
812
  ULONGEST un;
813
 
814
  int i = 0;
815
  int c;
816
  int base = input_radix;
817
  int unsigned_p = 0;
818
 
819
  /* Number of "L" suffixes encountered.  */
820
  int long_p = 0;
821
 
822
  /* We have found a "L" or "U" suffix.  */
823
  int found_suffix = 0;
824
 
825
  ULONGEST high_bit;
826
  struct type *signed_type;
827
  struct type *unsigned_type;
828
 
829
  if (parsed_float)
830
    {
831
      /* It's a float since it contains a point or an exponent.  */
832
      char c;
833
      int num = 0;      /* number of tokens scanned by scanf */
834
      char saved_char = p[len];
835
 
836
      p[len] = 0;       /* null-terminate the token */
837
      num = sscanf (p, "%" DOUBLEST_SCAN_FORMAT "%c",
838
                    &putithere->typed_val_float.dval, &c);
839
      p[len] = saved_char;      /* restore the input stream */
840
      if (num != 1)             /* check scanf found ONLY a float ... */
841
        return ERROR;
842
      /* See if it has `f' or `l' suffix (float or long double).  */
843
 
844
      c = tolower (p[len - 1]);
845
 
846
      if (c == 'f')
847
        putithere->typed_val_float.type = builtin_type_float;
848
      else if (c == 'l')
849
        putithere->typed_val_float.type = builtin_type_long_double;
850
      else if (isdigit (c) || c == '.')
851
        putithere->typed_val_float.type = builtin_type_double;
852
      else
853
        return ERROR;
854
 
855
      return FLOAT;
856
    }
857
 
858
  /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
859
  if (p[0] == '0')
860
    switch (p[1])
861
      {
862
      case 'x':
863
      case 'X':
864
        if (len >= 3)
865
          {
866
            p += 2;
867
            base = 16;
868
            len -= 2;
869
          }
870
        break;
871
 
872
      case 't':
873
      case 'T':
874
      case 'd':
875
      case 'D':
876
        if (len >= 3)
877
          {
878
            p += 2;
879
            base = 10;
880
            len -= 2;
881
          }
882
        break;
883
 
884
      default:
885
        base = 8;
886
        break;
887
      }
888
 
889
  while (len-- > 0)
890
    {
891
      c = *p++;
892
      if (c >= 'A' && c <= 'Z')
893
        c += 'a' - 'A';
894
      if (c != 'l' && c != 'u')
895
        n *= base;
896
      if (c >= '0' && c <= '9')
897
        {
898
          if (found_suffix)
899
            return ERROR;
900
          n += i = c - '0';
901
        }
902
      else
903
        {
904
          if (base > 10 && c >= 'a' && c <= 'f')
905
            {
906
              if (found_suffix)
907
                return ERROR;
908
              n += i = c - 'a' + 10;
909
            }
910
          else if (c == 'l')
911
            {
912
              ++long_p;
913
              found_suffix = 1;
914
            }
915
          else if (c == 'u')
916
            {
917
              unsigned_p = 1;
918
              found_suffix = 1;
919
            }
920
          else
921
            return ERROR;       /* Char not a digit */
922
        }
923
      if (i >= base)
924
        return ERROR;           /* Invalid digit in this base */
925
 
926
      /* Portably test for overflow (only works for nonzero values, so make
927
         a second check for zero).  FIXME: Can't we just make n and prevn
928
         unsigned and avoid this?  */
929
      if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
930
        unsigned_p = 1;         /* Try something unsigned */
931
 
932
      /* Portably test for unsigned overflow.
933
         FIXME: This check is wrong; for example it doesn't find overflow
934
         on 0x123456789 when LONGEST is 32 bits.  */
935
      if (c != 'l' && c != 'u' && n != 0)
936
        {
937
          if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
938
            error ("Numeric constant too large.");
939
        }
940
      prevn = n;
941
    }
942
 
943
  /* An integer constant is an int, a long, or a long long.  An L
944
     suffix forces it to be long; an LL suffix forces it to be long
945
     long.  If not forced to a larger size, it gets the first type of
946
     the above that it fits in.  To figure out whether it fits, we
947
     shift it right and see whether anything remains.  Note that we
948
     can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
949
     operation, because many compilers will warn about such a shift
950
     (which always produces a zero result).  Sometimes gdbarch_int_bit
951
     or gdbarch_long_bit will be that big, sometimes not.  To deal with
952
     the case where it is we just always shift the value more than
953
     once, with fewer bits each time.  */
954
 
955
  un = (ULONGEST)n >> 2;
956
  if (long_p == 0
957
      && (un >> (gdbarch_int_bit (current_gdbarch) - 2)) == 0)
958
    {
959
      high_bit = ((ULONGEST)1) << (gdbarch_int_bit (current_gdbarch) - 1);
960
 
961
      /* A large decimal (not hex or octal) constant (between INT_MAX
962
         and UINT_MAX) is a long or unsigned long, according to ANSI,
963
         never an unsigned int, but this code treats it as unsigned
964
         int.  This probably should be fixed.  GCC gives a warning on
965
         such constants.  */
966
 
967
      unsigned_type = builtin_type_unsigned_int;
968
      signed_type = builtin_type_int;
969
    }
970
  else if (long_p <= 1
971
           && (un >> (gdbarch_long_bit (current_gdbarch) - 2)) == 0)
972
    {
973
      high_bit = ((ULONGEST)1) << (gdbarch_long_bit (current_gdbarch) - 1);
974
      unsigned_type = builtin_type_unsigned_long;
975
      signed_type = builtin_type_long;
976
    }
977
  else
978
    {
979
      int shift;
980
      if (sizeof (ULONGEST) * HOST_CHAR_BIT
981
          < gdbarch_long_long_bit (current_gdbarch))
982
        /* A long long does not fit in a LONGEST.  */
983
        shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
984
      else
985
        shift = (gdbarch_long_long_bit (current_gdbarch) - 1);
986
      high_bit = (ULONGEST) 1 << shift;
987
      unsigned_type = builtin_type_unsigned_long_long;
988
      signed_type = builtin_type_long_long;
989
    }
990
 
991
   putithere->typed_val_int.val = n;
992
 
993
   /* If the high bit of the worked out type is set then this number
994
      has to be unsigned. */
995
 
996
   if (unsigned_p || (n & high_bit))
997
     {
998
       putithere->typed_val_int.type = unsigned_type;
999
     }
1000
   else
1001
     {
1002
       putithere->typed_val_int.type = signed_type;
1003
     }
1004
 
1005
   return INT;
1006
}
1007
 
1008
 
1009
struct type_push
1010
{
1011
  struct type *stored;
1012
  struct type_push *next;
1013
};
1014
 
1015
static struct type_push *tp_top = NULL;
1016
 
1017
static void
1018
push_current_type (void)
1019
{
1020
  struct type_push *tpnew;
1021
  tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1022
  tpnew->next = tp_top;
1023
  tpnew->stored = current_type;
1024
  current_type = NULL;
1025
  tp_top = tpnew;
1026
}
1027
 
1028
static void
1029
pop_current_type (void)
1030
{
1031
  struct type_push *tp = tp_top;
1032
  if (tp)
1033
    {
1034
      current_type = tp->stored;
1035
      tp_top = tp->next;
1036
      xfree (tp);
1037
    }
1038
}
1039
 
1040
struct token
1041
{
1042
  char *operator;
1043
  int token;
1044
  enum exp_opcode opcode;
1045
};
1046
 
1047
static const struct token tokentab3[] =
1048
  {
1049
    {"shr", RSH, BINOP_END},
1050
    {"shl", LSH, BINOP_END},
1051
    {"and", ANDAND, BINOP_END},
1052
    {"div", DIV, BINOP_END},
1053
    {"not", NOT, BINOP_END},
1054
    {"mod", MOD, BINOP_END},
1055
    {"inc", INCREMENT, BINOP_END},
1056
    {"dec", DECREMENT, BINOP_END},
1057
    {"xor", XOR, BINOP_END}
1058
  };
1059
 
1060
static const struct token tokentab2[] =
1061
  {
1062
    {"or", OR, BINOP_END},
1063
    {"<>", NOTEQUAL, BINOP_END},
1064
    {"<=", LEQ, BINOP_END},
1065
    {">=", GEQ, BINOP_END},
1066
    {":=", ASSIGN, BINOP_END},
1067
    {"::", COLONCOLON, BINOP_END} };
1068
 
1069
/* Allocate uppercased var */
1070
/* make an uppercased copy of tokstart */
1071
static char * uptok (tokstart, namelen)
1072
  char *tokstart;
1073
  int namelen;
1074
{
1075
  int i;
1076
  char *uptokstart = (char *)malloc(namelen+1);
1077
  for (i = 0;i <= namelen;i++)
1078
    {
1079
      if ((tokstart[i]>='a' && tokstart[i]<='z'))
1080
        uptokstart[i] = tokstart[i]-('a'-'A');
1081
      else
1082
        uptokstart[i] = tokstart[i];
1083
    }
1084
  uptokstart[namelen]='\0';
1085
  return uptokstart;
1086
}
1087
/* Read one token, getting characters through lexptr.  */
1088
 
1089
 
1090
static int
1091
yylex ()
1092
{
1093
  int c;
1094
  int namelen;
1095
  unsigned int i;
1096
  char *tokstart;
1097
  char *uptokstart;
1098
  char *tokptr;
1099
  char *p;
1100
  int explen, tempbufindex;
1101
  static char *tempbuf;
1102
  static int tempbufsize;
1103
 
1104
 retry:
1105
 
1106
  prev_lexptr = lexptr;
1107
 
1108
  tokstart = lexptr;
1109
  explen = strlen (lexptr);
1110
  /* See if it is a special token of length 3.  */
1111
  if (explen > 2)
1112
    for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1113
      if (strncasecmp (tokstart, tokentab3[i].operator, 3) == 0
1114
          && (!isalpha (tokentab3[i].operator[0]) || explen == 3
1115
              || (!isalpha (tokstart[3]) && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1116
        {
1117
          lexptr += 3;
1118
          yylval.opcode = tokentab3[i].opcode;
1119
          return tokentab3[i].token;
1120
        }
1121
 
1122
  /* See if it is a special token of length 2.  */
1123
  if (explen > 1)
1124
  for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1125
      if (strncasecmp (tokstart, tokentab2[i].operator, 2) == 0
1126
          && (!isalpha (tokentab2[i].operator[0]) || explen == 2
1127
              || (!isalpha (tokstart[2]) && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1128
        {
1129
          lexptr += 2;
1130
          yylval.opcode = tokentab2[i].opcode;
1131
          return tokentab2[i].token;
1132
        }
1133
 
1134
  switch (c = *tokstart)
1135
    {
1136
    case 0:
1137
      return 0;
1138
 
1139
    case ' ':
1140
    case '\t':
1141
    case '\n':
1142
      lexptr++;
1143
      goto retry;
1144
 
1145
    case '\'':
1146
      /* We either have a character constant ('0' or '\177' for example)
1147
         or we have a quoted symbol reference ('foo(int,int)' in object pascal
1148
         for example). */
1149
      lexptr++;
1150
      c = *lexptr++;
1151
      if (c == '\\')
1152
        c = parse_escape (&lexptr);
1153
      else if (c == '\'')
1154
        error ("Empty character constant.");
1155
 
1156
      yylval.typed_val_int.val = c;
1157
      yylval.typed_val_int.type = builtin_type_char;
1158
 
1159
      c = *lexptr++;
1160
      if (c != '\'')
1161
        {
1162
          namelen = skip_quoted (tokstart) - tokstart;
1163
          if (namelen > 2)
1164
            {
1165
              lexptr = tokstart + namelen;
1166
              if (lexptr[-1] != '\'')
1167
                error ("Unmatched single quote.");
1168
              namelen -= 2;
1169
              tokstart++;
1170
              uptokstart = uptok(tokstart,namelen);
1171
              goto tryname;
1172
            }
1173
          error ("Invalid character constant.");
1174
        }
1175
      return INT;
1176
 
1177
    case '(':
1178
      paren_depth++;
1179
      lexptr++;
1180
      return c;
1181
 
1182
    case ')':
1183
      if (paren_depth == 0)
1184
        return 0;
1185
      paren_depth--;
1186
      lexptr++;
1187
      return c;
1188
 
1189
    case ',':
1190
      if (comma_terminates && paren_depth == 0)
1191
        return 0;
1192
      lexptr++;
1193
      return c;
1194
 
1195
    case '.':
1196
      /* Might be a floating point number.  */
1197
      if (lexptr[1] < '0' || lexptr[1] > '9')
1198
        goto symbol;            /* Nope, must be a symbol. */
1199
      /* FALL THRU into number case.  */
1200
 
1201
    case '0':
1202
    case '1':
1203
    case '2':
1204
    case '3':
1205
    case '4':
1206
    case '5':
1207
    case '6':
1208
    case '7':
1209
    case '8':
1210
    case '9':
1211
      {
1212
        /* It's a number.  */
1213
        int got_dot = 0, got_e = 0, toktype;
1214
        char *p = tokstart;
1215
        int hex = input_radix > 10;
1216
 
1217
        if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1218
          {
1219
            p += 2;
1220
            hex = 1;
1221
          }
1222
        else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1223
          {
1224
            p += 2;
1225
            hex = 0;
1226
          }
1227
 
1228
        for (;; ++p)
1229
          {
1230
            /* This test includes !hex because 'e' is a valid hex digit
1231
               and thus does not indicate a floating point number when
1232
               the radix is hex.  */
1233
            if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1234
              got_dot = got_e = 1;
1235
            /* This test does not include !hex, because a '.' always indicates
1236
               a decimal floating point number regardless of the radix.  */
1237
            else if (!got_dot && *p == '.')
1238
              got_dot = 1;
1239
            else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1240
                     && (*p == '-' || *p == '+'))
1241
              /* This is the sign of the exponent, not the end of the
1242
                 number.  */
1243
              continue;
1244
            /* We will take any letters or digits.  parse_number will
1245
               complain if past the radix, or if L or U are not final.  */
1246
            else if ((*p < '0' || *p > '9')
1247
                     && ((*p < 'a' || *p > 'z')
1248
                                  && (*p < 'A' || *p > 'Z')))
1249
              break;
1250
          }
1251
        toktype = parse_number (tokstart, p - tokstart, got_dot|got_e, &yylval);
1252
        if (toktype == ERROR)
1253
          {
1254
            char *err_copy = (char *) alloca (p - tokstart + 1);
1255
 
1256
            memcpy (err_copy, tokstart, p - tokstart);
1257
            err_copy[p - tokstart] = 0;
1258
            error ("Invalid number \"%s\".", err_copy);
1259
          }
1260
        lexptr = p;
1261
        return toktype;
1262
      }
1263
 
1264
    case '+':
1265
    case '-':
1266
    case '*':
1267
    case '/':
1268
    case '|':
1269
    case '&':
1270
    case '^':
1271
    case '~':
1272
    case '!':
1273
    case '@':
1274
    case '<':
1275
    case '>':
1276
    case '[':
1277
    case ']':
1278
    case '?':
1279
    case ':':
1280
    case '=':
1281
    case '{':
1282
    case '}':
1283
    symbol:
1284
      lexptr++;
1285
      return c;
1286
 
1287
    case '"':
1288
 
1289
      /* Build the gdb internal form of the input string in tempbuf,
1290
         translating any standard C escape forms seen.  Note that the
1291
         buffer is null byte terminated *only* for the convenience of
1292
         debugging gdb itself and printing the buffer contents when
1293
         the buffer contains no embedded nulls.  Gdb does not depend
1294
         upon the buffer being null byte terminated, it uses the length
1295
         string instead.  This allows gdb to handle C strings (as well
1296
         as strings in other languages) with embedded null bytes */
1297
 
1298
      tokptr = ++tokstart;
1299
      tempbufindex = 0;
1300
 
1301
      do {
1302
        /* Grow the static temp buffer if necessary, including allocating
1303
           the first one on demand. */
1304
        if (tempbufindex + 1 >= tempbufsize)
1305
          {
1306
            tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1307
          }
1308
 
1309
        switch (*tokptr)
1310
          {
1311
          case '\0':
1312
          case '"':
1313
            /* Do nothing, loop will terminate. */
1314
            break;
1315
          case '\\':
1316
            tokptr++;
1317
            c = parse_escape (&tokptr);
1318
            if (c == -1)
1319
              {
1320
                continue;
1321
              }
1322
            tempbuf[tempbufindex++] = c;
1323
            break;
1324
          default:
1325
            tempbuf[tempbufindex++] = *tokptr++;
1326
            break;
1327
          }
1328
      } while ((*tokptr != '"') && (*tokptr != '\0'));
1329
      if (*tokptr++ != '"')
1330
        {
1331
          error ("Unterminated string in expression.");
1332
        }
1333
      tempbuf[tempbufindex] = '\0';     /* See note above */
1334
      yylval.sval.ptr = tempbuf;
1335
      yylval.sval.length = tempbufindex;
1336
      lexptr = tokptr;
1337
      return (STRING);
1338
    }
1339
 
1340
  if (!(c == '_' || c == '$'
1341
        || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1342
    /* We must have come across a bad character (e.g. ';').  */
1343
    error ("Invalid character '%c' in expression.", c);
1344
 
1345
  /* It's a name.  See how long it is.  */
1346
  namelen = 0;
1347
  for (c = tokstart[namelen];
1348
       (c == '_' || c == '$' || (c >= '0' && c <= '9')
1349
        || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1350
    {
1351
      /* Template parameter lists are part of the name.
1352
         FIXME: This mishandles `print $a<4&&$a>3'.  */
1353
      if (c == '<')
1354
        {
1355
          int i = namelen;
1356
          int nesting_level = 1;
1357
          while (tokstart[++i])
1358
            {
1359
              if (tokstart[i] == '<')
1360
                nesting_level++;
1361
              else if (tokstart[i] == '>')
1362
                {
1363
                  if (--nesting_level == 0)
1364
                    break;
1365
                }
1366
            }
1367
          if (tokstart[i] == '>')
1368
            namelen = i;
1369
          else
1370
            break;
1371
        }
1372
 
1373
      /* do NOT uppercase internals because of registers !!! */
1374
      c = tokstart[++namelen];
1375
    }
1376
 
1377
  uptokstart = uptok(tokstart,namelen);
1378
 
1379
  /* The token "if" terminates the expression and is NOT
1380
     removed from the input stream.  */
1381
  if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1382
    {
1383
      free (uptokstart);
1384
      return 0;
1385
    }
1386
 
1387
  lexptr += namelen;
1388
 
1389
  tryname:
1390
 
1391
  /* Catch specific keywords.  Should be done with a data structure.  */
1392
  switch (namelen)
1393
    {
1394
    case 6:
1395
      if (strcmp (uptokstart, "OBJECT") == 0)
1396
        {
1397
          free (uptokstart);
1398
          return CLASS;
1399
        }
1400
      if (strcmp (uptokstart, "RECORD") == 0)
1401
        {
1402
          free (uptokstart);
1403
          return STRUCT;
1404
        }
1405
      if (strcmp (uptokstart, "SIZEOF") == 0)
1406
        {
1407
          free (uptokstart);
1408
          return SIZEOF;
1409
        }
1410
      break;
1411
    case 5:
1412
      if (strcmp (uptokstart, "CLASS") == 0)
1413
        {
1414
          free (uptokstart);
1415
          return CLASS;
1416
        }
1417
      if (strcmp (uptokstart, "FALSE") == 0)
1418
        {
1419
          yylval.lval = 0;
1420
          free (uptokstart);
1421
          return FALSEKEYWORD;
1422
        }
1423
      break;
1424
    case 4:
1425
      if (strcmp (uptokstart, "TRUE") == 0)
1426
        {
1427
          yylval.lval = 1;
1428
          free (uptokstart);
1429
          return TRUEKEYWORD;
1430
        }
1431
      if (strcmp (uptokstart, "SELF") == 0)
1432
        {
1433
          /* here we search for 'this' like
1434
             inserted in FPC stabs debug info */
1435
          static const char this_name[] = "this";
1436
 
1437
          if (lookup_symbol (this_name, expression_context_block,
1438
                             VAR_DOMAIN, (int *) NULL,
1439
                             (struct symtab **) NULL))
1440
            {
1441
              free (uptokstart);
1442
              return THIS;
1443
            }
1444
        }
1445
      break;
1446
    default:
1447
      break;
1448
    }
1449
 
1450
  yylval.sval.ptr = tokstart;
1451
  yylval.sval.length = namelen;
1452
 
1453
  if (*tokstart == '$')
1454
    {
1455
      /* $ is the normal prefix for pascal hexadecimal values
1456
        but this conflicts with the GDB use for debugger variables
1457
        so in expression to enter hexadecimal values
1458
        we still need to use C syntax with 0xff  */
1459
      write_dollar_variable (yylval.sval);
1460
      free (uptokstart);
1461
      return VARIABLE;
1462
    }
1463
 
1464
  /* Use token-type BLOCKNAME for symbols that happen to be defined as
1465
     functions or symtabs.  If this is not so, then ...
1466
     Use token-type TYPENAME for symbols that happen to be defined
1467
     currently as names of types; NAME for other symbols.
1468
     The caller is not constrained to care about the distinction.  */
1469
  {
1470
    char *tmp = copy_name (yylval.sval);
1471
    struct symbol *sym;
1472
    int is_a_field_of_this = 0;
1473
    int is_a_field = 0;
1474
    int hextype;
1475
 
1476
 
1477
    if (search_field && current_type)
1478
      is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1479
    if (is_a_field)
1480
      sym = NULL;
1481
    else
1482
      sym = lookup_symbol (tmp, expression_context_block,
1483
                           VAR_DOMAIN,
1484
                           &is_a_field_of_this,
1485
                           (struct symtab **) NULL);
1486
    /* second chance uppercased (as Free Pascal does).  */
1487
    if (!sym && !is_a_field_of_this && !is_a_field)
1488
      {
1489
       for (i = 0; i <= namelen; i++)
1490
         {
1491
           if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1492
             tmp[i] -= ('a'-'A');
1493
         }
1494
       if (search_field && current_type)
1495
         is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1496
       if (is_a_field)
1497
         sym = NULL;
1498
       else
1499
         sym = lookup_symbol (tmp, expression_context_block,
1500
                        VAR_DOMAIN,
1501
                        &is_a_field_of_this,
1502
                        (struct symtab **) NULL);
1503
       if (sym || is_a_field_of_this || is_a_field)
1504
         for (i = 0; i <= namelen; i++)
1505
           {
1506
             if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1507
               tokstart[i] -= ('a'-'A');
1508
           }
1509
      }
1510
    /* Third chance Capitalized (as GPC does).  */
1511
    if (!sym && !is_a_field_of_this && !is_a_field)
1512
      {
1513
       for (i = 0; i <= namelen; i++)
1514
         {
1515
           if (i == 0)
1516
             {
1517
              if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1518
                tmp[i] -= ('a'-'A');
1519
             }
1520
           else
1521
           if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1522
             tmp[i] -= ('A'-'a');
1523
          }
1524
       if (search_field && current_type)
1525
         is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1526
       if (is_a_field)
1527
         sym = NULL;
1528
       else
1529
         sym = lookup_symbol (tmp, expression_context_block,
1530
                         VAR_DOMAIN,
1531
                         &is_a_field_of_this,
1532
                         (struct symtab **) NULL);
1533
       if (sym || is_a_field_of_this || is_a_field)
1534
          for (i = 0; i <= namelen; i++)
1535
            {
1536
              if (i == 0)
1537
                {
1538
                  if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1539
                    tokstart[i] -= ('a'-'A');
1540
                }
1541
              else
1542
                if ((tokstart[i] >= 'A' && tokstart[i] <= 'Z'))
1543
                  tokstart[i] -= ('A'-'a');
1544
            }
1545
      }
1546
 
1547
    if (is_a_field)
1548
      {
1549
        tempbuf = (char *) realloc (tempbuf, namelen + 1);
1550
        strncpy (tempbuf, tokstart, namelen); tempbuf [namelen] = 0;
1551
        yylval.sval.ptr = tempbuf;
1552
        yylval.sval.length = namelen;
1553
        free (uptokstart);
1554
        return FIELDNAME;
1555
      }
1556
    /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1557
       no psymtabs (coff, xcoff, or some future change to blow away the
1558
       psymtabs once once symbols are read).  */
1559
    if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1560
        || lookup_symtab (tmp))
1561
      {
1562
        yylval.ssym.sym = sym;
1563
        yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1564
        free (uptokstart);
1565
        return BLOCKNAME;
1566
      }
1567
    if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1568
        {
1569
#if 1
1570
          /* Despite the following flaw, we need to keep this code enabled.
1571
             Because we can get called from check_stub_method, if we don't
1572
             handle nested types then it screws many operations in any
1573
             program which uses nested types.  */
1574
          /* In "A::x", if x is a member function of A and there happens
1575
             to be a type (nested or not, since the stabs don't make that
1576
             distinction) named x, then this code incorrectly thinks we
1577
             are dealing with nested types rather than a member function.  */
1578
 
1579
          char *p;
1580
          char *namestart;
1581
          struct symbol *best_sym;
1582
 
1583
          /* Look ahead to detect nested types.  This probably should be
1584
             done in the grammar, but trying seemed to introduce a lot
1585
             of shift/reduce and reduce/reduce conflicts.  It's possible
1586
             that it could be done, though.  Or perhaps a non-grammar, but
1587
             less ad hoc, approach would work well.  */
1588
 
1589
          /* Since we do not currently have any way of distinguishing
1590
             a nested type from a non-nested one (the stabs don't tell
1591
             us whether a type is nested), we just ignore the
1592
             containing type.  */
1593
 
1594
          p = lexptr;
1595
          best_sym = sym;
1596
          while (1)
1597
            {
1598
              /* Skip whitespace.  */
1599
              while (*p == ' ' || *p == '\t' || *p == '\n')
1600
                ++p;
1601
              if (*p == ':' && p[1] == ':')
1602
                {
1603
                  /* Skip the `::'.  */
1604
                  p += 2;
1605
                  /* Skip whitespace.  */
1606
                  while (*p == ' ' || *p == '\t' || *p == '\n')
1607
                    ++p;
1608
                  namestart = p;
1609
                  while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1610
                         || (*p >= 'a' && *p <= 'z')
1611
                         || (*p >= 'A' && *p <= 'Z'))
1612
                    ++p;
1613
                  if (p != namestart)
1614
                    {
1615
                      struct symbol *cur_sym;
1616
                      /* As big as the whole rest of the expression, which is
1617
                         at least big enough.  */
1618
                      char *ncopy = alloca (strlen (tmp)+strlen (namestart)+3);
1619
                      char *tmp1;
1620
 
1621
                      tmp1 = ncopy;
1622
                      memcpy (tmp1, tmp, strlen (tmp));
1623
                      tmp1 += strlen (tmp);
1624
                      memcpy (tmp1, "::", 2);
1625
                      tmp1 += 2;
1626
                      memcpy (tmp1, namestart, p - namestart);
1627
                      tmp1[p - namestart] = '\0';
1628
                      cur_sym = lookup_symbol (ncopy, expression_context_block,
1629
                                               VAR_DOMAIN, (int *) NULL,
1630
                                               (struct symtab **) NULL);
1631
                      if (cur_sym)
1632
                        {
1633
                          if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1634
                            {
1635
                              best_sym = cur_sym;
1636
                              lexptr = p;
1637
                            }
1638
                          else
1639
                            break;
1640
                        }
1641
                      else
1642
                        break;
1643
                    }
1644
                  else
1645
                    break;
1646
                }
1647
              else
1648
                break;
1649
            }
1650
 
1651
          yylval.tsym.type = SYMBOL_TYPE (best_sym);
1652
#else /* not 0 */
1653
          yylval.tsym.type = SYMBOL_TYPE (sym);
1654
#endif /* not 0 */
1655
          free (uptokstart);
1656
          return TYPENAME;
1657
        }
1658
    yylval.tsym.type
1659
      = language_lookup_primitive_type_by_name (current_language,
1660
                                                current_gdbarch, tmp);
1661
    if (yylval.tsym.type != NULL)
1662
      {
1663
        free (uptokstart);
1664
        return TYPENAME;
1665
      }
1666
 
1667
    /* Input names that aren't symbols but ARE valid hex numbers,
1668
       when the input radix permits them, can be names or numbers
1669
       depending on the parse.  Note we support radixes > 16 here.  */
1670
    if (!sym
1671
        && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1672
            || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1673
      {
1674
        YYSTYPE newlval;        /* Its value is ignored.  */
1675
        hextype = parse_number (tokstart, namelen, 0, &newlval);
1676
        if (hextype == INT)
1677
          {
1678
            yylval.ssym.sym = sym;
1679
            yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1680
            free (uptokstart);
1681
            return NAME_OR_INT;
1682
          }
1683
      }
1684
 
1685
    free(uptokstart);
1686
    /* Any other kind of symbol */
1687
    yylval.ssym.sym = sym;
1688
    yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1689
    return NAME;
1690
  }
1691
}
1692
 
1693
void
1694
yyerror (msg)
1695
     char *msg;
1696
{
1697
  if (prev_lexptr)
1698
    lexptr = prev_lexptr;
1699
 
1700
  error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
1701
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.