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