* gdb.c++/classes.exp, gdb.c++/cplusfuncs.exp,
[deliverable/binutils-gdb.git] / gdb / ch-exp.y
CommitLineData
e58de8a2 1/* YACC grammar for Chill expressions, for GDB.
ba47c66a 2 Copyright 1992, 1993, 1994 Free Software Foundation, Inc.
e58de8a2
FF
3
4This file is part of GDB.
5
6This program is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2 of the License, or
9(at your option) any later version.
10
11This program is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with this program; if not, write to the Free Software
18Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20/* Parse a Chill expression from text in a string,
21 and return the result as a struct expression pointer.
22 That structure contains arithmetic operations in reverse polish,
23 with constants represented by operations that are followed by special data.
24 See expression.h for the details of the format.
25 What is important here is that it can be built up sequentially
26 during the process of parsing; the lower levels of the tree always
27 come first in the result.
28
29 Note that malloc's and realloc's in this file are transformed to
30 xmalloc and xrealloc respectively by the same sed command in the
31 makefile that remaps any other malloc/realloc inserted by the parser
32 generator. Doing this with #defines and trying to control the interaction
33 with include files (<malloc.h> and <stdlib.h> for example) just became
34 too messy, particularly when such includes can be inserted at random
35 times by the parser generator.
36
37 Also note that the language accepted by this parser is more liberal
38 than the one accepted by an actual Chill compiler. For example, the
39 language rule that a simple name string can not be one of the reserved
40 simple name strings is not enforced (e.g "case" is not treated as a
41 reserved name). Another example is that Chill is a strongly typed
42 language, and certain expressions that violate the type constraints
43 may still be evaluated if gdb can do so in a meaningful manner, while
44 such expressions would be rejected by the compiler. The reason for
45 this more liberal behavior is the philosophy that the debugger
46 is intended to be a tool that is used by the programmer when things
47 go wrong, and as such, it should provide as few artificial barriers
48 to it's use as possible. If it can do something meaningful, even
49 something that violates language contraints that are enforced by the
50 compiler, it should do so without complaint.
51
52 */
53
54%{
55
e58de8a2 56#include "defs.h"
ba47c66a 57#include <string.h>
00cea52f 58#include <ctype.h>
e58de8a2
FF
59#include "expression.h"
60#include "language.h"
61#include "value.h"
62#include "parser-defs.h"
22e39759 63#include "ch-lang.h"
100f92e2
JK
64#include "bfd.h" /* Required by objfiles.h. */
65#include "symfile.h" /* Required by objfiles.h. */
66#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
e58de8a2 67
19d0f3f4
FF
68/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
69 as well as gratuitiously global symbol names, so we can have multiple
70 yacc generated parsers in gdb. Note that these are only the variables
71 produced by yacc. If other parser generators (bison, byacc, etc) produce
72 additional global names that conflict at link time, then those parser
73 generators need to be fixed instead of adding those names to this list. */
74
e58de8a2
FF
75#define yymaxdepth chill_maxdepth
76#define yyparse chill_parse
77#define yylex chill_lex
78#define yyerror chill_error
79#define yylval chill_lval
80#define yychar chill_char
81#define yydebug chill_debug
82#define yypact chill_pact
83#define yyr1 chill_r1
84#define yyr2 chill_r2
85#define yydef chill_def
86#define yychk chill_chk
87#define yypgo chill_pgo
88#define yyact chill_act
89#define yyexca chill_exca
4015bfb9
BK
90#define yyerrflag chill_errflag
91#define yynerrs chill_nerrs
e58de8a2
FF
92#define yyps chill_ps
93#define yypv chill_pv
94#define yys chill_s
95#define yy_yys chill_yys
96#define yystate chill_state
97#define yytmp chill_tmp
98#define yyv chill_v
99#define yy_yyv chill_yyv
100#define yyval chill_val
101#define yylloc chill_lloc
4015bfb9
BK
102#define yyreds chill_reds /* With YYDEBUG defined */
103#define yytoks chill_toks /* With YYDEBUG defined */
19d0f3f4
FF
104
105#ifndef YYDEBUG
106#define YYDEBUG 0 /* Default to no yydebug support */
107#endif
108
109int
110yyparse PARAMS ((void));
e58de8a2
FF
111
112static int
113yylex PARAMS ((void));
114
22e39759 115void
e58de8a2
FF
116yyerror PARAMS ((char *));
117
e58de8a2
FF
118%}
119
120/* Although the yacc "value" of an expression is not used,
121 since the result is stored in the structure being created,
122 other node types do have values. */
123
124%union
125 {
126 LONGEST lval;
127 unsigned LONGEST ulval;
128 struct {
129 LONGEST val;
130 struct type *type;
131 } typed_val;
132 double dval;
133 struct symbol *sym;
134 struct type *tval;
135 struct stoken sval;
136 struct ttype tsym;
137 struct symtoken ssym;
138 int voidval;
139 struct block *bval;
140 enum exp_opcode opcode;
141 struct internalvar *ivar;
142
143 struct type **tvec;
144 int *ivec;
145 }
146
2fcc38b8
FF
147%token <voidval> FIXME_01
148%token <voidval> FIXME_02
149%token <voidval> FIXME_03
150%token <voidval> FIXME_04
151%token <voidval> FIXME_05
152%token <voidval> FIXME_06
153%token <voidval> FIXME_07
154%token <voidval> FIXME_08
155%token <voidval> FIXME_09
156%token <voidval> FIXME_10
157%token <voidval> FIXME_11
158%token <voidval> FIXME_12
159%token <voidval> FIXME_13
160%token <voidval> FIXME_14
161%token <voidval> FIXME_15
162%token <voidval> FIXME_16
163%token <voidval> FIXME_17
164%token <voidval> FIXME_18
165%token <voidval> FIXME_19
166%token <voidval> FIXME_20
167%token <voidval> FIXME_21
168%token <voidval> FIXME_22
2fcc38b8
FF
169%token <voidval> FIXME_24
170%token <voidval> FIXME_25
171%token <voidval> FIXME_26
172%token <voidval> FIXME_27
173%token <voidval> FIXME_28
174%token <voidval> FIXME_29
175%token <voidval> FIXME_30
e58de8a2
FF
176
177%token <typed_val> INTEGER_LITERAL
178%token <ulval> BOOLEAN_LITERAL
2e66cf7d 179%token <typed_val> CHARACTER_LITERAL
1188fbbf 180%token <dval> FLOAT_LITERAL
cbd1bdc3
FF
181%token <ssym> GENERAL_PROCEDURE_NAME
182%token <ssym> LOCATION_NAME
e58de8a2
FF
183%token <voidval> SET_LITERAL
184%token <voidval> EMPTINESS_LITERAL
c7da3ed3 185%token <sval> CHARACTER_STRING_LITERAL
81028ab0 186%token <sval> BIT_STRING_LITERAL
8a177da6
PB
187%token <tsym> TYPENAME
188%token <sval> FIELD_NAME
e58de8a2 189
e58de8a2
FF
190%token <voidval> '.'
191%token <voidval> ';'
192%token <voidval> ':'
193%token <voidval> CASE
194%token <voidval> OF
195%token <voidval> ESAC
196%token <voidval> LOGIOR
197%token <voidval> ORIF
198%token <voidval> LOGXOR
199%token <voidval> LOGAND
200%token <voidval> ANDIF
201%token <voidval> '='
202%token <voidval> NOTEQUAL
203%token <voidval> '>'
204%token <voidval> GTR
205%token <voidval> '<'
206%token <voidval> LEQ
207%token <voidval> IN
208%token <voidval> '+'
209%token <voidval> '-'
210%token <voidval> '*'
211%token <voidval> '/'
212%token <voidval> SLASH_SLASH
213%token <voidval> MOD
214%token <voidval> REM
215%token <voidval> NOT
216%token <voidval> POINTER
217%token <voidval> RECEIVE
e58de8a2
FF
218%token <voidval> '['
219%token <voidval> ']'
220%token <voidval> '('
221%token <voidval> ')'
222%token <voidval> UP
223%token <voidval> IF
224%token <voidval> THEN
225%token <voidval> ELSE
226%token <voidval> FI
227%token <voidval> ELSIF
228%token <voidval> ILLEGAL_TOKEN
81028ab0
FF
229%token <voidval> NUM
230%token <voidval> PRED
231%token <voidval> SUCC
232%token <voidval> ABS
233%token <voidval> CARD
57ffffe3
JG
234%token <voidval> MAX_TOKEN
235%token <voidval> MIN_TOKEN
81028ab0
FF
236%token <voidval> SIZE
237%token <voidval> UPPER
238%token <voidval> LOWER
239%token <voidval> LENGTH
e58de8a2 240
45fe3db4
FF
241/* Tokens which are not Chill tokens used in expressions, but rather GDB
242 specific things that we recognize in the same context as Chill tokens
243 (register names for example). */
244
245%token <lval> GDB_REGNAME /* Machine register name */
246%token <lval> GDB_LAST /* Value history */
247%token <ivar> GDB_VARIABLE /* Convenience variable */
248%token <voidval> GDB_ASSIGNMENT /* Assign value to somewhere */
249
cbd1bdc3 250%type <voidval> access_name
e58de8a2 251%type <voidval> primitive_value
e58de8a2
FF
252%type <voidval> value_name
253%type <voidval> literal
254%type <voidval> tuple
255%type <voidval> value_string_element
256%type <voidval> value_string_slice
e58de8a2 257%type <voidval> value_array_slice
e58de8a2
FF
258%type <voidval> expression_conversion
259%type <voidval> value_procedure_call
260%type <voidval> value_built_in_routine_call
81028ab0 261%type <voidval> chill_value_built_in_routine_call
e58de8a2
FF
262%type <voidval> start_expression
263%type <voidval> zero_adic_operator
264%type <voidval> parenthesised_expression
265%type <voidval> value
266%type <voidval> undefined_value
267%type <voidval> expression
268%type <voidval> conditional_expression
269%type <voidval> then_alternative
270%type <voidval> else_alternative
271%type <voidval> sub_expression
272%type <voidval> value_case_alternative
273%type <voidval> operand_0
274%type <voidval> operand_1
275%type <voidval> operand_2
276%type <voidval> operand_3
277%type <voidval> operand_4
278%type <voidval> operand_5
279%type <voidval> operand_6
e58de8a2
FF
280%type <voidval> synonym_name
281%type <voidval> value_enumeration_name
282%type <voidval> value_do_with_name
283%type <voidval> value_receive_name
e58de8a2
FF
284%type <voidval> string_primitive_value
285%type <voidval> start_element
286%type <voidval> left_element
287%type <voidval> right_element
288%type <voidval> slice_size
e58de8a2
FF
289%type <voidval> expression_list
290%type <voidval> lower_element
291%type <voidval> upper_element
292%type <voidval> first_element
58cda66e 293%type <tval> mode_argument
81028ab0
FF
294%type <voidval> upper_lower_argument
295%type <voidval> length_argument
81028ab0
FF
296%type <voidval> array_mode_name
297%type <voidval> string_mode_name
298%type <voidval> variant_structure_mode_name
e58de8a2
FF
299%type <voidval> boolean_expression
300%type <voidval> case_selector_list
301%type <voidval> subexpression
302%type <voidval> case_label_specification
303%type <voidval> buffer_location
45fe3db4 304%type <voidval> single_assignment_action
8a177da6 305%type <tsym> mode_name
45fe3db4 306
e58de8a2
FF
307%%
308
309/* Z.200, 5.3.1 */
310
f39a2631 311start : value { }
8a177da6
PB
312 | mode_name
313 { write_exp_elt_opcode(OP_TYPE);
314 write_exp_elt_type($1.type);
315 write_exp_elt_opcode(OP_TYPE);}
316 ;
317
e58de8a2
FF
318value : expression
319 {
2e66cf7d 320 $$ = 0; /* FIXME */
e58de8a2
FF
321 }
322 | undefined_value
323 {
2e66cf7d 324 $$ = 0; /* FIXME */
e58de8a2
FF
325 }
326 ;
327
2fcc38b8 328undefined_value : FIXME_01
e58de8a2 329 {
2e66cf7d 330 $$ = 0; /* FIXME */
e58de8a2
FF
331 }
332 ;
333
cbd1bdc3
FF
334/* Z.200, 4.2.2 */
335
336access_name : LOCATION_NAME
337 {
338 write_exp_elt_opcode (OP_VAR_VALUE);
479fdd26 339 write_exp_elt_block (NULL);
cbd1bdc3
FF
340 write_exp_elt_sym ($1.sym);
341 write_exp_elt_opcode (OP_VAR_VALUE);
342 }
45fe3db4
FF
343 | GDB_LAST /* gdb specific */
344 {
345 write_exp_elt_opcode (OP_LAST);
346 write_exp_elt_longcst ($1);
347 write_exp_elt_opcode (OP_LAST);
348 }
349 | GDB_REGNAME /* gdb specific */
350 {
351 write_exp_elt_opcode (OP_REGISTER);
352 write_exp_elt_longcst ($1);
353 write_exp_elt_opcode (OP_REGISTER);
354 }
355 | GDB_VARIABLE /* gdb specific */
356 {
357 write_exp_elt_opcode (OP_INTERNALVAR);
358 write_exp_elt_intern ($1);
359 write_exp_elt_opcode (OP_INTERNALVAR);
360 }
2fcc38b8 361 | FIXME_03
e58de8a2 362 {
2e66cf7d 363 $$ = 0; /* FIXME */
e58de8a2
FF
364 }
365 ;
366
54bbbfb4
FF
367/* Z.200, 4.2.8 */
368
369expression_list : expression
370 {
371 arglist_len = 1;
372 }
373 | expression_list ',' expression
374 {
375 arglist_len++;
376 }
377
e58de8a2
FF
378/* Z.200, 5.2.1 */
379
bdef6b60
PB
380primitive_value :
381 access_name
382 | primitive_value '('
383 /* This is to save the value of arglist_len
384 being accumulated for each dimension. */
385 { start_arglist (); }
386 expression_list ')'
e58de8a2 387 {
bdef6b60
PB
388 write_exp_elt_opcode (MULTI_SUBSCRIPT);
389 write_exp_elt_longcst ((LONGEST) end_arglist ());
390 write_exp_elt_opcode (MULTI_SUBSCRIPT);
391 }
392 | primitive_value FIELD_NAME
393 { write_exp_elt_opcode (STRUCTOP_STRUCT);
394 write_exp_string ($2);
395 write_exp_elt_opcode (STRUCTOP_STRUCT);
396 }
397 | primitive_value POINTER
398 {
399 write_exp_elt_opcode (UNOP_IND);
e58de8a2
FF
400 }
401 | value_name
402 {
2e66cf7d 403 $$ = 0; /* FIXME */
e58de8a2
FF
404 }
405 | literal
406 {
2e66cf7d 407 $$ = 0; /* FIXME */
e58de8a2
FF
408 }
409 | tuple
410 {
2e66cf7d 411 $$ = 0; /* FIXME */
e58de8a2
FF
412 }
413 | value_string_element
414 {
2e66cf7d 415 $$ = 0; /* FIXME */
e58de8a2
FF
416 }
417 | value_string_slice
418 {
2e66cf7d 419 $$ = 0; /* FIXME */
e58de8a2 420 }
e58de8a2
FF
421 | value_array_slice
422 {
2e66cf7d 423 $$ = 0; /* FIXME */
e58de8a2 424 }
e58de8a2
FF
425 | expression_conversion
426 {
2e66cf7d 427 $$ = 0; /* FIXME */
e58de8a2
FF
428 }
429 | value_procedure_call
430 {
2e66cf7d 431 $$ = 0; /* FIXME */
e58de8a2
FF
432 }
433 | value_built_in_routine_call
434 {
2e66cf7d 435 $$ = 0; /* FIXME */
e58de8a2
FF
436 }
437 | start_expression
438 {
2e66cf7d 439 $$ = 0; /* FIXME */
e58de8a2
FF
440 }
441 | zero_adic_operator
442 {
2e66cf7d 443 $$ = 0; /* FIXME */
e58de8a2
FF
444 }
445 | parenthesised_expression
446 {
2e66cf7d 447 $$ = 0; /* FIXME */
e58de8a2
FF
448 }
449 ;
450
e58de8a2
FF
451/* Z.200, 5.2.3 */
452
453value_name : synonym_name
454 {
2e66cf7d 455 $$ = 0; /* FIXME */
e58de8a2
FF
456 }
457 | value_enumeration_name
458 {
2e66cf7d 459 $$ = 0; /* FIXME */
e58de8a2
FF
460 }
461 | value_do_with_name
462 {
2e66cf7d 463 $$ = 0; /* FIXME */
e58de8a2
FF
464 }
465 | value_receive_name
466 {
2e66cf7d 467 $$ = 0; /* FIXME */
e58de8a2 468 }
cbd1bdc3 469 | GENERAL_PROCEDURE_NAME
e58de8a2 470 {
cbd1bdc3 471 write_exp_elt_opcode (OP_VAR_VALUE);
479fdd26 472 write_exp_elt_block (NULL);
cbd1bdc3
FF
473 write_exp_elt_sym ($1.sym);
474 write_exp_elt_opcode (OP_VAR_VALUE);
e58de8a2
FF
475 }
476 ;
477
478/* Z.200, 5.2.4.1 */
479
480literal : INTEGER_LITERAL
481 {
2e66cf7d
FF
482 write_exp_elt_opcode (OP_LONG);
483 write_exp_elt_type ($1.type);
484 write_exp_elt_longcst ((LONGEST) ($1.val));
485 write_exp_elt_opcode (OP_LONG);
e58de8a2
FF
486 }
487 | BOOLEAN_LITERAL
488 {
2e66cf7d
FF
489 write_exp_elt_opcode (OP_BOOL);
490 write_exp_elt_longcst ((LONGEST) $1);
491 write_exp_elt_opcode (OP_BOOL);
e58de8a2
FF
492 }
493 | CHARACTER_LITERAL
494 {
2e66cf7d
FF
495 write_exp_elt_opcode (OP_LONG);
496 write_exp_elt_type ($1.type);
497 write_exp_elt_longcst ((LONGEST) ($1.val));
498 write_exp_elt_opcode (OP_LONG);
e58de8a2 499 }
1188fbbf
FF
500 | FLOAT_LITERAL
501 {
502 write_exp_elt_opcode (OP_DOUBLE);
503 write_exp_elt_type (builtin_type_double);
504 write_exp_elt_dblcst ($1);
505 write_exp_elt_opcode (OP_DOUBLE);
506 }
e58de8a2
FF
507 | SET_LITERAL
508 {
2e66cf7d 509 $$ = 0; /* FIXME */
e58de8a2
FF
510 }
511 | EMPTINESS_LITERAL
512 {
2d67c7e9
PB
513 struct type *void_ptr_type
514 = lookup_pointer_type (builtin_type_void);
515 write_exp_elt_opcode (OP_LONG);
516 write_exp_elt_type (void_ptr_type);
517 write_exp_elt_longcst (0);
518 write_exp_elt_opcode (OP_LONG);
e58de8a2
FF
519 }
520 | CHARACTER_STRING_LITERAL
521 {
c7da3ed3
FF
522 write_exp_elt_opcode (OP_STRING);
523 write_exp_string ($1);
524 write_exp_elt_opcode (OP_STRING);
e58de8a2
FF
525 }
526 | BIT_STRING_LITERAL
527 {
81028ab0
FF
528 write_exp_elt_opcode (OP_BITSTRING);
529 write_exp_bitstring ($1);
530 write_exp_elt_opcode (OP_BITSTRING);
e58de8a2
FF
531 }
532 ;
533
534/* Z.200, 5.2.5 */
535
2d67c7e9
PB
536tuple : '['
537 { start_arglist (); }
538 expression_list ']'
e58de8a2 539 {
2d67c7e9
PB
540 write_exp_elt_opcode (OP_ARRAY);
541 write_exp_elt_longcst ((LONGEST) 0);
542 write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
543 write_exp_elt_opcode (OP_ARRAY);
544 }
545 |
546 mode_name '['
547 { start_arglist (); }
548 expression_list ']'
549 {
550 write_exp_elt_opcode (OP_ARRAY);
551 write_exp_elt_longcst ((LONGEST) 0);
552 write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
553 write_exp_elt_opcode (OP_ARRAY);
554
555 write_exp_elt_opcode (UNOP_CAST);
556 write_exp_elt_type ($1.type);
557 write_exp_elt_opcode (UNOP_CAST);
e58de8a2
FF
558 }
559 ;
560
561
562/* Z.200, 5.2.6 */
563
564value_string_element: string_primitive_value '(' start_element ')'
565 {
2e66cf7d 566 $$ = 0; /* FIXME */
e58de8a2
FF
567 }
568 ;
569
570/* Z.200, 5.2.7 */
571
572value_string_slice: string_primitive_value '(' left_element ':' right_element ')'
573 {
2e66cf7d 574 $$ = 0; /* FIXME */
e58de8a2
FF
575 }
576 | string_primitive_value '(' start_element UP slice_size ')'
577 {
2e66cf7d 578 $$ = 0; /* FIXME */
e58de8a2
FF
579 }
580 ;
581
e58de8a2
FF
582/* Z.200, 5.2.9 */
583
bdef6b60 584value_array_slice: primitive_value '(' lower_element ':' upper_element ')'
e58de8a2 585 {
2e66cf7d 586 $$ = 0; /* FIXME */
e58de8a2 587 }
bdef6b60 588 | primitive_value '(' first_element UP slice_size ')'
e58de8a2 589 {
2e66cf7d 590 $$ = 0; /* FIXME */
e58de8a2
FF
591 }
592 ;
593
e58de8a2
FF
594/* Z.200, 5.2.11 */
595
2fcc38b8 596expression_conversion: mode_name parenthesised_expression
e58de8a2 597 {
8a177da6
PB
598 write_exp_elt_opcode (UNOP_CAST);
599 write_exp_elt_type ($1.type);
600 write_exp_elt_opcode (UNOP_CAST);
e58de8a2
FF
601 }
602 ;
603
604/* Z.200, 5.2.12 */
605
2fcc38b8 606value_procedure_call: FIXME_05
e58de8a2 607 {
2e66cf7d 608 $$ = 0; /* FIXME */
e58de8a2
FF
609 }
610 ;
611
612/* Z.200, 5.2.13 */
613
81028ab0 614value_built_in_routine_call: chill_value_built_in_routine_call
e58de8a2 615 {
2e66cf7d 616 $$ = 0; /* FIXME */
e58de8a2
FF
617 }
618 ;
619
620/* Z.200, 5.2.14 */
621
2fcc38b8 622start_expression: FIXME_06
e58de8a2 623 {
2e66cf7d 624 $$ = 0; /* FIXME */
e58de8a2
FF
625 } /* Not in GNU-Chill */
626 ;
627
628/* Z.200, 5.2.15 */
629
2fcc38b8 630zero_adic_operator: FIXME_07
e58de8a2 631 {
2e66cf7d 632 $$ = 0; /* FIXME */
e58de8a2
FF
633 }
634 ;
635
636/* Z.200, 5.2.16 */
637
638parenthesised_expression: '(' expression ')'
639 {
2e66cf7d 640 $$ = 0; /* FIXME */
e58de8a2
FF
641 }
642 ;
643
644/* Z.200, 5.3.2 */
645
646expression : operand_0
647 {
2e66cf7d 648 $$ = 0; /* FIXME */
e58de8a2 649 }
8a177da6
PB
650 | single_assignment_action
651 {
652 $$ = 0; /* FIXME */
653 }
e58de8a2
FF
654 | conditional_expression
655 {
2e66cf7d 656 $$ = 0; /* FIXME */
e58de8a2
FF
657 }
658 ;
659
660conditional_expression : IF boolean_expression then_alternative else_alternative FI
661 {
2e66cf7d 662 $$ = 0; /* FIXME */
e58de8a2 663 }
2d67c7e9 664 | CASE case_selector_list OF value_case_alternative ELSE sub_expression ESAC
e58de8a2 665 {
2e66cf7d 666 $$ = 0; /* FIXME */
e58de8a2
FF
667 }
668 ;
669
670then_alternative: THEN subexpression
671 {
2e66cf7d 672 $$ = 0; /* FIXME */
e58de8a2
FF
673 }
674 ;
675
676else_alternative: ELSE subexpression
677 {
2e66cf7d 678 $$ = 0; /* FIXME */
e58de8a2
FF
679 }
680 | ELSIF boolean_expression then_alternative else_alternative
681 {
2e66cf7d 682 $$ = 0; /* FIXME */
e58de8a2
FF
683 }
684 ;
685
686sub_expression : expression
687 {
2e66cf7d 688 $$ = 0; /* FIXME */
e58de8a2
FF
689 }
690 ;
691
692value_case_alternative: case_label_specification ':' sub_expression ';'
693 {
2e66cf7d 694 $$ = 0; /* FIXME */
e58de8a2
FF
695 }
696 ;
697
698/* Z.200, 5.3.3 */
699
700operand_0 : operand_1
701 {
2e66cf7d 702 $$ = 0; /* FIXME */
e58de8a2
FF
703 }
704 | operand_0 LOGIOR operand_1
705 {
2e66cf7d 706 write_exp_elt_opcode (BINOP_BITWISE_IOR);
e58de8a2
FF
707 }
708 | operand_0 ORIF operand_1
709 {
2e66cf7d 710 $$ = 0; /* FIXME */
e58de8a2
FF
711 }
712 | operand_0 LOGXOR operand_1
713 {
2e66cf7d 714 write_exp_elt_opcode (BINOP_BITWISE_XOR);
e58de8a2
FF
715 }
716 ;
717
718/* Z.200, 5.3.4 */
719
720operand_1 : operand_2
721 {
2e66cf7d 722 $$ = 0; /* FIXME */
e58de8a2
FF
723 }
724 | operand_1 LOGAND operand_2
725 {
2e66cf7d 726 write_exp_elt_opcode (BINOP_BITWISE_AND);
e58de8a2
FF
727 }
728 | operand_1 ANDIF operand_2
729 {
2e66cf7d 730 $$ = 0; /* FIXME */
e58de8a2
FF
731 }
732 ;
733
734/* Z.200, 5.3.5 */
735
736operand_2 : operand_3
737 {
2e66cf7d 738 $$ = 0; /* FIXME */
e58de8a2
FF
739 }
740 | operand_2 '=' operand_3
741 {
2e66cf7d 742 write_exp_elt_opcode (BINOP_EQUAL);
e58de8a2
FF
743 }
744 | operand_2 NOTEQUAL operand_3
745 {
2e66cf7d 746 write_exp_elt_opcode (BINOP_NOTEQUAL);
e58de8a2
FF
747 }
748 | operand_2 '>' operand_3
749 {
2e66cf7d 750 write_exp_elt_opcode (BINOP_GTR);
e58de8a2
FF
751 }
752 | operand_2 GTR operand_3
753 {
2e66cf7d 754 write_exp_elt_opcode (BINOP_GEQ);
e58de8a2
FF
755 }
756 | operand_2 '<' operand_3
757 {
2e66cf7d 758 write_exp_elt_opcode (BINOP_LESS);
e58de8a2
FF
759 }
760 | operand_2 LEQ operand_3
761 {
2e66cf7d 762 write_exp_elt_opcode (BINOP_LEQ);
e58de8a2
FF
763 }
764 | operand_2 IN operand_3
765 {
e909f287 766 write_exp_elt_opcode (BINOP_IN);
e58de8a2
FF
767 }
768 ;
769
770
771/* Z.200, 5.3.6 */
772
773operand_3 : operand_4
774 {
2e66cf7d 775 $$ = 0; /* FIXME */
e58de8a2
FF
776 }
777 | operand_3 '+' operand_4
778 {
2e66cf7d 779 write_exp_elt_opcode (BINOP_ADD);
e58de8a2
FF
780 }
781 | operand_3 '-' operand_4
782 {
2e66cf7d 783 write_exp_elt_opcode (BINOP_SUB);
e58de8a2
FF
784 }
785 | operand_3 SLASH_SLASH operand_4
786 {
fcbadaee 787 write_exp_elt_opcode (BINOP_CONCAT);
e58de8a2
FF
788 }
789 ;
790
791/* Z.200, 5.3.7 */
792
793operand_4 : operand_5
794 {
2e66cf7d 795 $$ = 0; /* FIXME */
e58de8a2
FF
796 }
797 | operand_4 '*' operand_5
798 {
2e66cf7d 799 write_exp_elt_opcode (BINOP_MUL);
e58de8a2
FF
800 }
801 | operand_4 '/' operand_5
802 {
2e66cf7d 803 write_exp_elt_opcode (BINOP_DIV);
e58de8a2
FF
804 }
805 | operand_4 MOD operand_5
806 {
76a0ffb4 807 write_exp_elt_opcode (BINOP_MOD);
e58de8a2
FF
808 }
809 | operand_4 REM operand_5
810 {
76a0ffb4 811 write_exp_elt_opcode (BINOP_REM);
e58de8a2
FF
812 }
813 ;
814
815/* Z.200, 5.3.8 */
816
817operand_5 : operand_6
818 {
2e66cf7d 819 $$ = 0; /* FIXME */
e58de8a2
FF
820 }
821 | '-' operand_6
822 {
2e66cf7d 823 write_exp_elt_opcode (UNOP_NEG);
e58de8a2
FF
824 }
825 | NOT operand_6
826 {
2e66cf7d 827 write_exp_elt_opcode (UNOP_LOGICAL_NOT);
e58de8a2 828 }
47f366bc 829 | parenthesised_expression literal
8a177da6
PB
830/* We require the string operand to be a literal, to avoid some
831 nasty parsing ambiguities. */
e58de8a2 832 {
2fcc38b8 833 write_exp_elt_opcode (BINOP_CONCAT);
e58de8a2
FF
834 }
835 ;
836
837/* Z.200, 5.3.9 */
838
bdef6b60 839operand_6 : POINTER primitive_value
e58de8a2 840 {
8a177da6 841 write_exp_elt_opcode (UNOP_ADDR);
e58de8a2
FF
842 }
843 | RECEIVE buffer_location
844 {
2e66cf7d 845 $$ = 0; /* FIXME */
e58de8a2
FF
846 }
847 | primitive_value
848 {
2e66cf7d 849 $$ = 0; /* FIXME */
e58de8a2
FF
850 }
851 ;
852
853
45fe3db4
FF
854/* Z.200, 6.2 */
855
81028ab0 856single_assignment_action :
bdef6b60 857 primitive_value GDB_ASSIGNMENT value
45fe3db4
FF
858 {
859 write_exp_elt_opcode (BINOP_ASSIGN);
860 }
81028ab0
FF
861 ;
862
863/* Z.200, 6.20.3 */
864
865chill_value_built_in_routine_call :
866 NUM '(' expression ')'
867 {
868 $$ = 0; /* FIXME */
869 }
870 | PRED '(' expression ')'
871 {
872 $$ = 0; /* FIXME */
873 }
874 | SUCC '(' expression ')'
875 {
876 $$ = 0; /* FIXME */
877 }
878 | ABS '(' expression ')'
879 {
880 $$ = 0; /* FIXME */
881 }
882 | CARD '(' expression ')'
883 {
884 $$ = 0; /* FIXME */
885 }
57ffffe3 886 | MAX_TOKEN '(' expression ')'
81028ab0
FF
887 {
888 $$ = 0; /* FIXME */
889 }
57ffffe3 890 | MIN_TOKEN '(' expression ')'
81028ab0
FF
891 {
892 $$ = 0; /* FIXME */
893 }
58cda66e
PB
894 | SIZE '(' expression ')'
895 { write_exp_elt_opcode (UNOP_SIZEOF); }
81028ab0 896 | SIZE '(' mode_argument ')'
58cda66e
PB
897 { write_exp_elt_opcode (OP_LONG);
898 write_exp_elt_type (builtin_type_int);
899 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
900 write_exp_elt_opcode (OP_LONG); }
81028ab0
FF
901 | UPPER '(' upper_lower_argument ')'
902 {
903 $$ = 0; /* FIXME */
904 }
905 | LOWER '(' upper_lower_argument ')'
906 {
907 $$ = 0; /* FIXME */
908 }
909 | LENGTH '(' length_argument ')'
910 {
911 $$ = 0; /* FIXME */
912 }
913 ;
914
915mode_argument : mode_name
916 {
58cda66e 917 $$ = $1.type;
81028ab0
FF
918 }
919 | array_mode_name '(' expression ')'
920 {
921 $$ = 0; /* FIXME */
922 }
923 | string_mode_name '(' expression ')'
924 {
925 $$ = 0; /* FIXME */
926 }
927 | variant_structure_mode_name '(' expression_list ')'
928 {
929 $$ = 0; /* FIXME */
930 }
931 ;
932
8a177da6
PB
933mode_name : TYPENAME
934 ;
935
936upper_lower_argument : expression
81028ab0
FF
937 {
938 $$ = 0; /* FIXME */
939 }
940 | mode_name
941 {
942 $$ = 0; /* FIXME */
943 }
944 ;
945
8a177da6 946length_argument : expression
81028ab0
FF
947 {
948 $$ = 0; /* FIXME */
949 }
950 ;
45fe3db4 951
e58de8a2 952/* Things which still need productions... */
54bbbfb4 953
2fcc38b8
FF
954array_mode_name : FIXME_08 { $$ = 0; }
955string_mode_name : FIXME_09 { $$ = 0; }
956variant_structure_mode_name: FIXME_10 { $$ = 0; }
957synonym_name : FIXME_11 { $$ = 0; }
958value_enumeration_name : FIXME_12 { $$ = 0; }
959value_do_with_name : FIXME_13 { $$ = 0; }
960value_receive_name : FIXME_14 { $$ = 0; }
961string_primitive_value : FIXME_15 { $$ = 0; }
962start_element : FIXME_16 { $$ = 0; }
963left_element : FIXME_17 { $$ = 0; }
964right_element : FIXME_18 { $$ = 0; }
965slice_size : FIXME_19 { $$ = 0; }
966lower_element : FIXME_20 { $$ = 0; }
967upper_element : FIXME_21 { $$ = 0; }
968first_element : FIXME_22 { $$ = 0; }
2fcc38b8
FF
969boolean_expression : FIXME_26 { $$ = 0; }
970case_selector_list : FIXME_27 { $$ = 0; }
971subexpression : FIXME_28 { $$ = 0; }
972case_label_specification: FIXME_29 { $$ = 0; }
973buffer_location : FIXME_30 { $$ = 0; }
e58de8a2
FF
974
975%%
976
c7da3ed3
FF
977/* Implementation of a dynamically expandable buffer for processing input
978 characters acquired through lexptr and building a value to return in
979 yylval. */
980
981static char *tempbuf; /* Current buffer contents */
982static int tempbufsize; /* Size of allocated buffer */
983static int tempbufindex; /* Current index into buffer */
984
985#define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
986
987#define CHECKBUF(size) \
988 do { \
989 if (tempbufindex + (size) >= tempbufsize) \
990 { \
991 growbuf_by_size (size); \
992 } \
993 } while (0);
994
995/* Grow the static temp buffer if necessary, including allocating the first one
996 on demand. */
997
998static void
999growbuf_by_size (count)
1000 int count;
1001{
1002 int growby;
1003
1004 growby = max (count, GROWBY_MIN_SIZE);
1005 tempbufsize += growby;
1006 if (tempbuf == NULL)
1007 {
1008 tempbuf = (char *) malloc (tempbufsize);
1009 }
1010 else
1011 {
1012 tempbuf = (char *) realloc (tempbuf, tempbufsize);
1013 }
1014}
1015
cbd1bdc3
FF
1016/* Try to consume a simple name string token. If successful, returns
1017 a pointer to a nullbyte terminated copy of the name that can be used
1018 in symbol table lookups. If not successful, returns NULL. */
1019
1020static char *
1021match_simple_name_string ()
1022{
1023 char *tokptr = lexptr;
1024
93dc3414 1025 if (isalpha (*tokptr) || *tokptr == '_')
cbd1bdc3 1026 {
5a7c9cce 1027 char *result;
cbd1bdc3
FF
1028 do {
1029 tokptr++;
5a7c9cce 1030 } while (isalnum (*tokptr) || (*tokptr == '_'));
cbd1bdc3
FF
1031 yylval.sval.ptr = lexptr;
1032 yylval.sval.length = tokptr - lexptr;
1033 lexptr = tokptr;
5a7c9cce 1034 result = copy_name (yylval.sval);
5a7c9cce 1035 return result;
cbd1bdc3
FF
1036 }
1037 return (NULL);
1038}
1039
5d074aa9
FF
1040/* Start looking for a value composed of valid digits as set by the base
1041 in use. Note that '_' characters are valid anywhere, in any quantity,
1042 and are simply ignored. Since we must find at least one valid digit,
1043 or reject this token as an integer literal, we keep track of how many
1044 digits we have encountered. */
1045
1046static int
1047decode_integer_value (base, tokptrptr, ivalptr)
1048 int base;
1049 char **tokptrptr;
1050 int *ivalptr;
1051{
1052 char *tokptr = *tokptrptr;
1053 int temp;
1054 int digits = 0;
1055
1056 while (*tokptr != '\0')
1057 {
db2302cb
PS
1058 temp = *tokptr;
1059 if (isupper (temp))
1060 temp = tolower (temp);
5d074aa9
FF
1061 tokptr++;
1062 switch (temp)
1063 {
1064 case '_':
1065 continue;
1066 case '0': case '1': case '2': case '3': case '4':
1067 case '5': case '6': case '7': case '8': case '9':
1068 temp -= '0';
1069 break;
1070 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1071 temp -= 'a';
1072 temp += 10;
1073 break;
1074 default:
1075 temp = base;
1076 break;
1077 }
1078 if (temp < base)
1079 {
1080 digits++;
1081 *ivalptr *= base;
1082 *ivalptr += temp;
1083 }
1084 else
1085 {
1086 /* Found something not in domain for current base. */
1087 tokptr--; /* Unconsume what gave us indigestion. */
1088 break;
1089 }
1090 }
1091
1092 /* If we didn't find any digits, then we don't have a valid integer
1093 value, so reject the entire token. Otherwise, update the lexical
1094 scan pointer, and return non-zero for success. */
1095
1096 if (digits == 0)
1097 {
1098 return (0);
1099 }
1100 else
1101 {
1102 *tokptrptr = tokptr;
1103 return (1);
1104 }
1105}
1106
e58de8a2 1107static int
2e66cf7d 1108decode_integer_literal (valptr, tokptrptr)
5d074aa9
FF
1109 int *valptr;
1110 char **tokptrptr;
e58de8a2 1111{
2e66cf7d
FF
1112 char *tokptr = *tokptrptr;
1113 int base = 0;
1114 int ival = 0;
2e66cf7d
FF
1115 int explicit_base = 0;
1116
1117 /* Look for an explicit base specifier, which is optional. */
1118
1119 switch (*tokptr)
1120 {
1121 case 'd':
1122 case 'D':
1123 explicit_base++;
1124 base = 10;
1125 tokptr++;
1126 break;
1127 case 'b':
1128 case 'B':
1129 explicit_base++;
1130 base = 2;
1131 tokptr++;
1132 break;
1133 case 'h':
1134 case 'H':
1135 explicit_base++;
1136 base = 16;
1137 tokptr++;
1138 break;
1139 case 'o':
1140 case 'O':
1141 explicit_base++;
1142 base = 8;
1143 tokptr++;
1144 break;
1145 default:
1146 base = 10;
1147 break;
1148 }
1149
1150 /* If we found an explicit base ensure that the character after the
1151 explicit base is a single quote. */
1152
1153 if (explicit_base && (*tokptr++ != '\''))
1154 {
1155 return (0);
1156 }
1157
5d074aa9
FF
1158 /* Attempt to decode whatever follows as an integer value in the
1159 indicated base, updating the token pointer in the process and
1160 computing the value into ival. Also, if we have an explicit
2e66cf7d 1161 base, then the next character must not be a single quote, or we
5d074aa9
FF
1162 have a bitstring literal, so reject the entire token in this case.
1163 Otherwise, update the lexical scan pointer, and return non-zero
1164 for success. */
1165
1166 if (!decode_integer_value (base, &tokptr, &ival))
2e66cf7d
FF
1167 {
1168 return (0);
1169 }
1170 else if (explicit_base && (*tokptr == '\''))
1171 {
1172 return (0);
1173 }
1174 else
1175 {
1176 *valptr = ival;
1177 *tokptrptr = tokptr;
1178 return (1);
1179 }
1180}
1181
1188fbbf
FF
1182/* If it wasn't for the fact that floating point values can contain '_'
1183 characters, we could just let strtod do all the hard work by letting it
1184 try to consume as much of the current token buffer as possible and
1185 find a legal conversion. Unfortunately we need to filter out the '_'
1186 characters before calling strtod, which we do by copying the other
1187 legal chars to a local buffer to be converted. However since we also
1188 need to keep track of where the last unconsumed character in the input
1189 buffer is, we have transfer only as many characters as may compose a
1190 legal floating point value. */
1191
1192static int
1193match_float_literal ()
1194{
1195 char *tokptr = lexptr;
1196 char *buf;
1197 char *copy;
1188fbbf
FF
1198 double dval;
1199 extern double strtod ();
1200
1201 /* Make local buffer in which to build the string to convert. This is
1202 required because underscores are valid in chill floating point numbers
1203 but not in the string passed to strtod to convert. The string will be
1204 no longer than our input string. */
1205
1206 copy = buf = (char *) alloca (strlen (tokptr) + 1);
1207
1208 /* Transfer all leading digits to the conversion buffer, discarding any
1209 underscores. */
1210
1211 while (isdigit (*tokptr) || *tokptr == '_')
1212 {
1213 if (*tokptr != '_')
1214 {
1215 *copy++ = *tokptr;
1216 }
1217 tokptr++;
1218 }
1219
1220 /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
1221 of whether we found any leading digits, and we simply accept it and
1222 continue on to look for the fractional part and/or exponent. One of
1223 [eEdD] is legal only if we have seen digits, and means that there
1224 is no fractional part. If we find neither of these, then this is
1225 not a floating point number, so return failure. */
1226
1227 switch (*tokptr++)
1228 {
1229 case '.':
1230 /* Accept and then look for fractional part and/or exponent. */
1231 *copy++ = '.';
1232 break;
1233
1234 case 'e':
1235 case 'E':
1236 case 'd':
1237 case 'D':
1238 if (copy == buf)
1239 {
1240 return (0);
1241 }
1242 *copy++ = 'e';
1243 goto collect_exponent;
1244 break;
1245
1246 default:
1247 return (0);
1248 break;
1249 }
1250
1251 /* We found a '.', copy any fractional digits to the conversion buffer, up
1252 to the first nondigit, non-underscore character. */
1253
1254 while (isdigit (*tokptr) || *tokptr == '_')
1255 {
1256 if (*tokptr != '_')
1257 {
1258 *copy++ = *tokptr;
1259 }
1260 tokptr++;
1261 }
1262
1263 /* Look for an exponent, which must start with one of [eEdD]. If none
1264 is found, jump directly to trying to convert what we have collected
1265 so far. */
1266
1267 switch (*tokptr)
1268 {
1269 case 'e':
1270 case 'E':
1271 case 'd':
1272 case 'D':
1273 *copy++ = 'e';
1274 tokptr++;
1275 break;
1276 default:
1277 goto convert_float;
1278 break;
1279 }
1280
1281 /* Accept an optional '-' or '+' following one of [eEdD]. */
1282
1283 collect_exponent:
1284 if (*tokptr == '+' || *tokptr == '-')
1285 {
1286 *copy++ = *tokptr++;
1287 }
1288
1289 /* Now copy an exponent into the conversion buffer. Note that at the
1290 moment underscores are *not* allowed in exponents. */
1291
1292 while (isdigit (*tokptr))
1293 {
1294 *copy++ = *tokptr++;
1295 }
1296
1297 /* If we transfered any chars to the conversion buffer, try to interpret its
1298 contents as a floating point value. If any characters remain, then we
1299 must not have a valid floating point string. */
1300
1301 convert_float:
1302 *copy = '\0';
1303 if (copy != buf)
1304 {
1305 dval = strtod (buf, &copy);
1306 if (*copy == '\0')
1307 {
1308 yylval.dval = dval;
1309 lexptr = tokptr;
1310 return (FLOAT_LITERAL);
1311 }
1312 }
1313 return (0);
1314}
1315
96b6b765 1316/* Recognize a string literal. A string literal is a sequence
c7da3ed3
FF
1317 of characters enclosed in matching single or double quotes, except that
1318 a single character inside single quotes is a character literal, which
1319 we reject as a string literal. To embed the terminator character inside
1320 a string, it is simply doubled (I.E. "this""is""one""string") */
1321
1322static int
1323match_string_literal ()
1324{
1325 char *tokptr = lexptr;
1326
1327 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1328 {
1329 CHECKBUF (1);
1330 if (*tokptr == *lexptr)
1331 {
1332 if (*(tokptr + 1) == *lexptr)
1333 {
1334 tokptr++;
1335 }
1336 else
1337 {
1338 break;
1339 }
1340 }
1341 tempbuf[tempbufindex++] = *tokptr;
1342 }
1343 if (*tokptr == '\0' /* no terminator */
c7da3ed3
FF
1344 || (tempbufindex == 1 && *tokptr == '\'')) /* char literal */
1345 {
1346 return (0);
1347 }
1348 else
1349 {
1350 tempbuf[tempbufindex] = '\0';
1351 yylval.sval.ptr = tempbuf;
1352 yylval.sval.length = tempbufindex;
1353 lexptr = ++tokptr;
1354 return (CHARACTER_STRING_LITERAL);
1355 }
1356}
1357
2e66cf7d
FF
1358/* Recognize a character literal. A character literal is single character
1359 or a control sequence, enclosed in single quotes. A control sequence
1360 is a comma separated list of one or more integer literals, enclosed
1361 in parenthesis and introduced with a circumflex character.
1362
1363 EX: 'a' '^(7)' '^(7,8)'
1364
5d074aa9
FF
1365 As a GNU chill extension, the syntax C'xx' is also recognized as a
1366 character literal, where xx is a hex value for the character.
1367
c7da3ed3
FF
1368 Note that more than a single character, enclosed in single quotes, is
1369 a string literal.
1370
c4413e2c
FF
1371 Also note that the control sequence form is not in GNU Chill since it
1372 is ambiguous with the string literal form using single quotes. I.E.
1373 is '^(7)' a character literal or a string literal. In theory it it
1374 possible to tell by context, but GNU Chill doesn't accept the control
1375 sequence form, so neither do we (for now the code is disabled).
1376
2e66cf7d
FF
1377 Returns CHARACTER_LITERAL if a match is found.
1378 */
1379
1380static int
1381match_character_literal ()
1382{
1383 char *tokptr = lexptr;
1384 int ival = 0;
1385
db2302cb 1386 if ((*tokptr == 'c' || *tokptr == 'C') && (*(tokptr + 1) == '\''))
2e66cf7d 1387 {
5d074aa9
FF
1388 /* We have a GNU chill extension form, so skip the leading "C'",
1389 decode the hex value, and then ensure that we have a trailing
1390 single quote character. */
2e66cf7d 1391 tokptr += 2;
5d074aa9 1392 if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
e58de8a2 1393 {
2e66cf7d 1394 return (0);
e58de8a2 1395 }
5d074aa9 1396 tokptr++;
2e66cf7d 1397 }
5d074aa9 1398 else if (*tokptr == '\'')
2e66cf7d 1399 {
5d074aa9 1400 tokptr++;
2e66cf7d 1401
5d074aa9
FF
1402 /* Determine which form we have, either a control sequence or the
1403 single character form. */
1404
1405 if ((*tokptr == '^') && (*(tokptr + 1) == '('))
1406 {
9da75ad3 1407#if 0 /* Disable, see note above. -fnf */
5d074aa9
FF
1408 /* Match and decode a control sequence. Return zero if we don't
1409 find a valid integer literal, or if the next unconsumed character
1410 after the integer literal is not the trailing ')'.
1411 FIXME: We currently don't handle the multiple integer literal
1412 form. */
1413 tokptr += 2;
1414 if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
1415 {
1416 return (0);
1417 }
9da75ad3
FF
1418#else
1419 return (0);
1420#endif
5d074aa9
FF
1421 }
1422 else
1423 {
1424 ival = *tokptr++;
1425 }
1426
1427 /* The trailing quote has not yet been consumed. If we don't find
1428 it, then we have no match. */
1429
1430 if (*tokptr++ != '\'')
1431 {
1432 return (0);
1433 }
2e66cf7d 1434 }
aed656ba
FF
1435 else
1436 {
1437 /* Not a character literal. */
1438 return (0);
1439 }
2e66cf7d
FF
1440 yylval.typed_val.val = ival;
1441 yylval.typed_val.type = builtin_type_chill_char;
1442 lexptr = tokptr;
1443 return (CHARACTER_LITERAL);
e58de8a2
FF
1444}
1445
1446/* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1447 Note that according to 5.2.4.2, a single "_" is also a valid integer
1448 literal, however GNU-chill requires there to be at least one "digit"
1449 in any integer literal. */
1450
1451static int
2e66cf7d 1452match_integer_literal ()
e58de8a2 1453{
2e66cf7d 1454 char *tokptr = lexptr;
ae0afa4b 1455 int ival;
2e66cf7d 1456
ae0afa4b 1457 if (!decode_integer_literal (&ival, &tokptr))
2e66cf7d
FF
1458 {
1459 return (0);
1460 }
ae0afa4b 1461 else
2e66cf7d
FF
1462 {
1463 yylval.typed_val.val = ival;
1464 yylval.typed_val.type = builtin_type_int;
1465 lexptr = tokptr;
1466 return (INTEGER_LITERAL);
1467 }
e58de8a2
FF
1468}
1469
81028ab0
FF
1470/* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
1471 Note that according to 5.2.4.8, a single "_" is also a valid bit-string
1472 literal, however GNU-chill requires there to be at least one "digit"
1473 in any bit-string literal. */
1474
1475static int
1476match_bitstring_literal ()
1477{
1478 char *tokptr = lexptr;
1479 int mask;
1480 int bitoffset = 0;
1481 int bitcount = 0;
1482 int base;
1483 int digit;
81028ab0 1484
c7da3ed3
FF
1485 tempbufindex = 0;
1486
81028ab0
FF
1487 /* Look for the required explicit base specifier. */
1488
1489 switch (*tokptr++)
1490 {
1491 case 'b':
1492 case 'B':
1493 base = 2;
1494 break;
1495 case 'o':
1496 case 'O':
1497 base = 8;
1498 break;
1499 case 'h':
1500 case 'H':
1501 base = 16;
1502 break;
1503 default:
1504 return (0);
1505 break;
1506 }
1507
1508 /* Ensure that the character after the explicit base is a single quote. */
1509
1510 if (*tokptr++ != '\'')
1511 {
1512 return (0);
1513 }
1514
1515 while (*tokptr != '\0' && *tokptr != '\'')
1516 {
db2302cb
PS
1517 digit = *tokptr;
1518 if (isupper (digit))
1519 digit = tolower (digit);
81028ab0
FF
1520 tokptr++;
1521 switch (digit)
1522 {
1523 case '_':
1524 continue;
1525 case '0': case '1': case '2': case '3': case '4':
1526 case '5': case '6': case '7': case '8': case '9':
1527 digit -= '0';
1528 break;
1529 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1530 digit -= 'a';
1531 digit += 10;
1532 break;
1533 default:
1534 return (0);
1535 break;
1536 }
1537 if (digit >= base)
1538 {
1539 /* Found something not in domain for current base. */
1540 return (0);
1541 }
1542 else
1543 {
1544 /* Extract bits from digit, starting with the msbit appropriate for
1545 the current base, and packing them into the bitstring byte,
1546 starting at the lsbit. */
1547 for (mask = (base >> 1); mask > 0; mask >>= 1)
1548 {
1549 bitcount++;
c7da3ed3 1550 CHECKBUF (1);
81028ab0
FF
1551 if (digit & mask)
1552 {
1553 tempbuf[tempbufindex] |= (1 << bitoffset);
1554 }
1555 bitoffset++;
1556 if (bitoffset == HOST_CHAR_BIT)
1557 {
1558 bitoffset = 0;
1559 tempbufindex++;
1560 }
1561 }
1562 }
1563 }
1564
1565 /* Verify that we consumed everything up to the trailing single quote,
1566 and that we found some bits (IE not just underbars). */
1567
1568 if (*tokptr++ != '\'')
1569 {
1570 return (0);
1571 }
1572 else
1573 {
1574 yylval.sval.ptr = tempbuf;
1575 yylval.sval.length = bitcount;
1576 lexptr = tokptr;
1577 return (BIT_STRING_LITERAL);
1578 }
1579}
1580
45fe3db4
FF
1581/* Recognize tokens that start with '$'. These include:
1582
1583 $regname A native register name or a "standard
1584 register name".
1585 Return token GDB_REGNAME.
1586
1587 $variable A convenience variable with a name chosen
1588 by the user.
1589 Return token GDB_VARIABLE.
1590
1591 $digits Value history with index <digits>, starting
1592 from the first value which has index 1.
1593 Return GDB_LAST.
1594
1595 $$digits Value history with index <digits> relative
1596 to the last value. I.E. $$0 is the last
1597 value, $$1 is the one previous to that, $$2
1598 is the one previous to $$1, etc.
1599 Return token GDB_LAST.
1600
1601 $ | $0 | $$0 The last value in the value history.
1602 Return token GDB_LAST.
1603
1604 $$ An abbreviation for the second to the last
1605 value in the value history, I.E. $$1
1606 Return token GDB_LAST.
1607
1608 Note that we currently assume that register names and convenience
1609 variables follow the convention of starting with a letter or '_'.
1610
1611 */
1612
1613static int
1614match_dollar_tokens ()
1615{
1616 char *tokptr;
1617 int regno;
1618 int namelength;
1619 int negate;
1620 int ival;
1621
1622 /* We will always have a successful match, even if it is just for
1623 a single '$', the abbreviation for $$0. So advance lexptr. */
1624
1625 tokptr = ++lexptr;
1626
1627 if (*tokptr == '_' || isalpha (*tokptr))
1628 {
1629 /* Look for a match with a native register name, usually something
1630 like "r0" for example. */
1631
1632 for (regno = 0; regno < NUM_REGS; regno++)
1633 {
1634 namelength = strlen (reg_names[regno]);
1635 if (STREQN (tokptr, reg_names[regno], namelength)
1636 && !isalnum (tokptr[namelength]))
1637 {
1638 yylval.lval = regno;
cba00921 1639 lexptr += namelength;
45fe3db4
FF
1640 return (GDB_REGNAME);
1641 }
1642 }
1643
1644 /* Look for a match with a standard register name, usually something
1645 like "pc", which gdb always recognizes as the program counter
1646 regardless of what the native register name is. */
1647
1648 for (regno = 0; regno < num_std_regs; regno++)
1649 {
1650 namelength = strlen (std_regs[regno].name);
1651 if (STREQN (tokptr, std_regs[regno].name, namelength)
1652 && !isalnum (tokptr[namelength]))
1653 {
1654 yylval.lval = std_regs[regno].regnum;
1655 lexptr += namelength;
1656 return (GDB_REGNAME);
1657 }
1658 }
1659
1660 /* Attempt to match against a convenience variable. Note that
1661 this will always succeed, because if no variable of that name
1662 already exists, the lookup_internalvar will create one for us.
1663 Also note that both lexptr and tokptr currently point to the
1664 start of the input string we are trying to match, and that we
1665 have already tested the first character for non-numeric, so we
1666 don't have to treat it specially. */
1667
1668 while (*tokptr == '_' || isalnum (*tokptr))
1669 {
1670 tokptr++;
1671 }
1672 yylval.sval.ptr = lexptr;
1673 yylval.sval.length = tokptr - lexptr;
1674 yylval.ivar = lookup_internalvar (copy_name (yylval.sval));
1675 lexptr = tokptr;
1676 return (GDB_VARIABLE);
1677 }
1678
1679 /* Since we didn't match against a register name or convenience
1680 variable, our only choice left is a history value. */
1681
1682 if (*tokptr == '$')
1683 {
1684 negate = 1;
1685 ival = 1;
1686 tokptr++;
1687 }
1688 else
1689 {
1690 negate = 0;
1691 ival = 0;
1692 }
1693
1694 /* Attempt to decode more characters as an integer value giving
1695 the index in the history list. If successful, the value will
1696 overwrite ival (currently 0 or 1), and if not, ival will be
1697 left alone, which is good since it is currently correct for
1698 the '$' or '$$' case. */
1699
1700 decode_integer_literal (&ival, &tokptr);
1701 yylval.lval = negate ? -ival : ival;
1702 lexptr = tokptr;
1703 return (GDB_LAST);
1704}
1705
e58de8a2
FF
1706struct token
1707{
1708 char *operator;
1709 int token;
1710};
1711
5a7c9cce 1712static const struct token idtokentab[] =
81028ab0 1713{
5a7c9cce
PB
1714 { "length", LENGTH },
1715 { "lower", LOWER },
1716 { "upper", UPPER },
1717 { "andif", ANDIF },
1718 { "pred", PRED },
1719 { "succ", SUCC },
1720 { "card", CARD },
1721 { "size", SIZE },
1722 { "orif", ORIF },
1723 { "num", NUM },
1724 { "abs", ABS },
57ffffe3
JG
1725 { "max", MAX_TOKEN },
1726 { "min", MIN_TOKEN },
5a7c9cce
PB
1727 { "mod", MOD },
1728 { "rem", REM },
1729 { "not", NOT },
1730 { "xor", LOGXOR },
1731 { "and", LOGAND },
1732 { "in", IN },
2d67c7e9
PB
1733 { "or", LOGIOR },
1734 { "null", EMPTINESS_LITERAL }
e58de8a2
FF
1735};
1736
a8a69e63 1737static const struct token tokentab2[] =
e58de8a2 1738{
45fe3db4 1739 { ":=", GDB_ASSIGNMENT },
e58de8a2 1740 { "//", SLASH_SLASH },
8a177da6 1741 { "->", POINTER },
e58de8a2
FF
1742 { "/=", NOTEQUAL },
1743 { "<=", LEQ },
5a7c9cce 1744 { ">=", GTR }
e58de8a2
FF
1745};
1746
1747/* Read one token, getting characters through lexptr. */
1748/* This is where we will check to make sure that the language and the
1749 operators used are compatible. */
1750
1751static int
1752yylex ()
1753{
1754 unsigned int i;
1755 int token;
ad86f717 1756 char *inputname;
cbd1bdc3 1757 struct symbol *sym;
e58de8a2
FF
1758
1759 /* Skip over any leading whitespace. */
1760 while (isspace (*lexptr))
1761 {
1762 lexptr++;
1763 }
1764 /* Look for special single character cases which can't be the first
1765 character of some other multicharacter token. */
1766 switch (*lexptr)
1767 {
1768 case '\0':
1769 return (0);
54bbbfb4 1770 case ',':
e58de8a2 1771 case '=':
e58de8a2
FF
1772 case ';':
1773 case '!':
1774 case '+':
e58de8a2 1775 case '*':
e58de8a2
FF
1776 case '(':
1777 case ')':
1778 case '[':
1779 case ']':
1780 return (*lexptr++);
1781 }
1782 /* Look for characters which start a particular kind of multicharacter
45fe3db4 1783 token, such as a character literal, register name, convenience
c7da3ed3 1784 variable name, string literal, etc. */
e58de8a2 1785 switch (*lexptr)
2e66cf7d 1786 {
c7da3ed3
FF
1787 case '\'':
1788 case '\"':
96b6b765 1789 /* First try to match a string literal, which is any
c7da3ed3
FF
1790 sequence of characters enclosed in matching single or double
1791 quotes, except that a single character inside single quotes
1792 is a character literal, so we have to catch that case also. */
1793 token = match_string_literal ();
1794 if (token != 0)
1795 {
1796 return (token);
1797 }
1798 if (*lexptr == '\'')
1799 {
1800 token = match_character_literal ();
1801 if (token != 0)
1802 {
1803 return (token);
1804 }
1805 }
1806 break;
5d074aa9
FF
1807 case 'C':
1808 case 'c':
2e66cf7d
FF
1809 token = match_character_literal ();
1810 if (token != 0)
1811 {
1812 return (token);
1813 }
1814 break;
45fe3db4
FF
1815 case '$':
1816 token = match_dollar_tokens ();
1817 if (token != 0)
1818 {
1819 return (token);
1820 }
1821 break;
2e66cf7d 1822 }
e58de8a2
FF
1823 /* See if it is a special token of length 2. */
1824 for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1825 {
45fe3db4 1826 if (STREQN (lexptr, tokentab2[i].operator, 2))
e58de8a2
FF
1827 {
1828 lexptr += 2;
1829 return (tokentab2[i].token);
1830 }
1831 }
1832 /* Look for single character cases which which could be the first
1833 character of some other multicharacter token, but aren't, or we
1834 would already have found it. */
1835 switch (*lexptr)
1836 {
8a177da6 1837 case '-':
45fe3db4 1838 case ':':
e58de8a2
FF
1839 case '/':
1840 case '<':
1841 case '>':
1842 return (*lexptr++);
1843 }
1188fbbf
FF
1844 /* Look for a float literal before looking for an integer literal, so
1845 we match as much of the input stream as possible. */
1846 token = match_float_literal ();
81028ab0
FF
1847 if (token != 0)
1848 {
1849 return (token);
1850 }
1851 token = match_bitstring_literal ();
1188fbbf
FF
1852 if (token != 0)
1853 {
1854 return (token);
1855 }
2e66cf7d 1856 token = match_integer_literal ();
cbd1bdc3 1857 if (token != 0)
e58de8a2
FF
1858 {
1859 return (token);
1860 }
cbd1bdc3
FF
1861
1862 /* Try to match a simple name string, and if a match is found, then
1863 further classify what sort of name it is and return an appropriate
1864 token. Note that attempting to match a simple name string consumes
1865 the token from lexptr, so we can't back out if we later find that
1866 we can't classify what sort of name it is. */
1867
ad86f717 1868 inputname = match_simple_name_string ();
5a7c9cce 1869
ad86f717 1870 if (inputname != NULL)
cbd1bdc3 1871 {
a30e2087 1872 char *simplename = (char*) alloca (strlen (inputname) + 1);
ad86f717
PB
1873
1874 char *dptr = simplename, *sptr = inputname;
1875 for (; *sptr; sptr++)
1876 *dptr++ = isupper (*sptr) ? tolower(*sptr) : *sptr;
a30e2087 1877 *dptr = '\0';
ad86f717 1878
d8f23320
PS
1879 /* See if it is a reserved identifier. */
1880 for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
1881 {
1882 if (STREQ (simplename, idtokentab[i].operator))
1883 {
1884 return (idtokentab[i].token);
1885 }
1886 }
1887
1888 /* Look for other special tokens. */
1889 if (STREQ (simplename, "true"))
1890 {
1891 yylval.ulval = 1;
1892 return (BOOLEAN_LITERAL);
1893 }
1894 if (STREQ (simplename, "false"))
1895 {
1896 yylval.ulval = 0;
1897 return (BOOLEAN_LITERAL);
1898 }
1899
ad86f717 1900 sym = lookup_symbol (inputname, expression_context_block,
cbd1bdc3
FF
1901 VAR_NAMESPACE, (int *) NULL,
1902 (struct symtab **) NULL);
ad86f717
PB
1903 if (sym == NULL && strcmp (inputname, simplename) != 0)
1904 {
1905 sym = lookup_symbol (simplename, expression_context_block,
1906 VAR_NAMESPACE, (int *) NULL,
1907 (struct symtab **) NULL);
1908 }
cbd1bdc3
FF
1909 if (sym != NULL)
1910 {
1911 yylval.ssym.stoken.ptr = NULL;
1912 yylval.ssym.stoken.length = 0;
1913 yylval.ssym.sym = sym;
1914 yylval.ssym.is_a_field_of_this = 0; /* FIXME, C++'ism */
1915 switch (SYMBOL_CLASS (sym))
1916 {
1917 case LOC_BLOCK:
1918 /* Found a procedure name. */
1919 return (GENERAL_PROCEDURE_NAME);
1920 case LOC_STATIC:
1921 /* Found a global or local static variable. */
1922 return (LOCATION_NAME);
a8a69e63
FF
1923 case LOC_REGISTER:
1924 case LOC_ARG:
1925 case LOC_REF_ARG:
1926 case LOC_REGPARM:
996ccb30 1927 case LOC_REGPARM_ADDR:
a8a69e63 1928 case LOC_LOCAL:
76a0ffb4 1929 case LOC_LOCAL_ARG:
a1c8d76e
JK
1930 case LOC_BASEREG:
1931 case LOC_BASEREG_ARG:
76a0ffb4
FF
1932 if (innermost_block == NULL
1933 || contained_in (block_found, innermost_block))
1934 {
1935 innermost_block = block_found;
1936 }
1937 return (LOCATION_NAME);
1938 break;
1939 case LOC_CONST:
a8a69e63 1940 case LOC_LABEL:
76a0ffb4
FF
1941 return (LOCATION_NAME);
1942 break;
76a0ffb4 1943 case LOC_TYPEDEF:
8a177da6
PB
1944 yylval.tsym.type = SYMBOL_TYPE (sym);
1945 return TYPENAME;
1946 case LOC_UNDEF:
a8a69e63 1947 case LOC_CONST_BYTES:
0848ad1c 1948 case LOC_OPTIMIZED_OUT:
ad86f717 1949 error ("Symbol \"%s\" names no location.", inputname);
a8a69e63 1950 break;
cbd1bdc3
FF
1951 }
1952 }
1953 else if (!have_full_symbols () && !have_partial_symbols ())
1954 {
1955 error ("No symbol table is loaded. Use the \"file\" command.");
1956 }
1957 else
1958 {
ad86f717 1959 error ("No symbol \"%s\" in current context.", inputname);
cbd1bdc3
FF
1960 }
1961 }
1962
1188fbbf
FF
1963 /* Catch single character tokens which are not part of some
1964 longer token. */
1965
1966 switch (*lexptr)
1967 {
1968 case '.': /* Not float for example. */
8a177da6
PB
1969 lexptr++;
1970 while (isspace (*lexptr)) lexptr++;
ad86f717
PB
1971 inputname = match_simple_name_string ();
1972 if (!inputname)
8a177da6
PB
1973 return '.';
1974 return FIELD_NAME;
1188fbbf
FF
1975 }
1976
e58de8a2
FF
1977 return (ILLEGAL_TOKEN);
1978}
1979
22e39759 1980void
e58de8a2 1981yyerror (msg)
8db1a922 1982 char *msg;
e58de8a2 1983{
8db1a922 1984 error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
e58de8a2 1985}
This page took 0.283143 seconds and 4 git commands to generate.