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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-6.8/] [gdb/] [f-exp.y] - Blame information for rev 258

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

Line No. Rev Author Line
1 24 jeremybenn
/* YACC parser for Fortran expressions, for GDB.
2
   Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1995, 1996, 2000, 2001,
3
   2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
4
 
5
   Contributed by Motorola.  Adapted from the C parser by Farooq Butt
6
   (fmbutt@engage.sps.mot.com).
7
 
8
This file is part of GDB.
9
 
10
This program is free software; you can redistribute it and/or modify
11
it under the terms of the GNU General Public License as published by
12
the Free Software Foundation; either version 2 of the License, or
13
(at your option) any later version.
14
 
15
This program is distributed in the hope that it will be useful,
16
but WITHOUT ANY WARRANTY; without even the implied warranty of
17
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18
GNU General Public License for more details.
19
 
20
You should have received a copy of the GNU General Public License
21
along with this program; if not, write to the Free Software
22
Foundation, Inc., 51 Franklin Street, Fifth Floor,
23
Boston, MA 02110-1301, USA.  */
24
 
25
/* This was blantantly ripped off the C expression parser, please
26
   be aware of that as you look at its basic structure -FMB */
27
 
28
/* Parse a F77 expression from text in a string,
29
   and return the result as a  struct expression  pointer.
30
   That structure contains arithmetic operations in reverse polish,
31
   with constants represented by operations that are followed by special data.
32
   See expression.h for the details of the format.
33
   What is important here is that it can be built up sequentially
34
   during the process of parsing; the lower levels of the tree always
35
   come first in the result.
36
 
37
   Note that malloc's and realloc's in this file are transformed to
38
   xmalloc and xrealloc respectively by the same sed command in the
39
   makefile that remaps any other malloc/realloc inserted by the parser
40
   generator.  Doing this with #defines and trying to control the interaction
41
   with include files ( and  for example) just became
42
   too messy, particularly when such includes can be inserted at random
43
   times by the parser generator.  */
44
 
45
%{
46
 
47
#include "defs.h"
48
#include "gdb_string.h"
49
#include "expression.h"
50
#include "value.h"
51
#include "parser-defs.h"
52
#include "language.h"
53
#include "f-lang.h"
54
#include "bfd.h" /* Required by objfiles.h.  */
55
#include "symfile.h" /* Required by objfiles.h.  */
56
#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
57
#include "block.h"
58
#include 
59
 
60
/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
61
   as well as gratuitiously global symbol names, so we can have multiple
62
   yacc generated parsers in gdb.  Note that these are only the variables
63
   produced by yacc.  If other parser generators (bison, byacc, etc) produce
64
   additional global names that conflict at link time, then those parser
65
   generators need to be fixed instead of adding those names to this list. */
66
 
67
#define yymaxdepth f_maxdepth
68
#define yyparse f_parse
69
#define yylex   f_lex
70
#define yyerror f_error
71
#define yylval  f_lval
72
#define yychar  f_char
73
#define yydebug f_debug
74
#define yypact  f_pact
75
#define yyr1    f_r1
76
#define yyr2    f_r2
77
#define yydef   f_def
78
#define yychk   f_chk
79
#define yypgo   f_pgo
80
#define yyact   f_act
81
#define yyexca  f_exca
82
#define yyerrflag f_errflag
83
#define yynerrs f_nerrs
84
#define yyps    f_ps
85
#define yypv    f_pv
86
#define yys     f_s
87
#define yy_yys  f_yys
88
#define yystate f_state
89
#define yytmp   f_tmp
90
#define yyv     f_v
91
#define yy_yyv  f_yyv
92
#define yyval   f_val
93
#define yylloc  f_lloc
94
#define yyreds  f_reds          /* With YYDEBUG defined */
95
#define yytoks  f_toks          /* With YYDEBUG defined */
96
#define yyname  f_name          /* With YYDEBUG defined */
97
#define yyrule  f_rule          /* With YYDEBUG defined */
98
#define yylhs   f_yylhs
99
#define yylen   f_yylen
100
#define yydefred f_yydefred
101
#define yydgoto f_yydgoto
102
#define yysindex f_yysindex
103
#define yyrindex f_yyrindex
104
#define yygindex f_yygindex
105
#define yytable  f_yytable
106
#define yycheck  f_yycheck
107
 
108
#ifndef YYDEBUG
109
#define YYDEBUG 1               /* Default to yydebug support */
110
#endif
111
 
112
#define YYFPRINTF parser_fprintf
113
 
114
int yyparse (void);
115
 
116
static int yylex (void);
117
 
118
void yyerror (char *);
119
 
120
static void growbuf_by_size (int);
121
 
122
static int match_string_literal (void);
123
 
124
%}
125
 
126
/* Although the yacc "value" of an expression is not used,
127
   since the result is stored in the structure being created,
128
   other node types do have values.  */
129
 
130
%union
131
  {
132
    LONGEST lval;
133
    struct {
134
      LONGEST val;
135
      struct type *type;
136
    } typed_val;
137
    DOUBLEST dval;
138
    struct symbol *sym;
139
    struct type *tval;
140
    struct stoken sval;
141
    struct ttype tsym;
142
    struct symtoken ssym;
143
    int voidval;
144
    struct block *bval;
145
    enum exp_opcode opcode;
146
    struct internalvar *ivar;
147
 
148
    struct type **tvec;
149
    int *ivec;
150
  }
