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