gdb/ch-exp.c

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