151
 
152
%{
153
/* YYSTYPE gets defined by %union */
154
static int parse_number (char *, int, int, YYSTYPE *);
155
%}
156
 
157
%type  exp  type_exp start variable
158
%type  type typebase
159
%type  nonempty_typelist
160
/* %type  block */
161
 
162
/* Fancy type parsing.  */
163
%type  func_mod direct_abs_decl abs_decl
164
%type  ptype
165
 
166
%token  INT
167
%token  FLOAT
168
 
169
/* Both NAME and TYPENAME tokens represent symbols in the input,
170
   and both convey their data as strings.
171
   But a TYPENAME is a string that happens to be defined as a typedef
172
   or builtin type name (such as int or char)
173
   and a NAME is any other symbol.
174
   Contexts where this distinction is not important can use the
175
   nonterminal "name", which matches either NAME or TYPENAME.  */
176
 
177
%token  STRING_LITERAL
178
%token  BOOLEAN_LITERAL
179
%token  NAME
180
%token  TYPENAME
181
%type  name
182
%type  name_not_typename
183
 
184
/* A NAME_OR_INT is a symbol which is not known in the symbol table,
185
   but which would parse as a valid number in the current input radix.
186
   E.g. "c" when input_radix==16.  Depending on the parse, it will be
187
   turned into a name or into a number.  */
188
 
189
%token  NAME_OR_INT
190
 
191
%token  SIZEOF
192
%token ERROR
193
 
194
/* Special type cases, put in to allow the parser to distinguish different
195
   legal basetypes.  */
196
%token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
197
%token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
198
%token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
199
%token BOOL_AND BOOL_OR BOOL_NOT
200
%token  CHARACTER
201
 
202
%token  VARIABLE
203
 
204
%token  ASSIGN_MODIFY
205
 
206
%left ','
207
%left ABOVE_COMMA
208
%right '=' ASSIGN_MODIFY
209
%right '?'
210
%left BOOL_OR
211
%right BOOL_NOT
212
%left BOOL_AND
213
%left '|'
214
%left '^'
215
%left '&'
216
%left EQUAL NOTEQUAL
217
%left LESSTHAN GREATERTHAN LEQ GEQ
218
%left LSH RSH
219
%left '@'
220
%left '+' '-'
221
%left '*' '/'
222
%right STARSTAR
223
%right '%'
224
%right UNARY
225
%right '('
226
 
227
 
228
%%
229
 
230
start   :       exp
231
        |       type_exp
232
        ;
233
 
234
type_exp:       type
235
                        { write_exp_elt_opcode(OP_TYPE);
236
                          write_exp_elt_type($1);
237
                          write_exp_elt_opcode(OP_TYPE); }
238
        ;
239
 
240
exp     :       '(' exp ')'
241
                        { }
242
        ;
243
 
244
/* Expressions, not including the comma operator.  */
245
exp     :       '*' exp    %prec UNARY
246
                        { write_exp_elt_opcode (UNOP_IND); }
247
        ;
248
 
249
exp     :       '&' exp    %prec UNARY
250
                        { write_exp_elt_opcode (UNOP_ADDR); }
251
        ;
252
 
253
exp     :       '-' exp    %prec UNARY
254
                        { write_exp_elt_opcode (UNOP_NEG); }
255
        ;
256
 
257
exp     :       BOOL_NOT exp    %prec UNARY
258
                        { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
259
        ;
260
 
261
exp     :       '~' exp    %prec UNARY
262
                        { write_exp_elt_opcode (UNOP_COMPLEMENT); }
263
        ;
264
 
265
exp     :       SIZEOF exp       %prec UNARY
266
                        { write_exp_elt_opcode (UNOP_SIZEOF); }
267
        ;
268
 
269
/* No more explicit array operators, we treat everything in F77 as
270
   a function call.  The disambiguation as to whether we are
271
   doing a subscript operation or a function call is done
272
   later in eval.c.  */
273
 
274
exp     :       exp '('
275
                        { start_arglist (); }
276
                arglist ')'
277
                        { write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST);
278
                          write_exp_elt_longcst ((LONGEST) end_arglist ());
279
                          write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); }
280
        ;
281
 
282
arglist :
283
        ;
284
 
285
arglist :       exp
286
                        { arglist_len = 1; }
287
        ;
288
 
289
arglist :       subrange
290
                        { arglist_len = 1; }
291
        ;
292
 
293
arglist :       arglist ',' exp   %prec ABOVE_COMMA
294
                        { arglist_len++; }
295
        ;
296
 
297
/* There are four sorts of subrange types in F90.  */
298
 
299
subrange:       exp ':' exp     %prec ABOVE_COMMA
300
                        { write_exp_elt_opcode (OP_F90_RANGE);
301
                          write_exp_elt_longcst (NONE_BOUND_DEFAULT);
302
                          write_exp_elt_opcode (OP_F90_RANGE); }
303
        ;
304
 
305
subrange:       exp ':' %prec ABOVE_COMMA
306
                        { write_exp_elt_opcode (OP_F90_RANGE);
307
                          write_exp_elt_longcst (HIGH_BOUND_DEFAULT);
308
                          write_exp_elt_opcode (OP_F90_RANGE); }
