gdb/ch-exp.c

   1 /* Parser for GNU CHILL (CCITT High-Level Language)  -*- C -*-
   2    Copyright 1992, 1993, 1995, 1996, 1997, 1999, 2000, 2001
   3    Free Software Foundation, Inc.
   4
   5    This file is part of GDB.
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 2 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program; if not, write to the Free Software
  19    Foundation, Inc., 59 Temple Place - Suite 330,
  20    Boston, MA 02111-1307, USA.  */
  21
  22 /* Parse a Chill expression from text in a string,
  23    and return the result as a  struct expression  pointer.
  24    That structure contains arithmetic operations in reverse polish,
  25    with constants represented by operations that are followed by special data.
  26    See expression.h for the details of the format.
  27    What is important here is that it can be built up sequentially
  28    during the process of parsing; the lower levels of the tree always
  29    come first in the result.
  30
  31    Note that the language accepted by this parser is more liberal
  32    than the one accepted by an actual Chill compiler.  For example, the
  33    language rule that a simple name string can not be one of the reserved
  34    simple name strings is not enforced (e.g "case" is not treated as a
  35    reserved name).  Another example is that Chill is a strongly typed
  36    language, and certain expressions that violate the type constraints
  37    may still be evaluated if gdb can do so in a meaningful manner, while
  38    such expressions would be rejected by the compiler.  The reason for
  39    this more liberal behavior is the philosophy that the debugger
  40    is intended to be a tool that is used by the programmer when things
  41    go wrong, and as such, it should provide as few artificial barriers
  42    to it's use as possible.  If it can do something meaningful, even
  43    something that violates language contraints that are enforced by the
  44    compiler, it should do so without complaint.
  45
  46  */
  47
  48 #include "defs.h"
  49 #include "gdb_string.h"
  50 #include <ctype.h>
  51 #include "expression.h"
  52 #include "language.h"
  53 #include "value.h"
  54 #include "parser-defs.h"
  55 #include "ch-lang.h"
  56 #include "bfd.h"                /* Required by objfiles.h.  */
  57 #include "symfile.h"            /* Required by objfiles.h.  */
  58 #include "objfiles.h"           /* For have_full_symbols and have_partial_symbols */
  59
  60 #ifdef __GNUC__
  61 #define INLINE __inline__
  62 #endif
  63
  64 typedef union
  65
  66   {
  67     LONGEST lval;
  68     ULONGEST ulval;
  69     struct
  70       {
  71         LONGEST val;
  72         struct type *type;
  73       }
  74     typed_val;
  75     double dval;
  76     struct symbol *sym;
  77     struct type *tval;
  78     struct stoken sval;
  79     struct ttype tsym;
  80     struct symtoken ssym;
  81   }
  82 YYSTYPE;
  83
  84 enum ch_terminal
  85   {
  86     END_TOKEN = 0,
  87     /* '\001' ... '\xff' come first. */
  88     OPEN_PAREN = '(',
  89     TOKEN_NOT_READ = 999,
  90     INTEGER_LITERAL,
  91     BOOLEAN_LITERAL,
  92     CHARACTER_LITERAL,
  93     FLOAT_LITERAL,
  94     GENERAL_PROCEDURE_NAME,
  95     LOCATION_NAME,
  96     EMPTINESS_LITERAL,
  97     CHARACTER_STRING_LITERAL,
  98     BIT_STRING_LITERAL,
  99     TYPENAME,
 100     DOT_FIELD_NAME,             /* '.' followed by <field name> */
 101     CASE,
 102     OF,
 103     ESAC,
 104     LOGIOR,
 105     ORIF,
 106     LOGXOR,
 107     LOGAND,
 108     ANDIF,
 109     NOTEQUAL,
 110     GEQ,
 111     LEQ,
 112     IN,
 113     SLASH_SLASH,
 114     MOD,
 115     REM,
 116     NOT,
 117     POINTER,
 118     RECEIVE,
 119     UP,
 120     IF,
 121     THEN,
 122     ELSE,
 123     FI,
 124     ELSIF,
 125     ILLEGAL_TOKEN,
 126     NUM,
 127     PRED,
 128     SUCC,
 129     ABS,
 130     CARD,
 131     MAX_TOKEN,
 132     MIN_TOKEN,
 133     ADDR_TOKEN,
 134     SIZE,
 135     UPPER,
 136     LOWER,
 137     LENGTH,
 138     ARRAY,
 139     GDB_VARIABLE,
 140     GDB_ASSIGNMENT
 141   };
 142
 143 /* Forward declarations. */
 144
 145 static void write_lower_upper_value (enum exp_opcode, struct type *);
 146 static enum ch_terminal match_bitstring_literal (void);
 147 static enum ch_terminal match_integer_literal (void);
 148 static enum ch_terminal match_character_literal (void);
 149 static enum ch_terminal match_string_literal (void);
 150 static enum ch_terminal match_float_literal (void);
 151 static enum ch_terminal match_float_literal (void);
 152 static int decode_integer_literal (LONGEST *, char **);
 153 static int decode_integer_value (int, char **, LONGEST *);
 154 static char *match_simple_name_string (void);
 155 static void growbuf_by_size (int);
 156 static void parse_untyped_expr (void);
 157 static void parse_if_expression (void);
 158 static void parse_else_alternative (void);
 159 static void parse_then_alternative (void);
 160 static void parse_expr (void);
 161 static void parse_operand0 (void);
 162 static void parse_operand1 (void);
 163 static void parse_operand2 (void);
 164 static void parse_operand3 (void);
 165 static void parse_operand4 (void);
 166 static void parse_operand5 (void);
 167 static void parse_operand6 (void);
 168 static void parse_primval (void);
 169 static void parse_tuple (struct type *);
 170 static void parse_opt_element_list (struct type *);
 171 static void parse_tuple_element (struct type *);
 172 static void parse_named_record_element (void);
 173 static void parse_call (void);
 174 static struct type *parse_mode_or_normal_call (void);
 175 #if 0
 176 static struct type *parse_mode_call (void);
 177 #endif
 178 static void parse_unary_call (void);
 179 static int parse_opt_untyped_expr (void);
 180 static void parse_case_label (void);
 181 static int expect (enum ch_terminal, char *);
 182 static void parse_expr (void);
 183 static void parse_primval (void);
 184 static void parse_untyped_expr (void);
 185 static int parse_opt_untyped_expr (void);
 186 static void parse_if_expression_body (void);
 187 static enum ch_terminal ch_lex (void);
 188 INLINE static enum ch_terminal PEEK_TOKEN (void);
 189 static enum ch_terminal peek_token_ (int);
 190 static void forward_token_ (void);
 191 static void require (enum ch_terminal);
 192 static int check_token (enum ch_terminal);
 193
 194 #define MAX_LOOK_AHEAD 2
 195 static enum ch_terminal terminal_buffer[MAX_LOOK_AHEAD + 1] =
 196 {
 197   TOKEN_NOT_READ, TOKEN_NOT_READ, TOKEN_NOT_READ};
 198 static YYSTYPE yylval;
 199 static YYSTYPE val_buffer[MAX_LOOK_AHEAD + 1];
 200
 201 /*int current_token, lookahead_token; */
 202
 203 INLINE static enum ch_terminal
 204 PEEK_TOKEN (void)
 205 {
 206   if (terminal_buffer[0] == TOKEN_NOT_READ)
 207     {
 208       terminal_buffer[0] = ch_lex ();
 209       val_buffer[0] = yylval;
 210     }
 211   return terminal_buffer[0];
 212 }
 213 #define PEEK_LVAL() val_buffer[0]
 214 #define PEEK_TOKEN1() peek_token_(1)
 215 #define PEEK_TOKEN2() peek_token_(2)
 216 static enum ch_terminal
 217 peek_token_ (int i)
 218 {
 219   if (i > MAX_LOOK_AHEAD)
 220     internal_error (__FILE__, __LINE__,
 221                     "too much lookahead");
 222   if (terminal_buffer[i] == TOKEN_NOT_READ)
 223     {
 224       terminal_buffer[i] = ch_lex ();
 225       val_buffer[i] = yylval;
 226     }
 227   return terminal_buffer[i];
 228 }
 229
 230 #if 0
 231
 232 static void
 233 pushback_token (enum ch_terminal code, YYSTYPE node)
 234 {
 235   int i;
 236   if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ)
 237     internal_error (__FILE__, __LINE__,
 238                     "cannot pushback token");
 239   for (i = MAX_LOOK_AHEAD; i > 0; i--)
 240     {
 241       terminal_buffer[i] = terminal_buffer[i - 1];
 242       val_buffer[i] = val_buffer[i - 1];
 243     }
 244   terminal_buffer[0] = code;
 245   val_buffer[0] = node;
 246 }
 247
 248 #endif
 249
 250 static void
 251 forward_token_ (void)
 252 {
 253   int i;
 254   for (i = 0; i < MAX_LOOK_AHEAD; i++)
 255     {
 256       terminal_buffer[i] = terminal_buffer[i + 1];
 257       val_buffer[i] = val_buffer[i + 1];
 258     }
 259   terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ;
 260 }
 261 #define FORWARD_TOKEN() forward_token_()
 262
 263 /* Skip the next token.
 264    if it isn't TOKEN, the parser is broken. */
 265
 266 static void
 267 require (enum ch_terminal token)
 268 {
 269   if (PEEK_TOKEN () != token)
 270     {
 271       internal_error (__FILE__, __LINE__,
 272                       "expected token %d", (int) token);
 273     }
 274   FORWARD_TOKEN ();
 275 }
 276
 277 static int
 278 check_token (enum ch_terminal token)
 279 {
 280   if (PEEK_TOKEN () != token)
 281     return 0;
 282   FORWARD_TOKEN ();
 283   return 1;
 284 }
 285
 286 /* return 0 if expected token was not found,
 287    else return 1.
 288  */
 289 static int
 290 expect (enum ch_terminal token, char *message)
 291 {
 292   if (PEEK_TOKEN () != token)
 293     {
 294       if (message)
 295         error (message);
 296       else if (token < 256)
 297         error ("syntax error - expected a '%c' here \"%s\"", token, lexptr);
 298       else
 299         error ("syntax error");
 300       return 0;
 301     }
 302   else
 303     FORWARD_TOKEN ();
 304   return 1;
 305 }
 306
 307 #if 0
 308 /* Parse a name string.  If ALLOW_ALL is 1, ALL is allowed as a postfix. */
 309
 310 static tree
 311 parse_opt_name_string (int allow_all)
 312 {
 313   int token = PEEK_TOKEN ();
 314   tree name;
 315   if (token != NAME)
 316     {
 317       if (token == ALL && allow_all)
 318         {
 319           FORWARD_TOKEN ();
 320           return ALL_POSTFIX;
 321         }
 322       return NULL_TREE;
 323     }
 324   name = PEEK_LVAL ();
 325   for (;;)
 326     {
 327       FORWARD_TOKEN ();
 328       token = PEEK_TOKEN ();
 329       if (token != '!')
 330         return name;
 331       FORWARD_TOKEN ();
 332       token = PEEK_TOKEN ();
 333       if (token == ALL && allow_all)
 334         return get_identifier3 (IDENTIFIER_POINTER (name), "!", "*");
 335       if (token != NAME)
 336         {
 337           if (pass == 1)
 338             error ("'%s!' is not followed by an identifier",
 339                    IDENTIFIER_POINTER (name));
 340           return name;
 341         }
 342       name = get_identifier3 (IDENTIFIER_POINTER (name),
 343                               "!", IDENTIFIER_POINTER (PEEK_LVAL ()));
 344     }
 345 }
 346
 347 static tree
 348 parse_simple_name_string (void)
 349 {
 350   int token = PEEK_TOKEN ();
 351   tree name;
 352   if (token != NAME)
 353     {
 354       error ("expected a name here");
 355       return error_mark_node;
 356     }
 357   name = PEEK_LVAL ();
 358   FORWARD_TOKEN ();
 359   return name;
 360 }
 361
 362 static tree
 363 parse_name_string (void)
 364 {
 365   tree name = parse_opt_name_string (0);
 366   if (name)
 367     return name;
 368   if (pass == 1)
 369     error ("expected a name string here");
 370   return error_mark_node;
 371 }
 372
 373 /* Matches: <name_string>
 374    Returns if pass 1: the identifier.
 375    Returns if pass 2: a decl or value for identifier. */
 376
 377 static tree
 378 parse_name (void)
 379 {
 380   tree name = parse_name_string ();
 381   if (pass == 1 || ignoring)
 382     return name;
 383   else
 384     {
 385       tree decl = lookup_name (name);
 386       if (decl == NULL_TREE)
 387         {
 388           error ("`%s' undeclared", IDENTIFIER_POINTER (name));
 389           return error_mark_node;
 390         }
 391       else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK)
 392         return error_mark_node;
 393       else if (TREE_CODE (decl) == CONST_DECL)
 394         return DECL_INITIAL (decl);
 395       else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE)
 396         return convert_from_reference (decl);
 397       else
 398         return decl;
 399     }
 400 }
 401 #endif
 402
 403 #if 0
 404 static void
 405 pushback_paren_expr (tree expr)
 406 {
 407   if (pass == 1 && !ignoring)
 408     expr = build1 (PAREN_EXPR, NULL_TREE, expr);
 409   pushback_token (EXPR, expr);
 410 }
 411 #endif
 412
 413 /* Matches: <case label> */
 414
 415 static void
 416 parse_case_label (void)
 417 {
 418   if (check_token (ELSE))
 419     error ("ELSE in tuples labels not implemented");
 420   /* Does not handle the case of a mode name.  FIXME */
 421   parse_expr ();
 422   if (check_token (':'))
 423     {
 424       parse_expr ();
 425       write_exp_elt_opcode (BINOP_RANGE);
 426     }
 427 }
 428
 429 static int
 430 parse_opt_untyped_expr (void)
 431 {
 432   switch (PEEK_TOKEN ())
 433     {
 434     case ',':
 435     case ':':
 436     case ')':
 437       return 0;
 438     default:
 439       parse_untyped_expr ();
 440       return 1;
 441     }
 442 }
 443
 444 static void
 445 parse_unary_call (void)
 446 {
 447   FORWARD_TOKEN ();
 448   expect ('(', NULL);
 449   parse_expr ();
 450   expect (')', NULL);
 451 }
 452
 453 /* Parse NAME '(' MODENAME ')'. */
 454
 455 #if 0
 456
 457 static struct type *
 458 parse_mode_call (void)
 459 {
 460   struct type *type;
 461   FORWARD_TOKEN ();
 462   expect ('(', NULL);
 463   if (PEEK_TOKEN () != TYPENAME)
 464     error ("expect MODENAME here `%s'", lexptr);
 465   type = PEEK_LVAL ().tsym.type;
 466   FORWARD_TOKEN ();
 467   expect (')', NULL);
 468   return type;
 469 }
 470
 471 #endif
 472
 473 static struct type *
 474 parse_mode_or_normal_call (void)
 475 {
 476   struct type *type;
 477   FORWARD_TOKEN ();
 478   expect ('(', NULL);
 479   if (PEEK_TOKEN () == TYPENAME)
 480     {
 481       type = PEEK_LVAL ().tsym.type;
 482       FORWARD_TOKEN ();
 483     }
 484   else
 485     {
 486       parse_expr ();
 487       type = NULL;
 488     }
 489   expect (')', NULL);
 490   return type;
 491 }
 492
 493 /* Parse something that looks like a function call.
 494    Assume we have parsed the function, and are at the '('. */
 495
 496 static void
 497 parse_call (void)
 498 {
 499   int arg_count;
 500   require ('(');
 501   /* This is to save the value of arglist_len
 502      being accumulated for each dimension. */
 503   start_arglist ();
 504   if (parse_opt_untyped_expr ())
 505     {
 506       int tok = PEEK_TOKEN ();
 507       arglist_len = 1;
 508       if (tok == UP || tok == ':')
 509         {
 510           FORWARD_TOKEN ();
 511           parse_expr ();
 512           expect (')', "expected ')' to terminate slice");
 513           end_arglist ();
 514           write_exp_elt_opcode (tok == UP ? TERNOP_SLICE_COUNT
 515                                 : TERNOP_SLICE);
 516           return;
 517         }
 518       while (check_token (','))
 519         {
 520           parse_untyped_expr ();
 521           arglist_len++;
 522         }
 523     }
 524   else
 525     arglist_len = 0;
 526   expect (')', NULL);
 527   arg_count = end_arglist ();
 528   write_exp_elt_opcode (MULTI_SUBSCRIPT);
 529   write_exp_elt_longcst (arg_count);
 530   write_exp_elt_opcode (MULTI_SUBSCRIPT);
 531 }
 532
 533 static void
 534 parse_named_record_element (void)
 535 {
 536   struct stoken label;
 537   char buf[256];
 538
 539   label = PEEK_LVAL ().sval;
 540   sprintf (buf, "expected a field name here `%s'", lexptr);
 541   expect (DOT_FIELD_NAME, buf);
 542   if (check_token (','))
 543     parse_named_record_element ();
 544   else if (check_token (':'))
 545     parse_expr ();
 546   else
 547     error ("syntax error near `%s' in named record tuple element", lexptr);
 548   write_exp_elt_opcode (OP_LABELED);
 549   write_exp_string (label);
 550   write_exp_elt_opcode (OP_LABELED);
 551 }
 552
 553 /* Returns one or more TREE_LIST nodes, in reverse order. */
 554
 555 static void
 556 parse_tuple_element (struct type *type)
 557 {
 558   if (PEEK_TOKEN () == DOT_FIELD_NAME)
 559     {
 560       /* Parse a labelled structure tuple. */
 561       parse_named_record_element ();
 562       return;
 563     }
 564
 565   if (check_token ('('))
 566     {
 567       if (check_token ('*'))
 568         {
 569           expect (')', "missing ')' after '*' case label list");
 570           if (type)
 571             {
 572               if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
 573                 {
 574                   /* do this as a range from low to high */
 575                   struct type *range_type = TYPE_FIELD_TYPE (type, 0);
 576                   LONGEST low_bound, high_bound;
 577                   if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
 578                     error ("cannot determine bounds for (*)");
 579                   /* lower bound */
 580                   write_exp_elt_opcode (OP_LONG);
 581                   write_exp_elt_type (range_type);
 582                   write_exp_elt_longcst (low_bound);
 583                   write_exp_elt_opcode (OP_LONG);
 584                   /* upper bound */
 585                   write_exp_elt_opcode (OP_LONG);
 586                   write_exp_elt_type (range_type);
 587                   write_exp_elt_longcst (high_bound);
 588                   write_exp_elt_opcode (OP_LONG);
 589                   write_exp_elt_opcode (BINOP_RANGE);
 590                 }
 591               else
 592                 error ("(*) in invalid context");
 593             }
 594           else
 595             error ("(*) only possible with modename in front of tuple (mode[..])");
 596         }
 597       else
 598         {
 599           parse_case_label ();
 600           while (check_token (','))
 601             {
 602               parse_case_label ();
 603               write_exp_elt_opcode (BINOP_COMMA);
 604             }
 605           expect (')', NULL);
 606         }
 607     }
 608   else
 609     parse_untyped_expr ();
 610   if (check_token (':'))
 611     {
 612       /* A powerset range or a labeled Array. */
 613       parse_untyped_expr ();
 614       write_exp_elt_opcode (BINOP_RANGE);
 615     }
 616 }
 617
 618 /* Matches:  a COMMA-separated list of tuple elements.
 619    Returns a list (of TREE_LIST nodes). */
 620 static void
 621 parse_opt_element_list (struct type *type)
 622 {
 623   arglist_len = 0;
 624   if (PEEK_TOKEN () == ']')
 625     return;
 626   for (;;)
 627     {
 628       parse_tuple_element (type);
 629       arglist_len++;
 630       if (PEEK_TOKEN () == ']')
 631         break;
 632       if (!check_token (','))
 633         error ("bad syntax in tuple");
 634     }
 635 }
 636
 637 /* Parses: '[' elements ']'
 638    If modename is non-NULL it prefixed the tuple.  */
 639
 640 static void
 641 parse_tuple (struct type *mode)
 642 {
 643   struct type *type;
 644   if (mode)
 645     type = check_typedef (mode);
 646   else
 647     type = 0;
 648   require ('[');
 649   start_arglist ();
 650   parse_opt_element_list (type);
 651   expect (']', "missing ']' after tuple");
 652   write_exp_elt_opcode (OP_ARRAY);
 653   write_exp_elt_longcst ((LONGEST) 0);
 654   write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
 655   write_exp_elt_opcode (OP_ARRAY);
 656   if (type)
 657     {
 658       if (TYPE_CODE (type) != TYPE_CODE_ARRAY
 659           && TYPE_CODE (type) != TYPE_CODE_STRUCT
 660           && TYPE_CODE (type) != TYPE_CODE_SET)
 661         error ("invalid tuple mode");
 662       write_exp_elt_opcode (UNOP_CAST);
 663       write_exp_elt_type (mode);
 664       write_exp_elt_opcode (UNOP_CAST);
 665     }
 666 }
 667
 668 static void
 669 parse_primval (void)
 670 {
 671   struct type *type;
 672   enum exp_opcode op;
 673   char *op_name;
 674   switch (PEEK_TOKEN ())
 675     {
 676     case INTEGER_LITERAL:
 677     case CHARACTER_LITERAL:
 678       write_exp_elt_opcode (OP_LONG);
 679       write_exp_elt_type (PEEK_LVAL ().typed_val.type);
 680       write_exp_elt_longcst (PEEK_LVAL ().typed_val.val);
 681       write_exp_elt_opcode (OP_LONG);
 682       FORWARD_TOKEN ();
 683       break;
 684     case BOOLEAN_LITERAL:
 685       write_exp_elt_opcode (OP_BOOL);
 686       write_exp_elt_longcst ((LONGEST) PEEK_LVAL ().ulval);
 687       write_exp_elt_opcode (OP_BOOL);
 688       FORWARD_TOKEN ();
 689       break;
 690     case FLOAT_LITERAL:
 691       write_exp_elt_opcode (OP_DOUBLE);
 692       write_exp_elt_type (builtin_type_double);
 693       write_exp_elt_dblcst (PEEK_LVAL ().dval);
 694       write_exp_elt_opcode (OP_DOUBLE);
 695       FORWARD_TOKEN ();
 696       break;
 697     case EMPTINESS_LITERAL:
 698       write_exp_elt_opcode (OP_LONG);
 699       write_exp_elt_type (lookup_pointer_type (builtin_type_void));
 700       write_exp_elt_longcst (0);
 701       write_exp_elt_opcode (OP_LONG);
 702       FORWARD_TOKEN ();
 703       break;
 704     case CHARACTER_STRING_LITERAL:
 705       write_exp_elt_opcode (OP_STRING);
 706       write_exp_string (PEEK_LVAL ().sval);
 707       write_exp_elt_opcode (OP_STRING);
 708       FORWARD_TOKEN ();
 709       break;
 710     case BIT_STRING_LITERAL:
 711       write_exp_elt_opcode (OP_BITSTRING);
 712       write_exp_bitstring (PEEK_LVAL ().sval);
 713       write_exp_elt_opcode (OP_BITSTRING);
 714       FORWARD_TOKEN ();
 715       break;
 716     case ARRAY:
 717       FORWARD_TOKEN ();
 718       /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
 719          which casts to an artificial array. */
 720       expect ('(', NULL);
 721       expect (')', NULL);
 722       if (PEEK_TOKEN () != TYPENAME)
 723         error ("missing MODENAME after ARRAY()");
 724       type = PEEK_LVAL ().tsym.type;
 725       FORWARD_TOKEN ();
 726       expect ('(', NULL);
 727       parse_expr ();
 728       expect (')', "missing right parenthesis");
 729       type = create_array_type ((struct type *) NULL, type,
 730                                 create_range_type ((struct type *) NULL,
 731                                                    builtin_type_int, 0, 0));
 732       TYPE_ARRAY_UPPER_BOUND_TYPE (type) = BOUND_CANNOT_BE_DETERMINED;
 733       write_exp_elt_opcode (UNOP_CAST);
 734       write_exp_elt_type (type);
 735       write_exp_elt_opcode (UNOP_CAST);
 736       break;
 737 #if 0
 738     case CONST:
 739     case EXPR:
 740       val = PEEK_LVAL ();
 741       FORWARD_TOKEN ();
 742       break;
 743 #endif
 744     case '(':
 745       FORWARD_TOKEN ();
 746       parse_expr ();
 747       expect (')', "missing right parenthesis");
 748       break;
 749     case '[':
 750       parse_tuple (NULL);
 751       break;
 752     case GENERAL_PROCEDURE_NAME:
 753     case LOCATION_NAME:
 754       write_exp_elt_opcode (OP_VAR_VALUE);
 755       write_exp_elt_block (NULL);
 756       write_exp_elt_sym (PEEK_LVAL ().ssym.sym);
 757       write_exp_elt_opcode (OP_VAR_VALUE);
 758       FORWARD_TOKEN ();
 759       break;
 760     case GDB_VARIABLE:          /* gdb specific */
 761       FORWARD_TOKEN ();
 762       break;
 763     case NUM:
 764       parse_unary_call ();
 765       write_exp_elt_opcode (UNOP_CAST);
 766       write_exp_elt_type (builtin_type_int);
 767       write_exp_elt_opcode (UNOP_CAST);
 768       break;
 769     case CARD:
 770       parse_unary_call ();
 771       write_exp_elt_opcode (UNOP_CARD);
 772       break;
 773     case MAX_TOKEN:
 774       parse_unary_call ();
 775       write_exp_elt_opcode (UNOP_CHMAX);
 776       break;
 777     case MIN_TOKEN:
 778       parse_unary_call ();
 779       write_exp_elt_opcode (UNOP_CHMIN);
 780       break;
 781     case PRED:
 782       op_name = "PRED";
 783       goto unimplemented_unary_builtin;
 784     case SUCC:
 785       op_name = "SUCC";
 786       goto unimplemented_unary_builtin;
 787     case ABS:
 788       op_name = "ABS";
 789       goto unimplemented_unary_builtin;
 790     unimplemented_unary_builtin:
 791       parse_unary_call ();
 792       error ("not implemented:  %s builtin function", op_name);
 793       break;
 794     case ADDR_TOKEN:
 795       parse_unary_call ();
 796       write_exp_elt_opcode (UNOP_ADDR);
 797       break;
 798     case SIZE:
 799       type = parse_mode_or_normal_call ();
 800       if (type)
 801         {
 802           write_exp_elt_opcode (OP_LONG);
 803           write_exp_elt_type (builtin_type_int);
 804           CHECK_TYPEDEF (type);
 805           write_exp_elt_longcst ((LONGEST) TYPE_LENGTH (type));
 806           write_exp_elt_opcode (OP_LONG);
 807         }
 808       else
 809         write_exp_elt_opcode (UNOP_SIZEOF);
 810       break;
 811     case LOWER:
 812       op = UNOP_LOWER;
 813       goto lower_upper;
 814     case UPPER:
 815       op = UNOP_UPPER;
 816       goto lower_upper;
 817     lower_upper:
 818       type = parse_mode_or_normal_call ();
 819       write_lower_upper_value (op, type);
 820       break;
 821     case LENGTH:
 822       parse_unary_call ();
 823       write_exp_elt_opcode (UNOP_LENGTH);
 824       break;
 825     case TYPENAME:
 826       type = PEEK_LVAL ().tsym.type;
 827       FORWARD_TOKEN ();
 828       switch (PEEK_TOKEN ())
 829         {
 830         case '[':
 831           parse_tuple (type);
 832           break;
 833         case '(':
 834           FORWARD_TOKEN ();
 835           parse_expr ();
 836           expect (')', "missing right parenthesis");
 837           write_exp_elt_opcode (UNOP_CAST);
 838           write_exp_elt_type (type);
 839           write_exp_elt_opcode (UNOP_CAST);
 840           break;
 841         default:
 842           error ("typename in invalid context");
 843         }
 844       break;
 845
 846     default:
 847       error ("invalid expression syntax at `%s'", lexptr);
 848     }
 849   for (;;)
 850     {
 851       switch (PEEK_TOKEN ())
 852         {
 853         case DOT_FIELD_NAME:
 854           write_exp_elt_opcode (STRUCTOP_STRUCT);
 855           write_exp_string (PEEK_LVAL ().sval);
 856           write_exp_elt_opcode (STRUCTOP_STRUCT);
 857           FORWARD_TOKEN ();
 858           continue;
 859         case POINTER:
 860           FORWARD_TOKEN ();
 861           if (PEEK_TOKEN () == TYPENAME)
 862             {
 863               type = PEEK_LVAL ().tsym.type;
 864               write_exp_elt_opcode (UNOP_CAST);
 865               write_exp_elt_type (lookup_pointer_type (type));
 866               write_exp_elt_opcode (UNOP_CAST);
 867               FORWARD_TOKEN ();
 868             }
 869           write_exp_elt_opcode (UNOP_IND);
 870           continue;
 871         case OPEN_PAREN:
 872           parse_call ();
 873           continue;
 874         case CHARACTER_STRING_LITERAL:
 875         case CHARACTER_LITERAL:
 876         case BIT_STRING_LITERAL:
 877           /* Handle string repetition. (See comment in parse_operand5.) */
 878           parse_primval ();
 879           write_exp_elt_opcode (MULTI_SUBSCRIPT);
 880           write_exp_elt_longcst (1);
 881           write_exp_elt_opcode (MULTI_SUBSCRIPT);
 882           continue;
 883         case END_TOKEN:
 884         case TOKEN_NOT_READ:
 885         case INTEGER_LITERAL:
 886         case BOOLEAN_LITERAL:
 887         case FLOAT_LITERAL:
 888         case GENERAL_PROCEDURE_NAME:
 889         case LOCATION_NAME:
 890         case EMPTINESS_LITERAL:
 891         case TYPENAME:
 892         case CASE:
 893         case OF:
 894         case ESAC:
 895         case LOGIOR:
 896         case ORIF:
 897         case LOGXOR:
 898         case LOGAND:
 899         case ANDIF:
 900         case NOTEQUAL:
 901         case GEQ:
 902         case LEQ:
 903         case IN:
 904         case SLASH_SLASH:
 905         case MOD:
 906         case REM:
 907         case NOT:
 908         case RECEIVE:
 909         case UP:
 910         case IF:
 911         case THEN:
 912         case ELSE:
 913         case FI:
 914         case ELSIF:
 915         case ILLEGAL_TOKEN:
 916         case NUM:
 917         case PRED:
 918         case SUCC:
 919         case ABS:
 920         case CARD:
 921         case MAX_TOKEN:
 922         case MIN_TOKEN:
 923         case ADDR_TOKEN:
 924         case SIZE:
 925         case UPPER:
 926         case LOWER:
 927         case LENGTH:
 928         case ARRAY:
 929         case GDB_VARIABLE:
 930         case GDB_ASSIGNMENT:
 931           break;
 932         }
 933       break;
 934     }
 935   return;
 936 }
 937
 938 static void
 939 parse_operand6 (void)
 940 {
 941   if (check_token (RECEIVE))
 942     {
 943       parse_primval ();
 944       error ("not implemented:  RECEIVE expression");
 945     }
 946   else if (check_token (POINTER))
 947     {
 948       parse_primval ();
 949       write_exp_elt_opcode (UNOP_ADDR);
 950     }
 951   else
 952     parse_primval ();
 953 }
 954
 955 static void
 956 parse_operand5 (void)
 957 {
 958   enum exp_opcode op;
 959   /* We are supposed to be looking for a <string repetition operator>,
 960      but in general we can't distinguish that from a parenthesized
 961      expression.  This is especially difficult if we allow the
 962      string operand to be a constant expression (as requested by
 963      some users), and not just a string literal.
 964      Consider:  LPRN expr RPRN LPRN expr RPRN
 965      Is that a function call or string repetition?
 966      Instead, we handle string repetition in parse_primval,
 967      and build_generalized_call. */
 968   switch (PEEK_TOKEN ())
 969     {
 970     case NOT:
 971       op = UNOP_LOGICAL_NOT;
 972       break;
 973     case '-':
 974       op = UNOP_NEG;
 975       break;
 976     default:
 977       op = OP_NULL;
 978     }
 979   if (op != OP_NULL)
 980     FORWARD_TOKEN ();
 981   parse_operand6 ();
 982   if (op != OP_NULL)
 983     write_exp_elt_opcode (op);
 984 }
 985
 986 static void
 987 parse_operand4 (void)
 988 {
 989   enum exp_opcode op;
 990   parse_operand5 ();
 991   for (;;)
 992     {
 993       switch (PEEK_TOKEN ())
 994         {
 995         case '*':
 996           op = BINOP_MUL;
 997           break;
 998         case '/':
 999           op = BINOP_DIV;
1000           break;
1001         case MOD:
1002           op = BINOP_MOD;
1003           break;
1004         case REM:
1005           op = BINOP_REM;
1006           break;
1007         default:
1008           return;
1009         }
1010       FORWARD_TOKEN ();
1011       parse_operand5 ();
1012       write_exp_elt_opcode (op);
1013     }
1014 }
1015
1016 static void
1017 parse_operand3 (void)
1018 {
1019   enum exp_opcode op;
1020   parse_operand4 ();
1021   for (;;)
1022     {
1023       switch (PEEK_TOKEN ())
1024         {
1025         case '+':
1026           op = BINOP_ADD;
1027           break;
1028         case '-':
1029           op = BINOP_SUB;
1030           break;
1031         case SLASH_SLASH:
1032           op = BINOP_CONCAT;
1033           break;
1034         default:
1035           return;
1036         }
1037       FORWARD_TOKEN ();
1038       parse_operand4 ();
1039       write_exp_elt_opcode (op);
1040     }
1041 }
1042
1043 static void
1044 parse_operand2 (void)
1045 {
1046   enum exp_opcode op;
1047   parse_operand3 ();
1048   for (;;)
1049     {
1050       if (check_token (IN))
1051         {
1052           parse_operand3 ();
1053           write_exp_elt_opcode (BINOP_IN);
1054         }
1055       else
1056         {
1057           switch (PEEK_TOKEN ())
1058             {
1059             case '>':
1060               op = BINOP_GTR;
1061               break;
1062             case GEQ:
1063               op = BINOP_GEQ;
1064               break;
1065             case '<':
1066               op = BINOP_LESS;
1067               break;
1068             case LEQ:
1069               op = BINOP_LEQ;
1070               break;
1071             case '=':
1072               op = BINOP_EQUAL;
1073               break;
1074             case NOTEQUAL:
1075               op = BINOP_NOTEQUAL;
1076               break;
1077             default:
1078               return;
1079             }
1080           FORWARD_TOKEN ();
1081           parse_operand3 ();
1082           write_exp_elt_opcode (op);
1083         }
1084     }
1085 }
1086
1087 static void
1088 parse_operand1 (void)
1089 {
1090   enum exp_opcode op;
1091   parse_operand2 ();
1092   for (;;)
1093     {
1094       switch (PEEK_TOKEN ())
1095         {
1096         case LOGAND:
1097           op = BINOP_BITWISE_AND;
1098           break;
1099         case ANDIF:
1100           op = BINOP_LOGICAL_AND;
1101           break;
1102         default:
1103           return;
1104         }
1105       FORWARD_TOKEN ();
1106       parse_operand2 ();
1107       write_exp_elt_opcode (op);
1108     }
1109 }
1110
1111 static void
1112 parse_operand0 (void)
1113 {
1114   enum exp_opcode op;
1115   parse_operand1 ();
1116   for (;;)
1117     {
1118       switch (PEEK_TOKEN ())
1119         {
1120         case LOGIOR:
1121           op = BINOP_BITWISE_IOR;
1122           break;
1123         case LOGXOR:
1124           op = BINOP_BITWISE_XOR;
1125           break;
1126         case ORIF:
1127           op = BINOP_LOGICAL_OR;
1128           break;
1129         default:
1130           return;
1131         }
1132       FORWARD_TOKEN ();
1133       parse_operand1 ();
1134       write_exp_elt_opcode (op);
1135     }
1136 }
1137
1138 static void
1139 parse_expr (void)
1140 {
1141   parse_operand0 ();
1142   if (check_token (GDB_ASSIGNMENT))
1143     {
1144       parse_expr ();
1145       write_exp_elt_opcode (BINOP_ASSIGN);
1146     }
1147 }
1148
1149 static void
1150 parse_then_alternative (void)
1151 {
1152   expect (THEN, "missing 'THEN' in 'IF' expression");
1153   parse_expr ();
1154 }
1155
1156 static void
1157 parse_else_alternative (void)
1158 {
1159   if (check_token (ELSIF))
1160     parse_if_expression_body ();
1161   else if (check_token (ELSE))
1162     parse_expr ();
1163   else
1164     error ("missing ELSE/ELSIF in IF expression");
1165 }
1166
1167 /* Matches: <boolean expression> <then alternative> <else alternative> */
1168
1169 static void
1170 parse_if_expression_body (void)
1171 {
1172   parse_expr ();
1173   parse_then_alternative ();
1174   parse_else_alternative ();
1175   write_exp_elt_opcode (TERNOP_COND);
1176 }
1177
1178 static void
1179 parse_if_expression (void)
1180 {
1181   require (IF);
1182   parse_if_expression_body ();
1183   expect (FI, "missing 'FI' at end of conditional expression");
1184 }
1185
1186 /* An <untyped_expr> is a superset of <expr>.  It also includes
1187    <conditional expressions> and untyped <tuples>, whose types
1188    are not given by their constituents.  Hence, these are only
1189    allowed in certain contexts that expect a certain type.
1190    You should call convert() to fix up the <untyped_expr>. */
1191
1192 static void
1193 parse_untyped_expr (void)
1194 {
1195   switch (PEEK_TOKEN ())
1196     {
1197     case IF:
1198       parse_if_expression ();
1199       return;
1200     case CASE:
1201       error ("not implemented:  CASE expression");
1202     case '(':
1203       switch (PEEK_TOKEN1 ())
1204         {
1205         case IF:
1206         case CASE:
1207           goto skip_lprn;
1208         case '[':
1209         skip_lprn:
1210           FORWARD_TOKEN ();
1211           parse_untyped_expr ();
1212           expect (')', "missing ')'");
1213           return;
1214         default:;
1215           /* fall through */
1216         }
1217     default:
1218       parse_operand0 ();
1219     }
1220 }
1221
1222 int
1223 chill_parse (void)
1224 {
1225   terminal_buffer[0] = TOKEN_NOT_READ;
1226   if (PEEK_TOKEN () == TYPENAME && PEEK_TOKEN1 () == END_TOKEN)
1227     {
1228       write_exp_elt_opcode (OP_TYPE);
1229       write_exp_elt_type (PEEK_LVAL ().tsym.type);
1230       write_exp_elt_opcode (OP_TYPE);
1231       FORWARD_TOKEN ();
1232     }
1233   else
1234     parse_expr ();
1235   if (terminal_buffer[0] != END_TOKEN)
1236     {
1237       if (comma_terminates && terminal_buffer[0] == ',')
1238         lexptr--;               /* Put the comma back.  */
1239       else
1240         error ("Junk after end of expression.");
1241     }
1242   return 0;
1243 }
1244
1245
1246 /* Implementation of a dynamically expandable buffer for processing input
1247    characters acquired through lexptr and building a value to return in
1248    yylval. */
1249
1250 static char *tempbuf;           /* Current buffer contents */
1251 static int tempbufsize;         /* Size of allocated buffer */
1252 static int tempbufindex;        /* Current index into buffer */
1253
1254 #define GROWBY_MIN_SIZE 64      /* Minimum amount to grow buffer by */
1255
1256 #define CHECKBUF(size) \
1257   do { \
1258     if (tempbufindex + (size) >= tempbufsize) \
1259       { \
1260         growbuf_by_size (size); \
1261       } \
1262   } while (0);
1263
1264 /* Grow the static temp buffer if necessary, including allocating the first one
1265    on demand. */
1266
1267 static void
1268 growbuf_by_size (int count)
1269 {
1270   int growby;
1271
1272   growby = max (count, GROWBY_MIN_SIZE);
1273   tempbufsize += growby;
1274   if (tempbuf == NULL)
1275     {
1276       tempbuf = (char *) xmalloc (tempbufsize);
1277     }
1278   else
1279     {
1280       tempbuf = (char *) xrealloc (tempbuf, tempbufsize);
1281     }
1282 }
1283
1284 /* Try to consume a simple name string token.  If successful, returns
1285    a pointer to a nullbyte terminated copy of the name that can be used
1286    in symbol table lookups.  If not successful, returns NULL. */
1287
1288 static char *
1289 match_simple_name_string (void)
1290 {
1291   char *tokptr = lexptr;
1292
1293   if (isalpha (*tokptr) || *tokptr == '_')
1294     {
1295       char *result;
1296       do
1297         {
1298           tokptr++;
1299         }
1300       while (isalnum (*tokptr) || (*tokptr == '_'));
1301       yylval.sval.ptr = lexptr;
1302       yylval.sval.length = tokptr - lexptr;
1303       lexptr = tokptr;
1304       result = copy_name (yylval.sval);
1305       return result;
1306     }
1307   return (NULL);
1308 }
1309
1310 /* Start looking for a value composed of valid digits as set by the base
1311    in use.  Note that '_' characters are valid anywhere, in any quantity,
1312    and are simply ignored.  Since we must find at least one valid digit,
1313    or reject this token as an integer literal, we keep track of how many
1314    digits we have encountered. */
1315
1316 static int
1317 decode_integer_value (int base, char **tokptrptr, LONGEST *ivalptr)
1318 {
1319   char *tokptr = *tokptrptr;
1320   int temp;
1321   int digits = 0;
1322
1323   while (*tokptr != '\0')
1324     {
1325       temp = *tokptr;
1326       if (isupper (temp))
1327         temp = tolower (temp);
1328       tokptr++;
1329       switch (temp)
1330         {
1331         case '_':
1332           continue;
1333         case '0':
1334         case '1':
1335         case '2':
1336         case '3':
1337         case '4':
1338         case '5':
1339         case '6':
1340         case '7':
1341         case '8':
1342         case '9':
1343           temp -= '0';
1344           break;
1345         case 'a':
1346         case 'b':
1347         case 'c':
1348         case 'd':
1349         case 'e':
1350         case 'f':
1351           temp -= 'a';
1352           temp += 10;
1353           break;
1354         default:
1355           temp = base;
1356           break;
1357         }
1358       if (temp < base)
1359         {
1360           digits++;
1361           *ivalptr *= base;
1362           *ivalptr += temp;
1363         }
1364       else
1365         {
1366           /* Found something not in domain for current base. */
1367           tokptr--;             /* Unconsume what gave us indigestion. */
1368           break;
1369         }
1370     }
1371
1372   /* If we didn't find any digits, then we don't have a valid integer
1373      value, so reject the entire token.  Otherwise, update the lexical
1374      scan pointer, and return non-zero for success. */
1375
1376   if (digits == 0)
1377     {
1378       return (0);
1379     }
1380   else
1381     {
1382       *tokptrptr = tokptr;
1383       return (1);
1384     }
1385 }
1386
1387 static int
1388 decode_integer_literal (LONGEST *valptr, char **tokptrptr)
1389 {
1390   char *tokptr = *tokptrptr;
1391   int base = 0;
1392   LONGEST ival = 0;
1393   int explicit_base = 0;
1394
1395   /* Look for an explicit base specifier, which is optional. */
1396
1397   switch (*tokptr)
1398     {
1399     case 'd':
1400     case 'D':
1401       explicit_base++;
1402       base = 10;
1403       tokptr++;
1404       break;
1405     case 'b':
1406     case 'B':
1407       explicit_base++;
1408       base = 2;
1409       tokptr++;
1410       break;
1411     case 'h':
1412     case 'H':
1413       explicit_base++;
1414       base = 16;
1415       tokptr++;
1416       break;
1417     case 'o':
1418     case 'O':
1419       explicit_base++;
1420       base = 8;
1421       tokptr++;
1422       break;
1423     default:
1424       base = 10;
1425       break;
1426     }
1427
1428   /* If we found an explicit base ensure that the character after the
1429      explicit base is a single quote. */
1430
1431   if (explicit_base && (*tokptr++ != '\''))
1432     {
1433       return (0);
1434     }
1435
1436   /* Attempt to decode whatever follows as an integer value in the
1437      indicated base, updating the token pointer in the process and
1438      computing the value into ival.  Also, if we have an explicit
1439      base, then the next character must not be a single quote, or we
1440      have a bitstring literal, so reject the entire token in this case.
1441      Otherwise, update the lexical scan pointer, and return non-zero
1442      for success. */
1443
1444   if (!decode_integer_value (base, &tokptr, &ival))
1445     {
1446       return (0);
1447     }
1448   else if (explicit_base && (*tokptr == '\''))
1449     {
1450       return (0);
1451     }
1452   else
1453     {
1454       *valptr = ival;
1455       *tokptrptr = tokptr;
1456       return (1);
1457     }
1458 }
1459
1460 /*  If it wasn't for the fact that floating point values can contain '_'
1461    characters, we could just let strtod do all the hard work by letting it
1462    try to consume as much of the current token buffer as possible and
1463    find a legal conversion.  Unfortunately we need to filter out the '_'
1464    characters before calling strtod, which we do by copying the other
1465    legal chars to a local buffer to be converted.  However since we also
1466    need to keep track of where the last unconsumed character in the input
1467    buffer is, we have transfer only as many characters as may compose a
1468    legal floating point value. */
1469
1470 static enum ch_terminal
1471 match_float_literal (void)
1472 {
1473   char *tokptr = lexptr;
1474   char *buf;
1475   char *copy;
1476   double dval;
1477   extern double strtod ();
1478
1479   /* Make local buffer in which to build the string to convert.  This is
1480      required because underscores are valid in chill floating point numbers
1481      but not in the string passed to strtod to convert.  The string will be
1482      no longer than our input string. */
1483
1484   copy = buf = (char *) alloca (strlen (tokptr) + 1);
1485
1486   /* Transfer all leading digits to the conversion buffer, discarding any
1487      underscores. */
1488
1489   while (isdigit (*tokptr) || *tokptr == '_')
1490     {
1491       if (*tokptr != '_')
1492         {
1493           *copy++ = *tokptr;
1494         }
1495       tokptr++;
1496     }
1497
1498   /* Now accept either a '.', or one of [eEdD].  Dot is legal regardless
1499      of whether we found any leading digits, and we simply accept it and
1500      continue on to look for the fractional part and/or exponent.  One of
1501      [eEdD] is legal only if we have seen digits, and means that there
1502      is no fractional part.  If we find neither of these, then this is
1503      not a floating point number, so return failure. */
1504
1505   switch (*tokptr++)
1506     {
1507     case '.':
1508       /* Accept and then look for fractional part and/or exponent. */
1509       *copy++ = '.';
1510       break;
1511
1512     case 'e':
1513     case 'E':
1514     case 'd':
1515     case 'D':
1516       if (copy == buf)
1517         {
1518           return (0);
1519         }
1520       *copy++ = 'e';
1521       goto collect_exponent;
1522       break;
1523
1524     default:
1525       return (0);
1526       break;
1527     }
1528
1529   /* We found a '.', copy any fractional digits to the conversion buffer, up
1530      to the first nondigit, non-underscore character. */
1531
1532   while (isdigit (*tokptr) || *tokptr == '_')
1533     {
1534       if (*tokptr != '_')
1535         {
1536           *copy++ = *tokptr;
1537         }
1538       tokptr++;
1539     }
1540
1541   /* Look for an exponent, which must start with one of [eEdD].  If none
1542      is found, jump directly to trying to convert what we have collected
1543      so far. */
1544
1545   switch (*tokptr)
1546     {
1547     case 'e':
1548     case 'E':
1549     case 'd':
1550     case 'D':
1551       *copy++ = 'e';
1552       tokptr++;
1553       break;
1554     default:
1555       goto convert_float;
1556       break;
1557     }
1558
1559   /* Accept an optional '-' or '+' following one of [eEdD]. */
1560
1561 collect_exponent:
1562   if (*tokptr == '+' || *tokptr == '-')
1563     {
1564       *copy++ = *tokptr++;
1565     }
1566
1567   /* Now copy an exponent into the conversion buffer.  Note that at the
1568      moment underscores are *not* allowed in exponents. */
1569
1570   while (isdigit (*tokptr))
1571     {
1572       *copy++ = *tokptr++;
1573     }
1574
1575   /* If we transfered any chars to the conversion buffer, try to interpret its
1576      contents as a floating point value.  If any characters remain, then we
1577      must not have a valid floating point string. */
1578
1579 convert_float:
1580   *copy = '\0';
1581   if (copy != buf)
1582     {
1583       dval = strtod (buf, &copy);
1584       if (*copy == '\0')
1585         {
1586           yylval.dval = dval;
1587           lexptr = tokptr;
1588           return (FLOAT_LITERAL);
1589         }
1590     }
1591   return (0);
1592 }
1593
1594 /* Recognize a string literal.  A string literal is a sequence
1595    of characters enclosed in matching single or double quotes, except that
1596    a single character inside single quotes is a character literal, which
1597    we reject as a string literal.  To embed the terminator character inside
1598    a string, it is simply doubled (I.E. "this""is""one""string") */
1599
1600 static enum ch_terminal
1601 match_string_literal (void)
1602 {
1603   char *tokptr = lexptr;
1604   int in_ctrlseq = 0;
1605   LONGEST ival;
1606
1607   for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1608     {
1609       CHECKBUF (1);
1610     tryagain:;
1611       if (in_ctrlseq)
1612         {
1613           /* skip possible whitespaces */
1614           while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
1615             tokptr++;
1616           if (*tokptr == ')')
1617             {
1618               in_ctrlseq = 0;
1619               tokptr++;
1620               goto tryagain;
1621             }
1622           else if (*tokptr != ',')
1623             error ("Invalid control sequence");
1624           tokptr++;
1625           /* skip possible whitespaces */
1626           while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
1627             tokptr++;
1628           if (!decode_integer_literal (&ival, &tokptr))
1629             error ("Invalid control sequence");
1630           tokptr--;
1631         }
1632       else if (*tokptr == *lexptr)
1633         {
1634           if (*(tokptr + 1) == *lexptr)
1635             {
1636               ival = *tokptr++;
1637             }
1638           else
1639             {
1640               break;
1641             }
1642         }
1643       else if (*tokptr == '^')
1644         {
1645           if (*(tokptr + 1) == '(')
1646             {
1647               in_ctrlseq = 1;
1648               tokptr += 2;
1649               if (!decode_integer_literal (&ival, &tokptr))
1650                 error ("Invalid control sequence");
1651               tokptr--;
1652             }
1653           else if (*(tokptr + 1) == '^')
1654             ival = *tokptr++;
1655           else
1656             error ("Invalid control sequence");
1657         }
1658       else
1659         ival = *tokptr;
1660       tempbuf[tempbufindex++] = ival;
1661     }
1662   if (in_ctrlseq)
1663     error ("Invalid control sequence");
1664
1665   if (*tokptr == '\0'           /* no terminator */
1666       || (tempbufindex == 1 && *tokptr == '\''))        /* char literal */
1667     {
1668       return (0);
1669     }
1670   else
1671     {
1672       tempbuf[tempbufindex] = '\0';
1673       yylval.sval.ptr = tempbuf;
1674       yylval.sval.length = tempbufindex;
1675       lexptr = ++tokptr;
1676       return (CHARACTER_STRING_LITERAL);
1677     }
1678 }
1679
1680 /* Recognize a character literal.  A character literal is single character
1681    or a control sequence, enclosed in single quotes.  A control sequence
1682    is a comma separated list of one or more integer literals, enclosed
1683    in parenthesis and introduced with a circumflex character.
1684
1685    EX:  'a'  '^(7)'  '^(7,8)'
1686
1687    As a GNU chill extension, the syntax C'xx' is also recognized as a
1688    character literal, where xx is a hex value for the character.
1689
1690    Note that more than a single character, enclosed in single quotes, is
1691    a string literal.
1692
1693    Returns CHARACTER_LITERAL if a match is found.
1694  */
1695
1696 static enum ch_terminal
1697 match_character_literal (void)
1698 {
1699   char *tokptr = lexptr;
1700   LONGEST ival = 0;
1701
1702   if ((*tokptr == 'c' || *tokptr == 'C') && (*(tokptr + 1) == '\''))
1703     {
1704       /* We have a GNU chill extension form, so skip the leading "C'",
1705          decode the hex value, and then ensure that we have a trailing
1706          single quote character. */
1707       tokptr += 2;
1708       if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
1709         {
1710           return (0);
1711         }
1712       tokptr++;
1713     }
1714   else if (*tokptr == '\'')
1715     {
1716       tokptr++;
1717
1718       /* Determine which form we have, either a control sequence or the
1719          single character form. */
1720
1721       if (*tokptr == '^')
1722         {
1723           if (*(tokptr + 1) == '(')
1724             {
1725               /* Match and decode a control sequence.  Return zero if we don't
1726                  find a valid integer literal, or if the next unconsumed character
1727                  after the integer literal is not the trailing ')'. */
1728               tokptr += 2;
1729               if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
1730                 {
1731                   return (0);
1732                 }
1733             }
1734           else if (*(tokptr + 1) == '^')
1735             {
1736               ival = *tokptr;
1737               tokptr += 2;
1738             }
1739           else
1740             /* fail */
1741             error ("Invalid control sequence");
1742         }
1743       else if (*tokptr == '\'')
1744         {
1745           /* this must be duplicated */
1746           ival = *tokptr;
1747           tokptr += 2;
1748         }
1749       else
1750         {
1751           ival = *tokptr++;
1752         }
1753
1754       /* The trailing quote has not yet been consumed.  If we don't find
1755          it, then we have no match. */
1756
1757       if (*tokptr++ != '\'')
1758         {
1759           return (0);
1760         }
1761     }
1762   else
1763     {
1764       /* Not a character literal. */
1765       return (0);
1766     }
1767   yylval.typed_val.val = ival;
1768   yylval.typed_val.type = builtin_type_chill_char;
1769   lexptr = tokptr;
1770   return (CHARACTER_LITERAL);
1771 }
1772
1773 /* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1774    Note that according to 5.2.4.2, a single "_" is also a valid integer
1775    literal, however GNU-chill requires there to be at least one "digit"
1776    in any integer literal. */
1777
1778 static enum ch_terminal
1779 match_integer_literal (void)
1780 {
1781   char *tokptr = lexptr;
1782   LONGEST ival;
1783
1784   if (!decode_integer_literal (&ival, &tokptr))
1785     {
1786       return (0);
1787     }
1788   else
1789     {
1790       yylval.typed_val.val = ival;
1791 #if defined(CC_HAS_LONG_LONG) && defined(__STDC__)
1792       if (ival > (LONGEST) 2147483647U || ival < -(LONGEST) 2147483648U)
1793         yylval.typed_val.type = builtin_type_long_long;
1794       else
1795 #endif
1796         yylval.typed_val.type = builtin_type_int;
1797       lexptr = tokptr;
1798       return (INTEGER_LITERAL);
1799     }
1800 }
1801
1802 /* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
1803    Note that according to 5.2.4.8, a single "_" is also a valid bit-string
1804    literal, however GNU-chill requires there to be at least one "digit"
1805    in any bit-string literal. */
1806
1807 static enum ch_terminal
1808 match_bitstring_literal (void)
1809 {
1810   register char *tokptr = lexptr;
1811   int bitoffset = 0;
1812   int bitcount = 0;
1813   int bits_per_char;
1814   int digit;
1815
1816   tempbufindex = 0;
1817   CHECKBUF (1);
1818   tempbuf[0] = 0;
1819
1820   /* Look for the required explicit base specifier. */
1821
1822   switch (*tokptr++)
1823     {
1824     case 'b':
1825     case 'B':
1826       bits_per_char = 1;
1827       break;
1828     case 'o':
1829     case 'O':
1830       bits_per_char = 3;
1831       break;
1832     case 'h':
1833     case 'H':
1834       bits_per_char = 4;
1835       break;
1836     default:
1837       return (0);
1838       break;
1839     }
1840
1841   /* Ensure that the character after the explicit base is a single quote. */
1842
1843   if (*tokptr++ != '\'')
1844     {
1845       return (0);
1846     }
1847
1848   while (*tokptr != '\0' && *tokptr != '\'')
1849     {
1850       digit = *tokptr;
1851       if (isupper (digit))
1852         digit = tolower (digit);
1853       tokptr++;
1854       switch (digit)
1855         {
1856         case '_':
1857           continue;
1858         case '0':
1859         case '1':
1860         case '2':
1861         case '3':
1862         case '4':
1863         case '5':
1864         case '6':
1865         case '7':
1866         case '8':
1867         case '9':
1868           digit -= '0';
1869           break;
1870         case 'a':
1871         case 'b':
1872         case 'c':
1873         case 'd':
1874         case 'e':
1875         case 'f':
1876           digit -= 'a';
1877           digit += 10;
1878           break;
1879         default:
1880           /* this is not a bitstring literal, probably an integer */
1881           return 0;
1882         }
1883       if (digit >= 1 << bits_per_char)
1884         {
1885           /* Found something not in domain for current base. */
1886           error ("Too-large digit in bitstring or integer.");
1887         }
1888       else
1889         {
1890           /* Extract bits from digit, packing them into the bitstring byte. */
1891           int k = TARGET_BYTE_ORDER == BIG_ENDIAN ? bits_per_char - 1 : 0;
1892           for (; TARGET_BYTE_ORDER == BIG_ENDIAN ? k >= 0 : k < bits_per_char;
1893                TARGET_BYTE_ORDER == BIG_ENDIAN ? k-- : k++)
1894             {
1895               bitcount++;
1896               if (digit & (1 << k))
1897                 {
1898                   tempbuf[tempbufindex] |=
1899                     (TARGET_BYTE_ORDER == BIG_ENDIAN)
1900                     ? (1 << (HOST_CHAR_BIT - 1 - bitoffset))
1901                     : (1 << bitoffset);
1902                 }
1903               bitoffset++;
1904               if (bitoffset == HOST_CHAR_BIT)
1905                 {
1906                   bitoffset = 0;
1907                   tempbufindex++;
1908                   CHECKBUF (1);
1909                   tempbuf[tempbufindex] = 0;
1910                 }
1911             }
1912         }
1913     }
1914
1915   /* Verify that we consumed everything up to the trailing single quote,
1916      and that we found some bits (IE not just underbars). */
1917
1918   if (*tokptr++ != '\'')
1919     {
1920       return (0);
1921     }
1922   else
1923     {
1924       yylval.sval.ptr = tempbuf;
1925       yylval.sval.length = bitcount;
1926       lexptr = tokptr;
1927       return (BIT_STRING_LITERAL);
1928     }
1929 }
1930
1931 struct token
1932 {
1933   char *operator;
1934   int token;
1935 };
1936
1937 static const struct token idtokentab[] =
1938 {
1939   {"array", ARRAY},
1940   {"length", LENGTH},
1941   {"lower", LOWER},
1942   {"upper", UPPER},
1943   {"andif", ANDIF},
1944   {"pred", PRED},
1945   {"succ", SUCC},
1946   {"card", CARD},
1947   {"size", SIZE},
1948   {"orif", ORIF},
1949   {"num", NUM},
1950   {"abs", ABS},
1951   {"max", MAX_TOKEN},
1952   {"min", MIN_TOKEN},
1953   {"mod", MOD},
1954   {"rem", REM},
1955   {"not", NOT},
1956   {"xor", LOGXOR},
1957   {"and", LOGAND},
1958   {"in", IN},
1959   {"or", LOGIOR},
1960   {"up", UP},
1961   {"addr", ADDR_TOKEN},
1962   {"null", EMPTINESS_LITERAL}
1963 };
1964
1965 static const struct token tokentab2[] =
1966 {
1967   {":=", GDB_ASSIGNMENT},
1968   {"//", SLASH_SLASH},
1969   {"->", POINTER},
1970   {"/=", NOTEQUAL},
1971   {"<=", LEQ},
1972   {">=", GEQ}
1973 };
1974
1975 /* Read one token, getting characters through lexptr.  */
1976 /* This is where we will check to make sure that the language and the
1977    operators used are compatible.  */
1978
1979 static enum ch_terminal
1980 ch_lex (void)
1981 {
1982   unsigned int i;
1983   enum ch_terminal token;
1984   char *inputname;
1985   struct symbol *sym;
1986
1987   /* Skip over any leading whitespace. */
1988   while (isspace (*lexptr))
1989     {
1990       lexptr++;
1991     }
1992   /* Look for special single character cases which can't be the first
1993      character of some other multicharacter token. */
1994   switch (*lexptr)
1995     {
1996     case '\0':
1997       return END_TOKEN;
1998     case ',':
1999     case '=':
2000     case ';':
2001     case '!':
2002     case '+':
2003     case '*':
2004     case '(':
2005     case ')':
2006     case '[':
2007     case ']':
2008       return (*lexptr++);
2009     }
2010   /* Look for characters which start a particular kind of multicharacter
2011      token, such as a character literal, register name, convenience
2012      variable name, string literal, etc. */
2013   switch (*lexptr)
2014     {
2015     case '\'':
2016     case '\"':
2017       /* First try to match a string literal, which is any
2018          sequence of characters enclosed in matching single or double
2019          quotes, except that a single character inside single quotes
2020          is a character literal, so we have to catch that case also. */
2021       token = match_string_literal ();
2022       if (token != 0)
2023         {
2024           return (token);
2025         }
2026       if (*lexptr == '\'')
2027         {
2028           token = match_character_literal ();
2029           if (token != 0)
2030             {
2031               return (token);
2032             }
2033         }
2034       break;
2035     case 'C':
2036     case 'c':
2037       token = match_character_literal ();
2038       if (token != 0)
2039         {
2040           return (token);
2041         }
2042       break;
2043     case '$':
2044       yylval.sval.ptr = lexptr;
2045       do
2046         {
2047           lexptr++;
2048         }
2049       while (isalnum (*lexptr) || *lexptr == '_' || *lexptr == '$');
2050       yylval.sval.length = lexptr - yylval.sval.ptr;
2051       write_dollar_variable (yylval.sval);
2052       return GDB_VARIABLE;
2053       break;
2054     }
2055   /* See if it is a special token of length 2.  */
2056   for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
2057     {
2058       if (STREQN (lexptr, tokentab2[i].operator, 2))
2059         {
2060           lexptr += 2;
2061           return (tokentab2[i].token);
2062         }
2063     }
2064   /* Look for single character cases which which could be the first
2065      character of some other multicharacter token, but aren't, or we
2066      would already have found it. */
2067   switch (*lexptr)
2068     {
2069     case '-':
2070     case ':':
2071     case '/':
2072     case '<':
2073     case '>':
2074       return (*lexptr++);
2075     }
2076   /* Look for a float literal before looking for an integer literal, so
2077      we match as much of the input stream as possible. */
2078   token = match_float_literal ();
2079   if (token != 0)
2080     {
2081       return (token);
2082     }
2083   token = match_bitstring_literal ();
2084   if (token != 0)
2085     {
2086       return (token);
2087     }
2088   token = match_integer_literal ();
2089   if (token != 0)
2090     {
2091       return (token);
2092     }
2093
2094   /* Try to match a simple name string, and if a match is found, then
2095      further classify what sort of name it is and return an appropriate
2096      token.  Note that attempting to match a simple name string consumes
2097      the token from lexptr, so we can't back out if we later find that
2098      we can't classify what sort of name it is. */
2099
2100   inputname = match_simple_name_string ();
2101
2102   if (inputname != NULL)
2103     {
2104       char *simplename = (char *) alloca (strlen (inputname) + 1);
2105
2106       char *dptr = simplename, *sptr = inputname;
2107       for (; *sptr; sptr++)
2108         *dptr++ = isupper (*sptr) ? tolower (*sptr) : *sptr;
2109       *dptr = '\0';
2110
2111       /* See if it is a reserved identifier. */
2112       for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
2113         {
2114           if (STREQ (simplename, idtokentab[i].operator))
2115             {
2116               return (idtokentab[i].token);
2117             }
2118         }
2119
2120       /* Look for other special tokens. */
2121       if (STREQ (simplename, "true"))
2122         {
2123           yylval.ulval = 1;
2124           return (BOOLEAN_LITERAL);
2125         }
2126       if (STREQ (simplename, "false"))
2127         {
2128           yylval.ulval = 0;
2129           return (BOOLEAN_LITERAL);
2130         }
2131
2132       sym = lookup_symbol (inputname, expression_context_block,
2133                            VAR_NAMESPACE, (int *) NULL,
2134                            (struct symtab **) NULL);
2135       if (sym == NULL && strcmp (inputname, simplename) != 0)
2136         {
2137           sym = lookup_symbol (simplename, expression_context_block,
2138                                VAR_NAMESPACE, (int *) NULL,
2139                                (struct symtab **) NULL);
2140         }
2141       if (sym != NULL)
2142         {
2143           yylval.ssym.stoken.ptr = NULL;
2144           yylval.ssym.stoken.length = 0;
2145           yylval.ssym.sym = sym;
2146           yylval.ssym.is_a_field_of_this = 0;   /* FIXME, C++'ism */
2147           switch (SYMBOL_CLASS (sym))
2148             {
2149             case LOC_BLOCK:
2150               /* Found a procedure name. */
2151               return (GENERAL_PROCEDURE_NAME);
2152             case LOC_STATIC:
2153               /* Found a global or local static variable. */
2154               return (LOCATION_NAME);
2155             case LOC_REGISTER:
2156             case LOC_ARG:
2157             case LOC_REF_ARG:
2158             case LOC_REGPARM:
2159             case LOC_REGPARM_ADDR:
2160             case LOC_LOCAL:
2161             case LOC_LOCAL_ARG:
2162             case LOC_BASEREG:
2163             case LOC_BASEREG_ARG:
2164               if (innermost_block == NULL
2165                   || contained_in (block_found, innermost_block))
2166                 {
2167                   innermost_block = block_found;
2168                 }
2169               return (LOCATION_NAME);
2170               break;
2171             case LOC_CONST:
2172             case LOC_LABEL:
2173               return (LOCATION_NAME);
2174               break;
2175             case LOC_TYPEDEF:
2176               yylval.tsym.type = SYMBOL_TYPE (sym);
2177               return TYPENAME;
2178             case LOC_UNDEF:
2179             case LOC_CONST_BYTES:
2180             case LOC_OPTIMIZED_OUT:
2181               error ("Symbol \"%s\" names no location.", inputname);
2182               break;
2183             default:
2184               internal_error (__FILE__, __LINE__,
2185                               "unhandled SYMBOL_CLASS in ch_lex()");
2186               break;
2187             }
2188         }
2189       else if (!have_full_symbols () && !have_partial_symbols ())
2190         {
2191           error ("No symbol table is loaded.  Use the \"file\" command.");
2192         }
2193       else
2194         {
2195           error ("No symbol \"%s\" in current context.", inputname);
2196         }
2197     }
2198
2199   /* Catch single character tokens which are not part of some
2200      longer token. */
2201
2202   switch (*lexptr)
2203     {
2204     case '.':                   /* Not float for example. */
2205       lexptr++;
2206       while (isspace (*lexptr))
2207         lexptr++;
2208       inputname = match_simple_name_string ();
2209       if (!inputname)
2210         return '.';
2211       return DOT_FIELD_NAME;
2212     }
2213
2214   return (ILLEGAL_TOKEN);
2215 }
2216
2217 static void
2218 write_lower_upper_value (enum exp_opcode opcode,        /* Either UNOP_LOWER or UNOP_UPPER */
2219                          struct type *type)
2220 {
2221   if (type == NULL)
2222     write_exp_elt_opcode (opcode);
2223   else
2224     {
2225       struct type *result_type;
2226       LONGEST val = type_lower_upper (opcode, type, &result_type);
2227       write_exp_elt_opcode (OP_LONG);
2228       write_exp_elt_type (result_type);
2229       write_exp_elt_longcst (val);
2230       write_exp_elt_opcode (OP_LONG);
2231     }
2232 }
2233
2234 void
2235 chill_error (char *msg)
2236 {
2237   /* Never used. */
2238 }