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