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

Subversion Repositories openrisc_me

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 227 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, 2009, 2010
4
   Free Software Foundation, Inc.
5
 
6
   Contributed by Motorola.  Adapted from the C parser by Farooq Butt
7
   (fmbutt@engage.sps.mot.com).
8
 
9
   This file is part of GDB.
10
 
11
   This program is free software; you can redistribute it and/or modify
12
   it under the terms of the GNU General Public License as published by
13
   the Free Software Foundation; either version 3 of the License, or
14
   (at your option) any later version.
15
 
16
   This program is distributed in the hope that it will be useful,
17
   but WITHOUT ANY WARRANTY; without even the implied warranty of
18
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19
   GNU General Public License for more details.
20
 
21
   You should have received a copy of the GNU General Public License
22
   along with this program.  If not, see .  */
23
 
24
/* This was blantantly ripped off the C expression parser, please
25
   be aware of that as you look at its basic structure -FMB */
26
 
27
/* Parse a F77 expression from text in a string,
28
   and return the result as a  struct expression  pointer.
29
   That structure contains arithmetic operations in reverse polish,
30
   with constants represented by operations that are followed by special data.
31
   See expression.h for the details of the format.
32
   What is important here is that it can be built up sequentially
33
   during the process of parsing; the lower levels of the tree always
34
   come first in the result.
35
 
36
   Note that malloc's and realloc's in this file are transformed to
37
   xmalloc and xrealloc respectively by the same sed command in the
38
   makefile that remaps any other malloc/realloc inserted by the parser
39
   generator.  Doing this with #defines and trying to control the interaction
40
   with include files ( and  for example) just became
41
   too messy, particularly when such includes can be inserted at random
42
   times by the parser generator.  */
43
 
44
%{
45
 
46
#include "defs.h"
47
#include "gdb_string.h"
48
#include "expression.h"
49
#include "value.h"
50
#include "parser-defs.h"
51
#include "language.h"
52
#include "f-lang.h"
53
#include "bfd.h" /* Required by objfiles.h.  */
54
#include "symfile.h" /* Required by objfiles.h.  */
55
#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
56
#include "block.h"
57
#include 
58
 
59
#define parse_type builtin_type (parse_gdbarch)
60
#define parse_f_type builtin_f_type (parse_gdbarch)
61
 
62
/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
63
   as well as gratuitiously global symbol names, so we can have multiple
64
   yacc generated parsers in gdb.  Note that these are only the variables
65
   produced by yacc.  If other parser generators (bison, byacc, etc) produce
66
   additional global names that conflict at link time, then those parser
67
   generators need to be fixed instead of adding those names to this list. */
68
 
69
#define yymaxdepth f_maxdepth
70
#define yyparse f_parse
71
#define yylex   f_lex
72
#define yyerror f_error
73
#define yylval  f_lval
74
#define yychar  f_char
75
#define yydebug f_debug
76
#define yypact  f_pact
77
#define yyr1    f_r1
78
#define yyr2    f_r2
79
#define yydef   f_def
80
#define yychk   f_chk
81
#define yypgo   f_pgo
82
#define yyact   f_act
83
#define yyexca  f_exca
84
#define yyerrflag f_errflag
85
#define yynerrs f_nerrs
86
#define yyps    f_ps
87
#define yypv    f_pv
88
#define yys     f_s
89
#define yy_yys  f_yys
90
#define yystate f_state
91
#define yytmp   f_tmp
92
#define yyv     f_v
93
#define yy_yyv  f_yyv
94
#define yyval   f_val
95
#define yylloc  f_lloc
96
#define yyreds  f_reds          /* With YYDEBUG defined */
97
#define yytoks  f_toks          /* With YYDEBUG defined */
98
#define yyname  f_name          /* With YYDEBUG defined */
99
#define yyrule  f_rule          /* With YYDEBUG defined */
100
#define yylhs   f_yylhs
101
#define yylen   f_yylen
102
#define yydefred f_yydefred
103
#define yydgoto f_yydgoto
104
#define yysindex f_yysindex
105
#define yyrindex f_yyrindex
106
#define yygindex f_yygindex
107
#define yytable  f_yytable
108
#define yycheck  f_yycheck
109
 
110
#ifndef YYDEBUG
111
#define YYDEBUG 1               /* Default to yydebug support */
112
#endif
113
 
114
#define YYFPRINTF parser_fprintf
115
 
116
int yyparse (void);
117
 
118
static int yylex (void);
119
 
120
void yyerror (char *);
121
 
122
static void growbuf_by_size (int);
123
 
124
static int match_string_literal (void);
125
 
126
%}
127
 
