* som.h (R_HPPA_COMPLEX): Fix dumb typo.
[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 1055 result = copy_name (yylval.sval);
5a7c9cce 1056 return result;
cbd1bdc3
FF
1057 }
1058 return (NULL);
1059}
1060
5d074aa9
FF
1061/* Start looking for a value composed of valid digits as set by the base
1062 in use. Note that '_' characters are valid anywhere, in any quantity,
1063 and are simply ignored. Since we must find at least one valid digit,
1064 or reject this token as an integer literal, we keep track of how many
1065 digits we have encountered. */
1066
1067static int
1068decode_integer_value (base, tokptrptr, ivalptr)
1069 int base;
1070 char **tokptrptr;
1071 int *ivalptr;
1072{
1073 char *tokptr = *tokptrptr;
1074 int temp;
1075 int digits = 0;
1076
1077 while (*tokptr != '\0')
1078 {
db2302cb
PS
1079 temp = *tokptr;
1080 if (isupper (temp))
1081 temp = tolower (temp);
5d074aa9
FF
1082 tokptr++;
1083 switch (temp)
1084 {
1085 case '_':
1086 continue;
1087 case '0': case '1': case '2': case '3': case '4':
1088 case '5': case '6': case '7': case '8': case '9':
1089 temp -= '0';
1090 break;
1091 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1092 temp -= 'a';
1093 temp += 10;
1094 break;
1095 default:
1096 temp = base;
1097 break;
1098 }
1099 if (temp < base)
1100 {
1101 digits++;
1102 *ivalptr *= base;
1103 *ivalptr += temp;
1104 }
1105 else
1106 {
1107 /* Found something not in domain for current base. */
1108 tokptr--; /* Unconsume what gave us indigestion. */
1109 break;
1110 }
1111 }
1112
1113 /* If we didn't find any digits, then we don't have a valid integer
1114 value, so reject the entire token. Otherwise, update the lexical
1115 scan pointer, and return non-zero for success. */
1116
1117 if (digits == 0)
1118 {
1119 return (0);
1120 }
1121 else
1122 {
1123 *tokptrptr = tokptr;
1124 return (1);
1125 }
1126}
1127
e58de8a2 1128static int
2e66cf7d 1129decode_integer_literal (valptr, tokptrptr)
5d074aa9
FF
1130 int *valptr;
1131 char **tokptrptr;
e58de8a2 1132{
2e66cf7d
FF
1133 char *tokptr = *tokptrptr;
1134 int base = 0;
1135 int ival = 0;
2e66cf7d
FF
1136 int explicit_base = 0;
1137
1138 /* Look for an explicit base specifier, which is optional. */
1139
1140 switch (*tokptr)
1141 {
1142 case 'd':
1143 case 'D':
1144 explicit_base++;
1145 base = 10;
1146 tokptr++;
1147 break;
1148 case 'b':
1149 case 'B':
1150 explicit_base++;
1151 base = 2;
1152 tokptr++;
1153 break;
1154 case 'h':
1155 case 'H':
1156 explicit_base++;
1157 base = 16;
1158 tokptr++;
1159 break;
1160 case 'o':
1161 case 'O':
1162 explicit_base++;
1163 base = 8;
1164 tokptr++;
1165 break;
1166 default:
1167 base = 10;
1168 break;
1169 }
1170
1171 /* If we found an explicit base ensure that the character after the
1172 explicit base is a single quote. */
1173
1174 if (explicit_base && (*tokptr++ != '\''))
1175 {
1176 return (0);
1177 }
1178
5d074aa9
FF
1179 /* Attempt to decode whatever follows as an integer value in the
1180 indicated base, updating the token pointer in the process and
1181 computing the value into ival. Also, if we have an explicit
2e66cf7d 1182 base, then the next character must not be a single quote, or we
5d074aa9
FF
1183 have a bitstring literal, so reject the entire token in this case.
1184 Otherwise, update the lexical scan pointer, and return non-zero
1185 for success. */
1186
1187 if (!decode_integer_value (base, &tokptr, &ival))
2e66cf7d
FF
1188 {
1189 return (0);
1190 }
1191 else if (explicit_base && (*tokptr == '\''))
1192 {
1193 return (0);
1194 }
1195 else
1196 {
1197 *valptr = ival;
1198 *tokptrptr = tokptr;
1199 return (1);
1200 }
1201}
1202
1188fbbf
FF
1203/* If it wasn't for the fact that floating point values can contain '_'
1204 characters, we could just let strtod do all the hard work by letting it
1205 try to consume as much of the current token buffer as possible and
1206 find a legal conversion. Unfortunately we need to filter out the '_'
1207 characters before calling strtod, which we do by copying the other
1208 legal chars to a local buffer to be converted. However since we also
1209 need to keep track of where the last unconsumed character in the input
1210 buffer is, we have transfer only as many characters as may compose a
1211 legal floating point value. */
1212
1213static int
1214match_float_literal ()
1215{
1216 char *tokptr = lexptr;
1217 char *buf;
1218 char *copy;
1188fbbf
FF
1219 double dval;
1220 extern double strtod ();
1221
1222 /* Make local buffer in which to build the string to convert. This is
1223 required because underscores are valid in chill floating point numbers
1224 but not in the string passed to strtod to convert. The string will be
1225 no longer than our input string. */
1226
1227 copy = buf = (char *) alloca (strlen (tokptr) + 1);
1228
1229 /* Transfer all leading digits to the conversion buffer, discarding any
1230 underscores. */
1231
1232 while (isdigit (*tokptr) || *tokptr == '_')
1233 {
1234 if (*tokptr != '_')
1235 {
1236 *copy++ = *tokptr;
1237 }
1238 tokptr++;
1239 }
1240
1241 /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
1242 of whether we found any leading digits, and we simply accept it and
1243 continue on to look for the fractional part and/or exponent. One of
1244 [eEdD] is legal only if we have seen digits, and means that there
1245 is no fractional part. If we find neither of these, then this is
1246 not a floating point number, so return failure. */
1247
1248 switch (*tokptr++)
1249 {
1250 case '.':
1251 /* Accept and then look for fractional part and/or exponent. */
1252 *copy++ = '.';
1253 break;
1254
1255 case 'e':
1256 case 'E':
1257 case 'd':
1258 case 'D':
1259 if (copy == buf)
1260 {
1261 return (0);
1262 }
1263 *copy++ = 'e';
1264 goto collect_exponent;
1265 break;
1266
1267 default:
1268 return (0);
1269 break;
1270 }
1271
1272 /* We found a '.', copy any fractional digits to the conversion buffer, up
1273 to the first nondigit, non-underscore character. */
1274
1275 while (isdigit (*tokptr) || *tokptr == '_')
1276 {
1277 if (*tokptr != '_')
1278 {
1279 *copy++ = *tokptr;
1280 }
1281 tokptr++;
1282 }
1283
1284 /* Look for an exponent, which must start with one of [eEdD]. If none
1285 is found, jump directly to trying to convert what we have collected
1286 so far. */
1287
1288 switch (*tokptr)
1289 {
1290 case 'e':
1291 case 'E':
1292 case 'd':
1293 case 'D':
1294 *copy++ = 'e';
1295 tokptr++;
1296 break;
1297 default:
1298 goto convert_float;
1299 break;
1300 }
1301
1302 /* Accept an optional '-' or '+' following one of [eEdD]. */
1303
1304 collect_exponent:
1305 if (*tokptr == '+' || *tokptr == '-')
1306 {
1307 *copy++ = *tokptr++;
1308 }
1309
1310 /* Now copy an exponent into the conversion buffer. Note that at the
1311 moment underscores are *not* allowed in exponents. */
1312
1313 while (isdigit (*tokptr))
1314 {
1315 *copy++ = *tokptr++;
1316 }
1317
1318 /* If we transfered any chars to the conversion buffer, try to interpret its
1319 contents as a floating point value. If any characters remain, then we
1320 must not have a valid floating point string. */
1321
1322 convert_float:
1323 *copy = '\0';
1324 if (copy != buf)
1325 {
1326 dval = strtod (buf, &copy);
1327 if (*copy == '\0')
1328 {
1329 yylval.dval = dval;
1330 lexptr = tokptr;
1331 return (FLOAT_LITERAL);
1332 }
1333 }
1334 return (0);
1335}
1336
96b6b765 1337/* Recognize a string literal. A string literal is a sequence
c7da3ed3
FF
1338 of characters enclosed in matching single or double quotes, except that
1339 a single character inside single quotes is a character literal, which
1340 we reject as a string literal. To embed the terminator character inside
1341 a string, it is simply doubled (I.E. "this""is""one""string") */
1342
1343static int
1344match_string_literal ()
1345{
1346 char *tokptr = lexptr;
1347
1348 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1349 {
1350 CHECKBUF (1);
1351 if (*tokptr == *lexptr)
1352 {
1353 if (*(tokptr + 1) == *lexptr)
1354 {
1355 tokptr++;
1356 }
1357 else
1358 {
1359 break;
1360 }
1361 }
1362 tempbuf[tempbufindex++] = *tokptr;
1363 }
1364 if (*tokptr == '\0' /* no terminator */
c7da3ed3
FF
1365 || (tempbufindex == 1 && *tokptr == '\'')) /* char literal */
1366 {
1367 return (0);
1368 }
1369 else
1370 {
1371 tempbuf[tempbufindex] = '\0';
1372 yylval.sval.ptr = tempbuf;
1373 yylval.sval.length = tempbufindex;
1374 lexptr = ++tokptr;
1375 return (CHARACTER_STRING_LITERAL);
1376 }
1377}
1378
2e66cf7d
FF
1379/* Recognize a character literal. A character literal is single character
1380 or a control sequence, enclosed in single quotes. A control sequence
1381 is a comma separated list of one or more integer literals, enclosed
1382 in parenthesis and introduced with a circumflex character.
1383
1384 EX: 'a' '^(7)' '^(7,8)'
1385
5d074aa9
FF
1386 As a GNU chill extension, the syntax C'xx' is also recognized as a
1387 character literal, where xx is a hex value for the character.
1388
c7da3ed3
FF
1389 Note that more than a single character, enclosed in single quotes, is
1390 a string literal.
1391
c4413e2c
FF
1392 Also note that the control sequence form is not in GNU Chill since it
1393 is ambiguous with the string literal form using single quotes. I.E.
1394 is '^(7)' a character literal or a string literal. In theory it it
1395 possible to tell by context, but GNU Chill doesn't accept the control
1396 sequence form, so neither do we (for now the code is disabled).
1397
2e66cf7d
FF
1398 Returns CHARACTER_LITERAL if a match is found.
1399 */
1400
1401static int
1402match_character_literal ()
1403{
1404 char *tokptr = lexptr;
1405 int ival = 0;
1406
db2302cb 1407 if ((*tokptr == 'c' || *tokptr == 'C') && (*(tokptr + 1) == '\''))
2e66cf7d 1408 {
5d074aa9
FF
1409 /* We have a GNU chill extension form, so skip the leading "C'",
1410 decode the hex value, and then ensure that we have a trailing
1411 single quote character. */
2e66cf7d 1412 tokptr += 2;
5d074aa9 1413 if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
e58de8a2 1414 {
2e66cf7d 1415 return (0);
e58de8a2 1416 }
5d074aa9 1417 tokptr++;
2e66cf7d 1418 }
5d074aa9 1419 else if (*tokptr == '\'')
2e66cf7d 1420 {
5d074aa9 1421 tokptr++;
2e66cf7d 1422
5d074aa9
FF
1423 /* Determine which form we have, either a control sequence or the
1424 single character form. */
1425
1426 if ((*tokptr == '^') && (*(tokptr + 1) == '('))
1427 {
9da75ad3 1428#if 0 /* Disable, see note above. -fnf */
5d074aa9
FF
1429 /* Match and decode a control sequence. Return zero if we don't
1430 find a valid integer literal, or if the next unconsumed character
1431 after the integer literal is not the trailing ')'.
1432 FIXME: We currently don't handle the multiple integer literal
1433 form. */
1434 tokptr += 2;
1435 if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
1436 {
1437 return (0);
1438 }
9da75ad3
FF
1439#else
1440 return (0);
1441#endif
5d074aa9
FF
1442 }
1443 else
1444 {
1445 ival = *tokptr++;
1446 }
1447
1448 /* The trailing quote has not yet been consumed. If we don't find
1449 it, then we have no match. */
1450
1451 if (*tokptr++ != '\'')
1452 {
1453 return (0);
1454 }
2e66cf7d 1455 }
aed656ba
FF
1456 else
1457 {
1458 /* Not a character literal. */
1459 return (0);
1460 }
2e66cf7d
FF
1461 yylval.typed_val.val = ival;
1462 yylval.typed_val.type = builtin_type_chill_char;
1463 lexptr = tokptr;
1464 return (CHARACTER_LITERAL);
e58de8a2
FF
1465}
1466
1467/* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1468 Note that according to 5.2.4.2, a single "_" is also a valid integer
1469 literal, however GNU-chill requires there to be at least one "digit"
1470 in any integer literal. */
1471
1472static int
2e66cf7d 1473match_integer_literal ()
e58de8a2 1474{
2e66cf7d 1475 char *tokptr = lexptr;
ae0afa4b 1476 int ival;
2e66cf7d 1477
ae0afa4b 1478 if (!decode_integer_literal (&ival, &tokptr))
2e66cf7d
FF
1479 {
1480 return (0);
1481 }
ae0afa4b 1482 else
2e66cf7d
FF
1483 {
1484 yylval.typed_val.val = ival;
1485 yylval.typed_val.type = builtin_type_int;
1486 lexptr = tokptr;
1487 return (INTEGER_LITERAL);
1488 }
e58de8a2
FF
1489}
1490
81028ab0
FF
1491/* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
1492 Note that according to 5.2.4.8, a single "_" is also a valid bit-string
1493 literal, however GNU-chill requires there to be at least one "digit"
1494 in any bit-string literal. */
1495
1496static int
1497match_bitstring_literal ()
1498{
1499 char *tokptr = lexptr;
1500 int mask;
1501 int bitoffset = 0;
1502 int bitcount = 0;
1503 int base;
1504 int digit;
81028ab0 1505
c7da3ed3
FF
1506 tempbufindex = 0;
1507
81028ab0
FF
1508 /* Look for the required explicit base specifier. */
1509
1510 switch (*tokptr++)
1511 {
1512 case 'b':
1513 case 'B':
1514 base = 2;
1515 break;
1516 case 'o':
1517 case 'O':
1518 base = 8;
1519 break;
1520 case 'h':
1521 case 'H':
1522 base = 16;
1523 break;
1524 default:
1525 return (0);
1526 break;
1527 }
1528
1529 /* Ensure that the character after the explicit base is a single quote. */
1530
1531 if (*tokptr++ != '\'')
1532 {
1533 return (0);
1534 }
1535
1536 while (*tokptr != '\0' && *tokptr != '\'')
1537 {
db2302cb
PS
1538 digit = *tokptr;
1539 if (isupper (digit))
1540 digit = tolower (digit);
81028ab0
FF
1541 tokptr++;
1542 switch (digit)
1543 {
1544 case '_':
1545 continue;
1546 case '0': case '1': case '2': case '3': case '4':
1547 case '5': case '6': case '7': case '8': case '9':
1548 digit -= '0';
1549 break;
1550 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1551 digit -= 'a';
1552 digit += 10;
1553 break;
1554 default:
1555 return (0);
1556 break;
1557 }
1558 if (digit >= base)
1559 {
1560 /* Found something not in domain for current base. */
1561 return (0);
1562 }
1563 else
1564 {
1565 /* Extract bits from digit, starting with the msbit appropriate for
1566 the current base, and packing them into the bitstring byte,
1567 starting at the lsbit. */
1568 for (mask = (base >> 1); mask > 0; mask >>= 1)
1569 {
1570 bitcount++;
c7da3ed3 1571 CHECKBUF (1);
81028ab0
FF
1572 if (digit & mask)
1573 {
1574 tempbuf[tempbufindex] |= (1 << bitoffset);
1575 }
1576 bitoffset++;
1577 if (bitoffset == HOST_CHAR_BIT)
1578 {
1579 bitoffset = 0;
1580 tempbufindex++;
1581 }
1582 }
1583 }
1584 }
1585
1586 /* Verify that we consumed everything up to the trailing single quote,
1587 and that we found some bits (IE not just underbars). */
1588
1589 if (*tokptr++ != '\'')
1590 {
1591 return (0);
1592 }
1593 else
1594 {
1595 yylval.sval.ptr = tempbuf;
1596 yylval.sval.length = bitcount;
1597 lexptr = tokptr;
1598 return (BIT_STRING_LITERAL);
1599 }
1600}
1601
45fe3db4
FF
1602/* Recognize tokens that start with '$'. These include:
1603
1604 $regname A native register name or a "standard
1605 register name".
1606 Return token GDB_REGNAME.
1607
1608 $variable A convenience variable with a name chosen
1609 by the user.
1610 Return token GDB_VARIABLE.
1611
1612 $digits Value history with index <digits>, starting
1613 from the first value which has index 1.
1614 Return GDB_LAST.
1615
1616 $$digits Value history with index <digits> relative
1617 to the last value. I.E. $$0 is the last
1618 value, $$1 is the one previous to that, $$2
1619 is the one previous to $$1, etc.
1620 Return token GDB_LAST.
1621
1622 $ | $0 | $$0 The last value in the value history.
1623 Return token GDB_LAST.
1624
1625 $$ An abbreviation for the second to the last
1626 value in the value history, I.E. $$1
1627 Return token GDB_LAST.
1628
1629 Note that we currently assume that register names and convenience
1630 variables follow the convention of starting with a letter or '_'.
1631
1632 */
1633
1634static int
1635match_dollar_tokens ()
1636{
1637 char *tokptr;
1638 int regno;
1639 int namelength;
1640 int negate;
1641 int ival;
1642
1643 /* We will always have a successful match, even if it is just for
1644 a single '$', the abbreviation for $$0. So advance lexptr. */
1645
1646 tokptr = ++lexptr;
1647
1648 if (*tokptr == '_' || isalpha (*tokptr))
1649 {
1650 /* Look for a match with a native register name, usually something
1651 like "r0" for example. */
1652
1653 for (regno = 0; regno < NUM_REGS; regno++)
1654 {
1655 namelength = strlen (reg_names[regno]);
1656 if (STREQN (tokptr, reg_names[regno], namelength)
1657 && !isalnum (tokptr[namelength]))
1658 {
1659 yylval.lval = regno;
cba00921 1660 lexptr += namelength;
45fe3db4
FF
1661 return (GDB_REGNAME);
1662 }
1663 }
1664
1665 /* Look for a match with a standard register name, usually something
1666 like "pc", which gdb always recognizes as the program counter
1667 regardless of what the native register name is. */
1668
1669 for (regno = 0; regno < num_std_regs; regno++)
1670 {
1671 namelength = strlen (std_regs[regno].name);
1672 if (STREQN (tokptr, std_regs[regno].name, namelength)
1673 && !isalnum (tokptr[namelength]))
1674 {
1675 yylval.lval = std_regs[regno].regnum;
1676 lexptr += namelength;
1677 return (GDB_REGNAME);
1678 }
1679 }
1680
1681 /* Attempt to match against a convenience variable. Note that
1682 this will always succeed, because if no variable of that name
1683 already exists, the lookup_internalvar will create one for us.
1684 Also note that both lexptr and tokptr currently point to the
1685 start of the input string we are trying to match, and that we
1686 have already tested the first character for non-numeric, so we
1687 don't have to treat it specially. */
1688
1689 while (*tokptr == '_' || isalnum (*tokptr))
1690 {
1691 tokptr++;
1692 }
1693 yylval.sval.ptr = lexptr;
1694 yylval.sval.length = tokptr - lexptr;
1695 yylval.ivar = lookup_internalvar (copy_name (yylval.sval));
1696 lexptr = tokptr;
1697 return (GDB_VARIABLE);
1698 }
1699
1700 /* Since we didn't match against a register name or convenience
1701 variable, our only choice left is a history value. */
1702
1703 if (*tokptr == '$')
1704 {
1705 negate = 1;
1706 ival = 1;
1707 tokptr++;
1708 }
1709 else
1710 {
1711 negate = 0;
1712 ival = 0;
1713 }
1714
1715 /* Attempt to decode more characters as an integer value giving
1716 the index in the history list. If successful, the value will
1717 overwrite ival (currently 0 or 1), and if not, ival will be
1718 left alone, which is good since it is currently correct for
1719 the '$' or '$$' case. */
1720
1721 decode_integer_literal (&ival, &tokptr);
1722 yylval.lval = negate ? -ival : ival;
1723 lexptr = tokptr;
1724 return (GDB_LAST);
1725}
1726
e58de8a2
FF
1727struct token
1728{
1729 char *operator;
1730 int token;
1731};
1732
5a7c9cce 1733static const struct token idtokentab[] =
81028ab0 1734{
5a7c9cce
PB
1735 { "length", LENGTH },
1736 { "lower", LOWER },
1737 { "upper", UPPER },
1738 { "andif", ANDIF },
1739 { "pred", PRED },
1740 { "succ", SUCC },
1741 { "card", CARD },
1742 { "size", SIZE },
1743 { "orif", ORIF },
1744 { "num", NUM },
1745 { "abs", ABS },
57ffffe3
JG
1746 { "max", MAX_TOKEN },
1747 { "min", MIN_TOKEN },
5a7c9cce
PB
1748 { "mod", MOD },
1749 { "rem", REM },
1750 { "not", NOT },
1751 { "xor", LOGXOR },
1752 { "and", LOGAND },
1753 { "in", IN },
1754 { "or", LOGIOR }
e58de8a2
FF
1755};
1756
a8a69e63 1757static const struct token tokentab2[] =
e58de8a2 1758{
45fe3db4 1759 { ":=", GDB_ASSIGNMENT },
e58de8a2 1760 { "//", SLASH_SLASH },
8a177da6 1761 { "->", POINTER },
e58de8a2
FF
1762 { "/=", NOTEQUAL },
1763 { "<=", LEQ },
5a7c9cce 1764 { ">=", GTR }
e58de8a2
FF
1765};
1766
1767/* Read one token, getting characters through lexptr. */
1768/* This is where we will check to make sure that the language and the
1769 operators used are compatible. */
1770
1771static int
1772yylex ()
1773{
1774 unsigned int i;
1775 int token;
ad86f717 1776 char *inputname;
cbd1bdc3 1777 struct symbol *sym;
e58de8a2
FF
1778
1779 /* Skip over any leading whitespace. */
1780 while (isspace (*lexptr))
1781 {
1782 lexptr++;
1783 }
1784 /* Look for special single character cases which can't be the first
1785 character of some other multicharacter token. */
1786 switch (*lexptr)
1787 {
1788 case '\0':
1789 return (0);
54bbbfb4 1790 case ',':
e58de8a2 1791 case '=':
e58de8a2
FF
1792 case ';':
1793 case '!':
1794 case '+':
e58de8a2 1795 case '*':
e58de8a2
FF
1796 case '(':
1797 case ')':
1798 case '[':
1799 case ']':
1800 return (*lexptr++);
1801 }
1802 /* Look for characters which start a particular kind of multicharacter
45fe3db4 1803 token, such as a character literal, register name, convenience
c7da3ed3 1804 variable name, string literal, etc. */
e58de8a2 1805 switch (*lexptr)
2e66cf7d 1806 {
c7da3ed3
FF
1807 case '\'':
1808 case '\"':
96b6b765 1809 /* First try to match a string literal, which is any
c7da3ed3
FF
1810 sequence of characters enclosed in matching single or double
1811 quotes, except that a single character inside single quotes
1812 is a character literal, so we have to catch that case also. */
1813 token = match_string_literal ();
1814 if (token != 0)
1815 {
1816 return (token);
1817 }
1818 if (*lexptr == '\'')
1819 {
1820 token = match_character_literal ();
1821 if (token != 0)
1822 {
1823 return (token);
1824 }
1825 }
1826 break;
5d074aa9
FF
1827 case 'C':
1828 case 'c':
2e66cf7d
FF
1829 token = match_character_literal ();
1830 if (token != 0)
1831 {
1832 return (token);
1833 }
1834 break;
45fe3db4
FF
1835 case '$':
1836 token = match_dollar_tokens ();
1837 if (token != 0)
1838 {
1839 return (token);
1840 }
1841 break;
2e66cf7d 1842 }
e58de8a2
FF
1843 /* See if it is a special token of length 2. */
1844 for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1845 {
45fe3db4 1846 if (STREQN (lexptr, tokentab2[i].operator, 2))
e58de8a2
FF
1847 {
1848 lexptr += 2;
1849 return (tokentab2[i].token);
1850 }
1851 }
1852 /* Look for single character cases which which could be the first
1853 character of some other multicharacter token, but aren't, or we
1854 would already have found it. */
1855 switch (*lexptr)
1856 {
8a177da6 1857 case '-':
45fe3db4 1858 case ':':
e58de8a2
FF
1859 case '/':
1860 case '<':
1861 case '>':
1862 return (*lexptr++);
1863 }
1188fbbf
FF
1864 /* Look for a float literal before looking for an integer literal, so
1865 we match as much of the input stream as possible. */
1866 token = match_float_literal ();
81028ab0
FF
1867 if (token != 0)
1868 {
1869 return (token);
1870 }
1871 token = match_bitstring_literal ();
1188fbbf
FF
1872 if (token != 0)
1873 {
1874 return (token);
1875 }
2e66cf7d 1876 token = match_integer_literal ();
cbd1bdc3 1877 if (token != 0)
e58de8a2
FF
1878 {
1879 return (token);
1880 }
cbd1bdc3
FF
1881
1882 /* Try to match a simple name string, and if a match is found, then
1883 further classify what sort of name it is and return an appropriate
1884 token. Note that attempting to match a simple name string consumes
1885 the token from lexptr, so we can't back out if we later find that
1886 we can't classify what sort of name it is. */
1887
ad86f717 1888 inputname = match_simple_name_string ();
5a7c9cce 1889
ad86f717 1890 if (inputname != NULL)
cbd1bdc3 1891 {
ad86f717
PB
1892 char *simplename = (char*) alloca (strlen (inputname));
1893
1894 char *dptr = simplename, *sptr = inputname;
1895 for (; *sptr; sptr++)
1896 *dptr++ = isupper (*sptr) ? tolower(*sptr) : *sptr;
1897
d8f23320
PS
1898 /* See if it is a reserved identifier. */
1899 for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
1900 {
1901 if (STREQ (simplename, idtokentab[i].operator))
1902 {
1903 return (idtokentab[i].token);
1904 }
1905 }
1906
1907 /* Look for other special tokens. */
1908 if (STREQ (simplename, "true"))
1909 {
1910 yylval.ulval = 1;
1911 return (BOOLEAN_LITERAL);
1912 }
1913 if (STREQ (simplename, "false"))
1914 {
1915 yylval.ulval = 0;
1916 return (BOOLEAN_LITERAL);
1917 }
1918
ad86f717 1919 sym = lookup_symbol (inputname, expression_context_block,
cbd1bdc3
FF
1920 VAR_NAMESPACE, (int *) NULL,
1921 (struct symtab **) NULL);
ad86f717
PB
1922 if (sym == NULL && strcmp (inputname, simplename) != 0)
1923 {
1924 sym = lookup_symbol (simplename, expression_context_block,
1925 VAR_NAMESPACE, (int *) NULL,
1926 (struct symtab **) NULL);
1927 }
cbd1bdc3
FF
1928 if (sym != NULL)
1929 {
1930 yylval.ssym.stoken.ptr = NULL;
1931 yylval.ssym.stoken.length = 0;
1932 yylval.ssym.sym = sym;
1933 yylval.ssym.is_a_field_of_this = 0; /* FIXME, C++'ism */
1934 switch (SYMBOL_CLASS (sym))
1935 {
1936 case LOC_BLOCK:
1937 /* Found a procedure name. */
1938 return (GENERAL_PROCEDURE_NAME);
1939 case LOC_STATIC:
1940 /* Found a global or local static variable. */
1941 return (LOCATION_NAME);
a8a69e63
FF
1942 case LOC_REGISTER:
1943 case LOC_ARG:
1944 case LOC_REF_ARG:
1945 case LOC_REGPARM:
996ccb30 1946 case LOC_REGPARM_ADDR:
a8a69e63 1947 case LOC_LOCAL:
76a0ffb4 1948 case LOC_LOCAL_ARG:
a1c8d76e
JK
1949 case LOC_BASEREG:
1950 case LOC_BASEREG_ARG:
76a0ffb4
FF
1951 if (innermost_block == NULL
1952 || contained_in (block_found, innermost_block))
1953 {
1954 innermost_block = block_found;
1955 }
1956 return (LOCATION_NAME);
1957 break;
1958 case LOC_CONST:
a8a69e63 1959 case LOC_LABEL:
76a0ffb4
FF
1960 return (LOCATION_NAME);
1961 break;
76a0ffb4 1962 case LOC_TYPEDEF:
8a177da6
PB
1963 yylval.tsym.type = SYMBOL_TYPE (sym);
1964 return TYPENAME;
1965 case LOC_UNDEF:
a8a69e63 1966 case LOC_CONST_BYTES:
0848ad1c 1967 case LOC_OPTIMIZED_OUT:
ad86f717 1968 error ("Symbol \"%s\" names no location.", inputname);
a8a69e63 1969 break;
cbd1bdc3
FF
1970 }
1971 }
1972 else if (!have_full_symbols () && !have_partial_symbols ())
1973 {
1974 error ("No symbol table is loaded. Use the \"file\" command.");
1975 }
1976 else
1977 {
ad86f717 1978 error ("No symbol \"%s\" in current context.", inputname);
cbd1bdc3
FF
1979 }
1980 }
1981
1188fbbf
FF
1982 /* Catch single character tokens which are not part of some
1983 longer token. */
1984
1985 switch (*lexptr)
1986 {
1987 case '.': /* Not float for example. */
8a177da6
PB
1988 lexptr++;
1989 while (isspace (*lexptr)) lexptr++;
ad86f717
PB
1990 inputname = match_simple_name_string ();
1991 if (!inputname)
8a177da6
PB
1992 return '.';
1993 return FIELD_NAME;
1188fbbf
FF
1994 }
1995
e58de8a2
FF
1996 return (ILLEGAL_TOKEN);
1997}
1998
22e39759 1999void
e58de8a2 2000yyerror (msg)
8db1a922 2001 char *msg;
e58de8a2 2002{
8db1a922 2003 error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
e58de8a2 2004}
This page took 0.188059 seconds and 4 git commands to generate.