gdb/ch-exp.c

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