128
/* Although the yacc "value" of an expression is not used,
129
   since the result is stored in the structure being created,
130
   other node types do have values.  */
131
 
132
%union
133
  {
134
    LONGEST lval;
135
    struct {
136
      LONGEST val;
137
      struct type *type;
138
    } typed_val;
139
    DOUBLEST dval;
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 parse_number (char *, int, int, YYSTYPE *);
157
%}
158
 
159
%type  exp  type_exp start variable
160
%type  type typebase
161
%type  nonempty_typelist
162
/* %type  block */
163
 
164
/* Fancy type parsing.  */
165
%type  func_mod direct_abs_decl abs_decl
166
%type  ptype
167
 
168
%token  INT
169
%token  FLOAT
170
 
171
/* Both NAME and TYPENAME tokens represent symbols in the input,
172
   and both convey their data as strings.
173
   But a TYPENAME is a string that happens to be defined as a typedef
174
   or builtin type name (such as int or char)
175
   and a NAME is any other symbol.
176
   Contexts where this distinction is not important can use the
177
   nonterminal "name", which matches either NAME or TYPENAME.  */
178
 
179
%token  STRING_LITERAL
180
%token  BOOLEAN_LITERAL
181
%token  NAME
182
%token  TYPENAME
183
%type  name
184
%type  name_not_typename
185
 
186
/* A NAME_OR_INT is a symbol which is not known in the symbol table,
187
   but which would parse as a valid number in the current input radix.
188
   E.g. "c" when input_radix==16.  Depending on the parse, it will be
189
   turned into a name or into a number.  */
190
 
191
%token  NAME_OR_INT
192
 
193
%token  SIZEOF
194
%token ERROR
195
 
196
/* Special type cases, put in to allow the parser to distinguish different
197
   legal basetypes.  */
198
%token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
199
%token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
200
%token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
201
%token BOOL_AND BOOL_OR BOOL_NOT
202
%token  CHARACTER
203
 
204
%token  VARIABLE
205
 
206
%token  ASSIGN_MODIFY
207
 
208
%left ','
209
%left ABOVE_COMMA
210
%right '=' ASSIGN_MODIFY
211
%right '?'
212
%left BOOL_OR
213
%right BOOL_NOT
214
%left BOOL_AND
215
%left '|'
216
%left '^'
217
%left '&'
218
%left EQUAL NOTEQUAL
219
%left LESSTHAN GREATERTHAN LEQ GEQ
220
%left LSH RSH
221
%left '@'
222
%left '+' '-'
223
%left '*' '/'
224
%right STARSTAR
225
%right '%'
226
%right UNARY
227
%right '('
228
 
229
 
230
%%
231
 
232
start   :       exp
233
        |       type_exp
234
        ;
235
 
236
type_exp:       type
237
                        { write_exp_elt_opcode(OP_TYPE);
238
                          write_exp_elt_type($1);
239
                          write_exp_elt_opcode(OP_TYPE); }
240
        ;
241
 
242
exp     :       '(' exp ')'
243
                        { }
244
        ;
245
 
246
/* Expressions, not including the comma operator.  */
247
exp     :       '*' exp    %prec UNARY
248
                        { write_exp_elt_opcode (UNOP_IND); }
249
        ;
250
 
251
exp     :       '&' exp    %prec UNARY
252
                        { write_exp_elt_opcode (UNOP_ADDR); }
253
        ;
254
 
255
exp     :       '-' exp    %prec UNARY
256
                        { write_exp_elt_opcode (UNOP_NEG); }
257
        ;
258
 
