gdb/ch-exp.y

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