309
        ;
310
 
311
subrange:       ':' exp %prec ABOVE_COMMA
312
                        { write_exp_elt_opcode (OP_F90_RANGE);
313
                          write_exp_elt_longcst (LOW_BOUND_DEFAULT);
314
                          write_exp_elt_opcode (OP_F90_RANGE); }
315
        ;
316
 
317
subrange:       ':'     %prec ABOVE_COMMA
318
                        { write_exp_elt_opcode (OP_F90_RANGE);
319
                          write_exp_elt_longcst (BOTH_BOUND_DEFAULT);
320
                          write_exp_elt_opcode (OP_F90_RANGE); }
321
        ;
322
 
323
complexnum:     exp ',' exp
324
                        { }
325
        ;
326
 
327
exp     :       '(' complexnum ')'
328
                        { write_exp_elt_opcode(OP_COMPLEX); }
329
        ;
330
 
331
exp     :       '(' type ')' exp  %prec UNARY
332
                        { write_exp_elt_opcode (UNOP_CAST);
333
                          write_exp_elt_type ($2);
334
                          write_exp_elt_opcode (UNOP_CAST); }
335
        ;
336
 
337
exp     :       exp '%' name
338
                        { write_exp_elt_opcode (STRUCTOP_STRUCT);
339
                          write_exp_string ($3);
340
                          write_exp_elt_opcode (STRUCTOP_STRUCT); }
341
        ;
342
 
343
/* Binary operators in order of decreasing precedence.  */
344
 
345
exp     :       exp '@' exp
346
                        { write_exp_elt_opcode (BINOP_REPEAT); }
347
        ;
348
 
349
exp     :       exp STARSTAR exp
350
                        { write_exp_elt_opcode (BINOP_EXP); }
351
        ;
352
 
353
exp     :       exp '*' exp
354
                        { write_exp_elt_opcode (BINOP_MUL); }
355
        ;
356
 
357
exp     :       exp '/' exp
358
                        { write_exp_elt_opcode (BINOP_DIV); }
359
        ;
360
 
361
exp     :       exp '+' exp
362
                        { write_exp_elt_opcode (BINOP_ADD); }
363
        ;
364
 
365
exp     :       exp '-' exp
366
                        { write_exp_elt_opcode (BINOP_SUB); }
367
        ;
368
 
369
exp     :       exp LSH exp
370
                        { write_exp_elt_opcode (BINOP_LSH); }
371
        ;
372
 
373
exp     :       exp RSH exp
374
                        { write_exp_elt_opcode (BINOP_RSH); }
375
        ;
376
 
377
exp     :       exp EQUAL exp
378
                        { write_exp_elt_opcode (BINOP_EQUAL); }
379
        ;
380
 
381
exp     :       exp NOTEQUAL exp
382
                        { write_exp_elt_opcode (BINOP_NOTEQUAL); }
383
        ;
384
 
385
exp     :       exp LEQ exp
386
                        { write_exp_elt_opcode (BINOP_LEQ); }
387
        ;
388
 
389
exp     :       exp GEQ exp
390
                        { write_exp_elt_opcode (BINOP_GEQ); }
391
        ;
392
 
393
exp     :       exp LESSTHAN exp
394
                        { write_exp_elt_opcode (BINOP_LESS); }
395
        ;
396
 
397
exp     :       exp GREATERTHAN exp
398
                        { write_exp_elt_opcode (BINOP_GTR); }
399
        ;
400
 
401
exp     :       exp '&' exp
402
                        { write_exp_elt_opcode (BINOP_BITWISE_AND); }
403
        ;
404
 