259
exp     :       BOOL_NOT exp    %prec UNARY
260
                        { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
261
        ;
262
 
263
exp     :       '~' exp    %prec UNARY
264
                        { write_exp_elt_opcode (UNOP_COMPLEMENT); }
265
        ;
266
 
267
exp     :       SIZEOF exp       %prec UNARY
268
                        { write_exp_elt_opcode (UNOP_SIZEOF); }
269
        ;
270
 
271
/* No more explicit array operators, we treat everything in F77 as
272
   a function call.  The disambiguation as to whether we are
273
   doing a subscript operation or a function call is done
274
   later in eval.c.  */
275
 
276
exp     :       exp '('
277
                        { start_arglist (); }
278
                arglist ')'
279
                        { write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST);
280
                          write_exp_elt_longcst ((LONGEST) end_arglist ());
281
                          write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); }
282
        ;
283
 
284
arglist :
285
        ;
286
 
287
arglist :       exp
288
                        { arglist_len = 1; }
289
        ;
290
 
291
arglist :       subrange
292
                        { arglist_len = 1; }
293
        ;
294
 
295
arglist :       arglist ',' exp   %prec ABOVE_COMMA
296
                        { arglist_len++; }
297
        ;
298
 
299
/* There are four sorts of subrange types in F90.  */
300
 
301
subrange:       exp ':' exp     %prec ABOVE_COMMA
302
                        { write_exp_elt_opcode (OP_F90_RANGE);
303
                          write_exp_elt_longcst (NONE_BOUND_DEFAULT);
304
                          write_exp_elt_opcode (OP_F90_RANGE); }
305
        ;
306
 
307
subrange:       exp ':' %prec ABOVE_COMMA
308
                        { write_exp_elt_opcode (OP_F90_RANGE);
309
                          write_exp_elt_longcst (HIGH_BOUND_DEFAULT);
310
                          write_exp_elt_opcode (OP_F90_RANGE); }
311
        ;
312
 
313
subrange:       ':' exp %prec ABOVE_COMMA
314
                        { write_exp_elt_opcode (OP_F90_RANGE);
315
                          write_exp_elt_longcst (LOW_BOUND_DEFAULT);
316
                          write_exp_elt_opcode (OP_F90_RANGE); }
317
        ;
318
 
319
subrange:       ':'     %prec ABOVE_COMMA
320
                        { write_exp_elt_opcode (OP_F90_RANGE);
321
                          write_exp_elt_longcst (BOTH_BOUND_DEFAULT);
322
                          write_exp_elt_opcode (OP_F90_RANGE); }
323
        ;
324
 
325
complexnum:     exp ',' exp
326
                        { }
327
        ;
328
 
329
exp     :       '(' complexnum ')'
330
                        { write_exp_elt_opcode(OP_COMPLEX);
331
                          write_exp_elt_type (parse_f_type->builtin_complex_s16);
332
                          write_exp_elt_opcode(OP_COMPLEX); }
333
        ;
334
 
335
exp     :       '(' type ')' exp  %prec UNARY
336
                        { write_exp_elt_opcode (UNOP_CAST);
337
                          write_exp_elt_type ($2);
338
                          write_exp_elt_opcode (UNOP_CAST); }
339
        ;
340
 
341
exp     :       exp '%' name
342
                        { write_exp_elt_opcode (STRUCTOP_STRUCT);
343
                          write_exp_string ($3);
344
                          write_exp_elt_opcode (STRUCTOP_STRUCT); }
345
        ;
346
 
347
/* Binary operators in order of decreasing precedence.  */
348
 
349
exp     :       exp '@' exp
350
                        { write_exp_elt_opcode (BINOP_REPEAT); }
351
        ;
352
 
353
exp     :       exp STARSTAR exp
354
                        { write_exp_elt_opcode (BINOP_EXP); }
355
        ;
356
 
357
exp     :       exp '*' exp
358
                        { write_exp_elt_opcode (BINOP_MUL); }
359
        ;
360
 
361
exp     :       exp '/' exp
362
                        { write_exp_elt_opcode (BINOP_DIV); }
363
        ;
364
 
365
exp     :       exp '+' exp
366
                        { write_exp_elt_opcode (BINOP_ADD); }
367
        ;
368
 
369
exp     :       exp '-' exp
370
                        { write_exp_elt_opcode (BINOP_SUB); }
371
        ;
372
 
373
exp     :       exp LSH exp
374
                        { write_exp_elt_opcode (BINOP_LSH); }
375
        ;
376
 
377
exp     :       exp RSH exp
378
                        { write_exp_elt_opcode (BINOP_RSH); }
