gdb/ch-exp.y

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