405
exp     :       exp '^' exp
406
                        { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
407
        ;
408
 
409
exp     :       exp '|' exp
410
                        { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
411
        ;
412
 
413
exp     :       exp BOOL_AND exp
414
                        { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
415
        ;
416
 
417
 
418
exp     :       exp BOOL_OR exp
419
                        { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
420
        ;
421
 
422
exp     :       exp '=' exp
423
                        { write_exp_elt_opcode (BINOP_ASSIGN); }
424
        ;
425
 
426
exp     :       exp ASSIGN_MODIFY exp
427
                        { write_exp_elt_opcode (BINOP_ASSIGN_MODIFY);
428
                          write_exp_elt_opcode ($2);
429
                          write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); }
430
        ;
431
 
432
exp     :       INT
433
                        { write_exp_elt_opcode (OP_LONG);
434
                          write_exp_elt_type ($1.type);
435
                          write_exp_elt_longcst ((LONGEST)($1.val));
436
                          write_exp_elt_opcode (OP_LONG); }
437
        ;
438
 
439
exp     :       NAME_OR_INT
440
                        { YYSTYPE val;
441
                          parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
442
                          write_exp_elt_opcode (OP_LONG);
443
                          write_exp_elt_type (val.typed_val.type);
444
                          write_exp_elt_longcst ((LONGEST)val.typed_val.val);
445
                          write_exp_elt_opcode (OP_LONG); }
446
        ;
447
 
448
exp     :       FLOAT
449
                        { write_exp_elt_opcode (OP_DOUBLE);
450
                          write_exp_elt_type (builtin_type_f_real_s8);
451
                          write_exp_elt_dblcst ($1);
452
                          write_exp_elt_opcode (OP_DOUBLE); }
453
        ;
454
 
455
exp     :       variable
456
        ;
457
 
458
exp     :       VARIABLE
459
        ;
460
 
461
exp     :       SIZEOF '(' type ')'     %prec UNARY
462
                        { write_exp_elt_opcode (OP_LONG);
463
                          write_exp_elt_type (builtin_type_f_integer);
464
                          CHECK_TYPEDEF ($3);
465
                          write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
466
                          write_exp_elt_opcode (OP_LONG); }
467
        ;
468
 
469
exp     :       BOOLEAN_LITERAL
470
                        { write_exp_elt_opcode (OP_BOOL);
471
                          write_exp_elt_longcst ((LONGEST) $1);
472
                          write_exp_elt_opcode (OP_BOOL);
473
                        }
474
        ;
475
 
476
exp     :       STRING_LITERAL
477
                        {
478
                          write_exp_elt_opcode (OP_STRING);
479
                          write_exp_string ($1);
480
                          write_exp_elt_opcode (OP_STRING);
481
                        }
482
        ;
483
 
484
variable:       name_not_typename
485
                        { struct symbol *sym = $1.sym;
486
 
487
                          if (sym)
488
                            {
489
                              if (symbol_read_needs_frame (sym))
490
                                {
491
                                  if (innermost_block == 0 ||
492
                                      contained_in (block_found,
493
                                                    innermost_block))
494
                                    innermost_block = block_found;
495
                                }
496
                              write_exp_elt_opcode (OP_VAR_VALUE);
497
                              /* We want to use the selected frame, not
498
                                 another more inner frame which happens to
499
                                 be in the same block.  */
500
                              write_exp_elt_block (NULL);
501
                              write_exp_elt_sym (sym);
502
                              write_exp_elt_opcode (OP_VAR_VALUE);
503
                              break;
504
                            }
505
                          else
506
                            {
507
                              struct minimal_symbol *msymbol;
508
                              char *arg = copy_name ($1.stoken);
509
 
510
                              msymbol =
511
                                lookup_minimal_symbol (arg, NULL, NULL);
512
                              if (msymbol != NULL)
513
                                {
514
                                  write_exp_msymbol (msymbol,
515
                                                     lookup_function_type (builtin_type_int),
516
                                                     builtin_type_int);
517
                                }
518
                              else if (!have_full_symbols () && !have_partial_symbols ())
519
                                error ("No symbol table is loaded.  Use the \"file\" command.");
520
                              else
521
                                error ("No symbol \"%s\" in current context.",
522
                                       copy_name ($1.stoken));
523
                            }
524
                        }
525
        ;
526
 
527
 
528
type    :       ptype
529
        ;
530
 
531
ptype   :       typebase
532
        |       typebase abs_decl
533
                {
534
                  /* This is where the interesting stuff happens.  */
535
                  int done = 0;
536
                  int array_size;
537
                  struct type *follow_type = $1;
538
                  struct type *range_type;
539
 
540
                  while (!done)
541
                    switch (pop_type ())
542
                      {
543
                      case tp_end:
544
                        done = 1;
545
                        break;
546
                      case tp_pointer:
547
                        follow_type = lookup_pointer_type (follow_type);
548
                        break;
549
                      case tp_reference:
550
                        follow_type = lookup_reference_type (follow_type);
551
                        break;
552
                      case tp_array:
553
                        array_size = pop_type_int ();
554
                        if (array_size != -1)
555
                          {
556
                            range_type =
557
                              create_range_type ((struct type *) NULL,
558
                                                 builtin_type_f_integer, 0,
559
                                                 array_size - 1);
560
                            follow_type =
561
                              create_array_type ((struct type *) NULL,
562
                                                 follow_type, range_type);
563
                          }
564
                        else
565
                          follow_type = lookup_pointer_type (follow_type);
566
                        break;
567
                      case tp_function:
568
                        follow_type = lookup_function_type (follow_type);
569
                        break;
570
                      }
571
                  $$ = follow_type;
572
                }
573
        ;
574
 
575
abs_decl:       '*'
576
                        { push_type (tp_pointer); $$ = 0; }
577
        |       '*' abs_decl
578
                        { push_type (tp_pointer); $$ = $2; }
579
        |       '&'
580
                        { push_type (tp_reference); $$ = 0; }
581
        |       '&' abs_decl
582
                        { push_type (tp_reference); $$ = $2; }
583
        |       direct_abs_decl
584
        ;
585
 
586
direct_abs_decl: '(' abs_decl ')'
587
                        { $$ = $2; }
588
        |       direct_abs_decl func_mod
589
                        { push_type (tp_function); }
590
        |       func_mod
591
                        { push_type (tp_function); }
592
        ;
593
 
594
func_mod:       '(' ')'
595
                        { $$ = 0; }
596
        |       '(' nonempty_typelist ')'
597
                        { free ($2); $$ = 0; }
598
        ;
599
 
600
typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
601
        :       TYPENAME
602
                        { $$ = $1.type; }
603
        |       INT_KEYWORD
604
                        { $$ = builtin_type_f_integer; }
605
        |       INT_S2_KEYWORD
606
                        { $$ = builtin_type_f_integer_s2; }
607
        |       CHARACTER
608
                        { $$ = builtin_type_f_character; }
609
        |       LOGICAL_KEYWORD
610
                        { $$ = builtin_type_f_logical;}
611
        |       LOGICAL_S2_KEYWORD
612
                        { $$ = builtin_type_f_logical_s2;}
613
        |       LOGICAL_S1_KEYWORD
614
                        { $$ = builtin_type_f_logical_s1;}
615
        |       REAL_KEYWORD
616
                        { $$ = builtin_type_f_real;}
617
        |       REAL_S8_KEYWORD
618
                        { $$ = builtin_type_f_real_s8;}
619
        |       REAL_S16_KEYWORD
620
                        { $$ = builtin_type_f_real_s16;}
621
        |       COMPLEX_S8_KEYWORD
622
                        { $$ = builtin_type_f_complex_s8;}
623
        |       COMPLEX_S16_KEYWORD
624
                        { $$ = builtin_type_f_complex_s16;}
625
        |       COMPLEX_S32_KEYWORD
626
                        { $$ = builtin_type_f_complex_s32;}
627
        ;
628
 
629
nonempty_typelist
630
        :       type
631
                { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
632
                  $$[0] = 1;    /* Number of types in vector */
633
                  $$[1] = $1;
634
                }
635
        |       nonempty_typelist ',' type
636
                { int len = sizeof (struct type *) * (++($1[0]) + 1);
637
                  $$ = (struct type **) realloc ((char *) $1, len);
638
                  $$[$$[0]] = $3;
639
                }
640
        ;
641
 
642
name    :       NAME
643
                {  $$ = $1.stoken; }
644
        ;
645
 
646
name_not_typename :     NAME
647
/* These would be useful if name_not_typename was useful, but it is just
648
   a fake for "variable", so these cause reduce/reduce conflicts because
649
   the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
650
   =exp) or just an exp.  If name_not_typename was ever used in an lvalue
651
   context where only a name could occur, this might be useful.
652
        |       NAME_OR_INT
653
   */
654
        ;
655
 
656
%%
657
 
658
/* Take care of parsing a number (anything that starts with a digit).
659
   Set yylval and return the token type; update lexptr.
660
   LEN is the number of characters in it.  */
661
 
662
/*** Needs some error checking for the float case ***/
663
 
664
static int
665
parse_number (p, len, parsed_float, putithere)
666
     char *p;
667
     int len;
668
     int parsed_float;
669
     YYSTYPE *putithere;
670
{
671
  LONGEST n = 0;
672
  LONGEST prevn = 0;
673
  int c;
674
  int base = input_radix;
675
  int unsigned_p = 0;
676
  int long_p = 0;
677
  ULONGEST high_bit;
678
  struct type *signed_type;
679
  struct type *unsigned_type;
680
 
681
  if (parsed_float)
682
    {
683
      /* It's a float since it contains a point or an exponent.  */
684
      /* [dD] is not understood as an exponent by atof, change it to 'e'.  */
685
      char *tmp, *tmp2;
686
 
687
      tmp = xstrdup (p);
688
      for (tmp2 = tmp; *tmp2; ++tmp2)
689
        if (*tmp2 == 'd' || *tmp2 == 'D')
690
          *tmp2 = 'e';
691
      putithere->dval = atof (tmp);
692
      free (tmp);
693
      return FLOAT;
694
    }
695
 
696
  /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
697
  if (p[0] == '0')
698
    switch (p[1])
699
      {
700
      case 'x':
701
      case 'X':
702
        if (len >= 3)
703
          {
704
            p += 2;
705
            base = 16;
706
            len -= 2;
707
          }
708
        break;
709
 
710
      case 't':
711
      case 'T':
712
      case 'd':
713
      case 'D':
714
        if (len >= 3)
715
          {
716
            p += 2;
717
            base = 10;
718
            len -= 2;
719
          }
720
        break;
721
 
722
      default:
723
        base = 8;
724
        break;
725
      }
726
 
727
  while (len-- > 0)
728
    {
729
      c = *p++;
730
      if (isupper (c))
731
        c = tolower (c);
732
      if (len == 0 && c == 'l')
733
        long_p = 1;
734
      else if (len == 0 && c == 'u')
735
        unsigned_p = 1;
736
      else
737
        {
738
          int i;
739
          if (c >= '0' && c <= '9')
740
            i = c - '0';
741
          else if (c >= 'a' && c <= 'f')
742
            i = c - 'a' + 10;
743
          else
744
            return ERROR;       /* Char not a digit */
745
          if (i >= base)
746
            return ERROR;               /* Invalid digit in this base */
747
          n *= base;
748
          n += i;
749
        }
750
      /* Portably test for overflow (only works for nonzero values, so make
751
         a second check for zero).  */
752
      if ((prevn >= n) && n != 0)
753
        unsigned_p=1;           /* Try something unsigned */
754
      /* If range checking enabled, portably test for unsigned overflow.  */
755
      if (RANGE_CHECK && n != 0)
756
        {
757
          if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
758
            range_error("Overflow on numeric constant.");
759
        }
760
      prevn = n;
761
    }
762
 
763
  /* If the number is too big to be an int, or it's got an l suffix
764
     then it's a long.  Work out if this has to be a long by
765
     shifting right and and seeing if anything remains, and the
766
     target int size is different to the target long size.
767
 
768
     In the expression below, we could have tested
769
     (n >> gdbarch_int_bit (current_gdbarch))
770
     to see if it was zero,
771
     but too many compilers warn about that, when ints and longs
772
     are the same size.  So we shift it twice, with fewer bits
773
     each time, for the same result.  */
774
 
775
  if ((gdbarch_int_bit (current_gdbarch) != gdbarch_long_bit (current_gdbarch)
776
       && ((n >> 2)
777
           >> (gdbarch_int_bit (current_gdbarch)-2))) /* Avoid shift warning */
778
      || long_p)
779
    {
780
      high_bit = ((ULONGEST)1) << (gdbarch_long_bit (current_gdbarch)-1);
781
      unsigned_type = builtin_type_unsigned_long;
782
      signed_type = builtin_type_long;
783
    }
784
  else
785
    {
786
      high_bit = ((ULONGEST)1) << (gdbarch_int_bit (current_gdbarch)-1);
787
      unsigned_type = builtin_type_unsigned_int;
788
      signed_type = builtin_type_int;
789
    }
790
 
791
  putithere->typed_val.val = n;
792
 
793
  /* If the high bit of the worked out type is set then this number
794
     has to be unsigned. */
795
 
796
  if (unsigned_p || (n & high_bit))
797
    putithere->typed_val.type = unsigned_type;
798
  else
799
    putithere->typed_val.type = signed_type;
800
 
801
  return INT;
802
}
803
 
804
struct token
805
{
806
  char *operator;
807
  int token;
808
  enum exp_opcode opcode;
809
};
810
 
811
static const struct token dot_ops[] =
812
{
813
  { ".and.", BOOL_AND, BINOP_END },
814
  { ".AND.", BOOL_AND, BINOP_END },
815
  { ".or.", BOOL_OR, BINOP_END },
816
  { ".OR.", BOOL_OR, BINOP_END },
817
  { ".not.", BOOL_NOT, BINOP_END },
818
  { ".NOT.", BOOL_NOT, BINOP_END },
819
  { ".eq.", EQUAL, BINOP_END },
820
  { ".EQ.", EQUAL, BINOP_END },
821
  { ".eqv.", EQUAL, BINOP_END },
822
  { ".NEQV.", NOTEQUAL, BINOP_END },
823
  { ".neqv.", NOTEQUAL, BINOP_END },
824
  { ".EQV.", EQUAL, BINOP_END },
825
  { ".ne.", NOTEQUAL, BINOP_END },
826
  { ".NE.", NOTEQUAL, BINOP_END },
827
  { ".le.", LEQ, BINOP_END },
828
  { ".LE.", LEQ, BINOP_END },
829
  { ".ge.", GEQ, BINOP_END },
830
  { ".GE.", GEQ, BINOP_END },
831
  { ".gt.", GREATERTHAN, BINOP_END },
832
  { ".GT.", GREATERTHAN, BINOP_END },
833
  { ".lt.", LESSTHAN, BINOP_END },
834
  { ".LT.", LESSTHAN, BINOP_END },
835
  { NULL, 0, 0 }
836
};
837
 
838
struct f77_boolean_val
839
{
840
  char *name;
841
  int value;
842
};
843
 
844
static const struct f77_boolean_val boolean_values[]  =
845
{
846
  { ".true.", 1 },
847
  { ".TRUE.", 1 },
848
  { ".false.", 0 },
849
  { ".FALSE.", 0 },
850
  { NULL, 0 }
851
};
852
 
853
static const struct token f77_keywords[] =
854
{
855
  { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END },
856
  { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END },
857
  { "character", CHARACTER, BINOP_END },
858
  { "integer_2", INT_S2_KEYWORD, BINOP_END },
859
  { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END },
860
  { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END },
861
  { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END },
862
  { "integer", INT_KEYWORD, BINOP_END },
863
  { "logical", LOGICAL_KEYWORD, BINOP_END },
864
  { "real_16", REAL_S16_KEYWORD, BINOP_END },
865
  { "complex", COMPLEX_S8_KEYWORD, BINOP_END },
866
  { "sizeof", SIZEOF, BINOP_END },
867
  { "real_8", REAL_S8_KEYWORD, BINOP_END },
868
  { "real", REAL_KEYWORD, BINOP_END },
869
  { NULL, 0, 0 }
870
};
871
 
872
/* Implementation of a dynamically expandable buffer for processing input
873
   characters acquired through lexptr and building a value to return in
874
   yylval. Ripped off from ch-exp.y */
875
 
876
static char *tempbuf;           /* Current buffer contents */
877
static int tempbufsize;         /* Size of allocated buffer */
878
static int tempbufindex;        /* Current index into buffer */
879
 
880
#define GROWBY_MIN_SIZE 64      /* Minimum amount to grow buffer by */
881
 
882
#define CHECKBUF(size) \
883
  do { \
884
    if (tempbufindex + (size) >= tempbufsize) \
885
      { \
886
        growbuf_by_size (size); \
887
      } \
888
  } while (0);
889
 
890
 
891
/* Grow the static temp buffer if necessary, including allocating the first one
892
   on demand. */
893
 
894
static void
895
growbuf_by_size (count)
896
     int count;
897
{
898
  int growby;
899
 
900
  growby = max (count, GROWBY_MIN_SIZE);
901
  tempbufsize += growby;
902
  if (tempbuf == NULL)
903
    tempbuf = (char *) malloc (tempbufsize);
904
  else
905
    tempbuf = (char *) realloc (tempbuf, tempbufsize);
906
}
907
 
908
/* Blatantly ripped off from ch-exp.y. This routine recognizes F77
909
   string-literals.
910
 
911
   Recognize a string literal.  A string literal is a nonzero sequence
912
   of characters enclosed in matching single quotes, except that
913
   a single character inside single quotes is a character literal, which
914
   we reject as a string literal.  To embed the terminator character inside
915
   a string, it is simply doubled (I.E. 'this''is''one''string') */
916
 
917
static int
918
match_string_literal ()
919
{
920
  char *tokptr = lexptr;
921
 
922
  for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
923
    {
924
      CHECKBUF (1);
925
      if (*tokptr == *lexptr)
926
        {
927
          if (*(tokptr + 1) == *lexptr)
928
            tokptr++;
929
          else
930
            break;
931
        }
932
      tempbuf[tempbufindex++] = *tokptr;
933
    }
934
  if (*tokptr == '\0'                                   /* no terminator */
935
      || tempbufindex == 0)                             /* no string */
936
    return 0;
937
  else
938
    {
939
      tempbuf[tempbufindex] = '\0';
940
      yylval.sval.ptr = tempbuf;
941
      yylval.sval.length = tempbufindex;
942
      lexptr = ++tokptr;
943
      return STRING_LITERAL;
944
    }
945
}
946
 
947
/* Read one token, getting characters through lexptr.  */
948
 
949
static int
950
yylex ()
951
{
952
  int c;
953
  int namelen;
954
  unsigned int i,token;
955
  char *tokstart;
956
 
957
 retry:
958
 
959
  prev_lexptr = lexptr;
960
 
961
  tokstart = lexptr;
962
 
963
  /* First of all, let us make sure we are not dealing with the
964
     special tokens .true. and .false. which evaluate to 1 and 0.  */
965
 
966
  if (*lexptr == '.')
967
    {
968
      for (i = 0; boolean_values[i].name != NULL; i++)
969
        {
970
          if (strncmp (tokstart, boolean_values[i].name,
971
                       strlen (boolean_values[i].name)) == 0)
972
            {
973
              lexptr += strlen (boolean_values[i].name);
974
              yylval.lval = boolean_values[i].value;
975
              return BOOLEAN_LITERAL;
976
            }
977
        }
978
    }
979
 
980
  /* See if it is a special .foo. operator.  */
981
 
982
  for (i = 0; dot_ops[i].operator != NULL; i++)
983
    if (strncmp (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator)) == 0)
984
      {
985
        lexptr += strlen (dot_ops[i].operator);
986
        yylval.opcode = dot_ops[i].opcode;
987
        return dot_ops[i].token;
988
      }
989
 
990
  /* See if it is an exponentiation operator.  */
991
 
992
  if (strncmp (tokstart, "**", 2) == 0)
993
    {
994
      lexptr += 2;
995
      yylval.opcode = BINOP_EXP;
996
      return STARSTAR;
997
    }
998
 
999
  switch (c = *tokstart)
1000
    {
1001
    case 0:
1002
      return 0;
1003
 
1004
    case ' ':
1005
    case '\t':
1006
    case '\n':
1007
      lexptr++;
1008
      goto retry;
1009
 
1010
    case '\'':
1011
      token = match_string_literal ();
1012
      if (token != 0)
1013
        return (token);
1014
      break;
1015
 
1016
    case '(':
1017
      paren_depth++;
1018
      lexptr++;
1019
      return c;
1020
 
1021
    case ')':
1022
      if (paren_depth == 0)
1023
        return 0;
1024
      paren_depth--;
1025
      lexptr++;
1026
      return c;
1027
 
1028
    case ',':
1029
      if (comma_terminates && paren_depth == 0)
1030
        return 0;
1031
      lexptr++;
1032
      return c;
1033
 
1034
    case '.':
1035
      /* Might be a floating point number.  */
1036
      if (lexptr[1] < '0' || lexptr[1] > '9')
1037
        goto symbol;            /* Nope, must be a symbol. */
1038
      /* FALL THRU into number case.  */
1039
 
1040
    case '0':
1041
    case '1':
1042
    case '2':
1043
    case '3':
1044
    case '4':
1045
    case '5':
1046
    case '6':
1047
    case '7':
1048
    case '8':
1049
    case '9':
1050
      {
1051
        /* It's a number.  */
1052
        int got_dot = 0, got_e = 0, got_d = 0, toktype;
1053
        char *p = tokstart;
1054
        int hex = input_radix > 10;
1055
 
1056
        if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1057
          {
1058
            p += 2;
1059
            hex = 1;
1060
          }
1061
        else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1062
          {
1063
            p += 2;
1064
            hex = 0;
1065
          }
1066
 
1067
        for (;; ++p)
1068
          {
1069
            if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1070
              got_dot = got_e = 1;
1071
            else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1072
              got_dot = got_d = 1;
1073
            else if (!hex && !got_dot && *p == '.')
1074
              got_dot = 1;
1075
            else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1076
                     || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1077
                     && (*p == '-' || *p == '+'))
1078
              /* This is the sign of the exponent, not the end of the
1079
                 number.  */
1080
              continue;
1081
            /* We will take any letters or digits.  parse_number will
1082
               complain if past the radix, or if L or U are not final.  */
1083
            else if ((*p < '0' || *p > '9')
1084
                     && ((*p < 'a' || *p > 'z')
1085
                         && (*p < 'A' || *p > 'Z')))
1086
              break;
1087
          }
1088
        toktype = parse_number (tokstart, p - tokstart, got_dot|got_e|got_d,
1089
                                &yylval);
1090
        if (toktype == ERROR)
1091
          {
1092
            char *err_copy = (char *) alloca (p - tokstart + 1);
1093
 
1094
            memcpy (err_copy, tokstart, p - tokstart);
1095
            err_copy[p - tokstart] = 0;
1096
            error ("Invalid number \"%s\".", err_copy);
1097
          }
1098
        lexptr = p;
1099
        return toktype;
1100
      }
1101
 
1102
    case '+':
1103
    case '-':
1104
    case '*':
1105
    case '/':
1106
    case '%':
1107
    case '|':
1108
    case '&':
1109
    case '^':
1110
    case '~':
1111
    case '!':
1112
    case '@':
1113
    case '<':
1114
    case '>':
1115
    case '[':
1116
    case ']':
1117
    case '?':
1118
    case ':':
1119
    case '=':
1120
    case '{':
1121
    case '}':
1122
    symbol:
1123
      lexptr++;
1124
      return c;
1125
    }
1126
 
1127
  if (!(c == '_' || c == '$'
1128
        || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1129
    /* We must have come across a bad character (e.g. ';').  */
1130
    error ("Invalid character '%c' in expression.", c);
1131
 
1132
  namelen = 0;
1133
  for (c = tokstart[namelen];
1134
       (c == '_' || c == '$' || (c >= '0' && c <= '9')
1135
        || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1136
       c = tokstart[++namelen]);
1137
 
1138
  /* The token "if" terminates the expression and is NOT
1139
     removed from the input stream.  */
1140
 
1141
  if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1142
    return 0;
1143
 
1144
  lexptr += namelen;
1145
 
1146
  /* Catch specific keywords.  */
1147
 
1148
  for (i = 0; f77_keywords[i].operator != NULL; i++)
1149
    if (strncmp (tokstart, f77_keywords[i].operator,
1150
                 strlen(f77_keywords[i].operator)) == 0)
1151
      {
1152
        /*      lexptr += strlen(f77_keywords[i].operator); */
1153
        yylval.opcode = f77_keywords[i].opcode;
1154
        return f77_keywords[i].token;
1155
      }
1156
 
1157
  yylval.sval.ptr = tokstart;
1158
  yylval.sval.length = namelen;
1159
 
1160
  if (*tokstart == '$')
1161
    {
1162
      write_dollar_variable (yylval.sval);
1163
      return VARIABLE;
1164
    }
1165
 
1166
  /* Use token-type TYPENAME for symbols that happen to be defined
1167
     currently as names of types; NAME for other symbols.
1168
     The caller is not constrained to care about the distinction.  */
1169
  {
1170
    char *tmp = copy_name (yylval.sval);
1171
    struct symbol *sym;
1172
    int is_a_field_of_this = 0;
1173
    int hextype;
1174
 
1175
    sym = lookup_symbol (tmp, expression_context_block,
1176
                         VAR_DOMAIN,
1177
                         current_language->la_language == language_cplus
1178
                         ? &is_a_field_of_this : NULL,
1179
                         NULL);
1180
    if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1181
      {
1182
        yylval.tsym.type = SYMBOL_TYPE (sym);
1183
        return TYPENAME;
1184
      }
1185
    yylval.tsym.type
1186
      = language_lookup_primitive_type_by_name (current_language,
1187
                                                current_gdbarch, tmp);
1188
    if (yylval.tsym.type != NULL)
1189
      return TYPENAME;
1190
 
1191
    /* Input names that aren't symbols but ARE valid hex numbers,
1192
       when the input radix permits them, can be names or numbers
1193
       depending on the parse.  Note we support radixes > 16 here.  */
1194
    if (!sym
1195
        && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1196
            || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1197
      {
1198
        YYSTYPE newlval;        /* Its value is ignored.  */
1199
        hextype = parse_number (tokstart, namelen, 0, &newlval);
1200
        if (hextype == INT)
1201
          {
1202
            yylval.ssym.sym = sym;
1203
            yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1204
            return NAME_OR_INT;
1205
          }
1206
      }
1207
 
1208
    /* Any other kind of symbol */
1209
    yylval.ssym.sym = sym;
1210
    yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1211
    return NAME;
1212
  }
1213
}
1214
 
1215
void
1216
yyerror (msg)
1217
     char *msg;
1218
{
1219
  if (prev_lexptr)
1220
    lexptr = prev_lexptr;
1221
 
1222
  error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
1223
}

powered by: WebSVN 2.1.0

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