379
        ;
380
 
381
exp     :       exp EQUAL exp
382
                        { write_exp_elt_opcode (BINOP_EQUAL); }
383
        ;
384
 
385
exp     :       exp NOTEQUAL exp
386
                        { write_exp_elt_opcode (BINOP_NOTEQUAL); }
387
        ;
388
 
389
exp     :       exp LEQ exp
390
                        { write_exp_elt_opcode (BINOP_LEQ); }
391
        ;
392
 
393
exp     :       exp GEQ exp
394
                        { write_exp_elt_opcode (BINOP_GEQ); }
395
        ;
396
 
397
exp     :       exp LESSTHAN exp
398
                        { write_exp_elt_opcode (BINOP_LESS); }
399
        ;
400
 
401
exp     :       exp GREATERTHAN exp
402
                        { write_exp_elt_opcode (BINOP_GTR); }
403
        ;
404
 
405
exp     :       exp '&' exp
406
                        { write_exp_elt_opcode (BINOP_BITWISE_AND); }
407
        ;
408
 
409
exp     :       exp '^' exp
410
                        { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
411
        ;
412
 
413
exp     :       exp '|' exp
414
                        { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
415
        ;
416
 
417
exp     :       exp BOOL_AND exp
418
                        { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
419
        ;
420
 
421
 
422
exp     :       exp BOOL_OR exp
423
                        { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
424
        ;
425
 
426
exp     :       exp '=' exp
427
                        { write_exp_elt_opcode (BINOP_ASSIGN); }
428
        ;
429
 
430
exp     :       exp ASSIGN_MODIFY exp
431
                        { write_exp_elt_opcode (BINOP_ASSIGN_MODIFY);
432
                          write_exp_elt_opcode ($2);
433
                          write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); }
434
        ;
435
 
436
exp     :       INT
437
                        { write_exp_elt_opcode (OP_LONG);
438
                          write_exp_elt_type ($1.type);
439
                          write_exp_elt_longcst ((LONGEST)($1.val));
440
                          write_exp_elt_opcode (OP_LONG); }
441
        ;
442
 
443
exp     :       NAME_OR_INT
444
                        { YYSTYPE val;
445
                          parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
446
                          write_exp_elt_opcode (OP_LONG);
447
                          write_exp_elt_type (val.typed_val.type);
448
                          write_exp_elt_longcst ((LONGEST)val.typed_val.val);
449
                          write_exp_elt_opcode (OP_LONG); }
450
        ;
451
 
452
exp     :       FLOAT
453
                        { write_exp_elt_opcode (OP_DOUBLE);
454
                          write_exp_elt_type (parse_f_type->builtin_real_s8);
455
                          write_exp_elt_dblcst ($1);
456
                          write_exp_elt_opcode (OP_DOUBLE); }
457
        ;
458
 
459
exp     :       variable
460
        ;
461
 
462
exp     :       VARIABLE
463
        ;
464
 
465
exp     :       SIZEOF '(' type ')'     %prec UNARY
466
                        { write_exp_elt_opcode (OP_LONG);
467
                          write_exp_elt_type (parse_f_type->builtin_integer);
468
                          CHECK_TYPEDEF ($3);
469
                          write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
470
                          write_exp_elt_opcode (OP_LONG); }
471
        ;
472
 
473
exp     :       BOOLEAN_LITERAL
474
                        { write_exp_elt_opcode (OP_BOOL);
475
                          write_exp_elt_longcst ((LONGEST) $1);
476
                          write_exp_elt_opcode (OP_BOOL);
477
                        }
478
        ;
479
 
480
exp     :       STRING_LITERAL
481
                        {
482
                          write_exp_elt_opcode (OP_STRING);
483
                          write_exp_string ($1);
484
                          write_exp_elt_opcode (OP_STRING);
485
                        }
486
        ;
487
 
488
variable:       name_not_typename
489
                        { struct symbol *sym = $1.sym;
490
 
491
                          if (sym)
492
                            {
493
                              if (symbol_read_needs_frame (sym))
494
                                {
495
                                  if (innermost_block == 0
496
                                      || contained_in (block_found,
497
                                                       innermost_block))
498
                                    innermost_block = block_found;
499
                                }
500
                              write_exp_elt_opcode (OP_VAR_VALUE);
501
                              /* We want to use the selected frame, not
502
                                 another more inner frame which happens to
503
                                 be in the same block.  */
504
                              write_exp_elt_block (NULL);
505
                              write_exp_elt_sym (sym);
506
                              write_exp_elt_opcode (OP_VAR_VALUE);
507
                              break;
508
                            }
509
                          else
510
                            {
511
                              struct minimal_symbol *msymbol;
512
                              char *arg = copy_name ($1.stoken);
513
 
514
                              msymbol =
515
                                lookup_minimal_symbol (arg, NULL, NULL);
516
                              if (msymbol != NULL)
517
                                write_exp_msymbol (msymbol);
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
                                                 parse_f_type->builtin_integer,
559
                                                 0, 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
                        { $$ = parse_f_type->builtin_integer; }
605
        |       INT_S2_KEYWORD
606
                        { $$ = parse_f_type->builtin_integer_s2; }
607
        |       CHARACTER
608
                        { $$ = parse_f_type->builtin_character; }
609
        |       LOGICAL_KEYWORD
610
                        { $$ = parse_f_type->builtin_logical; }
611
        |       LOGICAL_S2_KEYWORD
612
                        { $$ = parse_f_type->builtin_logical_s2; }
613
        |       LOGICAL_S1_KEYWORD
614
                        { $$ = parse_f_type->builtin_logical_s1; }
615
        |       REAL_KEYWORD
616
                        { $$ = parse_f_type->builtin_real; }
617
        |       REAL_S8_KEYWORD
618
                        { $$ = parse_f_type->builtin_real_s8; }
619
        |       REAL_S16_KEYWORD
620
                        { $$ = parse_f_type->builtin_real_s16; }
621
        |       COMPLEX_S8_KEYWORD
622
                        { $$ = parse_f_type->builtin_complex_s8; }
623
        |       COMPLEX_S16_KEYWORD
624
                        { $$ = parse_f_type->builtin_complex_s16; }
625
        |       COMPLEX_S32_KEYWORD
626
                        { $$ = parse_f_type->builtin_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 (parse_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 (parse_gdbarch) != gdbarch_long_bit (parse_gdbarch)
776
       && ((n >> 2)
777
           >> (gdbarch_int_bit (parse_gdbarch)-2))) /* Avoid shift warning */
778
      || long_p)
779
    {
780
      high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch)-1);
781
      unsigned_type = parse_type->builtin_unsigned_long;
782
      signed_type = parse_type->builtin_long;
783
    }
784
  else
785
    {
786
      high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch)-1);
787
      unsigned_type = parse_type->builtin_unsigned_int;
788
      signed_type = parse_type->builtin_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
                         parse_language->la_language == language_cplus
1178
                         ? &is_a_field_of_this : NULL);
1179
    if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1180
      {
1181
        yylval.tsym.type = SYMBOL_TYPE (sym);
1182
        return TYPENAME;
1183
      }
1184
    yylval.tsym.type
1185
      = language_lookup_primitive_type_by_name (parse_language,
1186
                                                parse_gdbarch, tmp);
1187
    if (yylval.tsym.type != NULL)
1188
      return TYPENAME;
1189
 
1190
    /* Input names that aren't symbols but ARE valid hex numbers,
1191
       when the input radix permits them, can be names or numbers
1192
       depending on the parse.  Note we support radixes > 16 here.  */
1193
    if (!sym
1194
        && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1195
            || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1196
      {
1197
        YYSTYPE newlval;        /* Its value is ignored.  */
1198
        hextype = parse_number (tokstart, namelen, 0, &newlval);
1199
        if (hextype == INT)
1200
          {
1201
            yylval.ssym.sym = sym;
1202
            yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1203
            return NAME_OR_INT;
1204
          }
1205
      }
1206
 
1207
    /* Any other kind of symbol */
1208
    yylval.ssym.sym = sym;
1209
    yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1210
    return NAME;
1211
  }
1212
}
1213
 
1214
void
1215
yyerror (msg)
1216
     char *msg;
1217
{
1218
  if (prev_lexptr)
1219
    lexptr = prev_lexptr;
1220
 
1221
  error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
1222
}

powered by: WebSVN 2.1.0

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