Initial creation of sourceware repository

1 files changed, 0 insertions, 2169 deletions

diff --git a/gdb/ch-exp.c b/gdb/ch-exp.c
deleted file mode 100644
index 45436a3..0000000
--- a/gdb/ch-exp.c
+++ /dev/null
@@ -1,2169 +0,0 @@
-/* Parser for GNU CHILL (CCITT High-Level Language)  -*- C -*-
-   Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc.
-
-This file is part of GDB.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
-
-/* Parse a Chill expression from text in a string,
-   and return the result as a  struct expression  pointer.
-   That structure contains arithmetic operations in reverse polish,
-   with constants represented by operations that are followed by special data.
-   See expression.h for the details of the format.
-   What is important here is that it can be built up sequentially
-   during the process of parsing; the lower levels of the tree always
-   come first in the result.
-
-   Note that the language accepted by this parser is more liberal
-   than the one accepted by an actual Chill compiler.  For example, the
-   language rule that a simple name string can not be one of the reserved
-   simple name strings is not enforced (e.g "case" is not treated as a
-   reserved name).  Another example is that Chill is a strongly typed
-   language, and certain expressions that violate the type constraints
-   may still be evaluated if gdb can do so in a meaningful manner, while
-   such expressions would be rejected by the compiler.  The reason for
-   this more liberal behavior is the philosophy that the debugger
-   is intended to be a tool that is used by the programmer when things
-   go wrong, and as such, it should provide as few artificial barriers
-   to it's use as possible.  If it can do something meaningful, even
-   something that violates language contraints that are enforced by the
-   compiler, it should do so without complaint.
-
- */
-
-#include "defs.h"
-#include "gdb_string.h"
-#include <ctype.h>
-#include "expression.h"
-#include "language.h"
-#include "value.h"
-#include "parser-defs.h"
-#include "ch-lang.h"
-#include "bfd.h" /* Required by objfiles.h.  */
-#include "symfile.h" /* Required by objfiles.h.  */
-#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
-
-#ifdef __GNUC__
-#define INLINE __inline__
-#endif
-
-typedef union
-
-  {
-    LONGEST lval;
-    ULONGEST ulval;
-    struct {
-      LONGEST val;
-      struct type *type;
-    } typed_val;
-    double dval;
-    struct symbol *sym;
-    struct type *tval;
-    struct stoken sval;
-    struct ttype tsym;
-    struct symtoken ssym;
-  }YYSTYPE;
-
-enum ch_terminal {
-  END_TOKEN = 0,
-  /* '\001' ... '\xff' come first. */
-  OPEN_PAREN = '(',
-  TOKEN_NOT_READ = 999,
-  INTEGER_LITERAL,
-  BOOLEAN_LITERAL,
-  CHARACTER_LITERAL,
-  FLOAT_LITERAL,
-  GENERAL_PROCEDURE_NAME,
-  LOCATION_NAME,
-  EMPTINESS_LITERAL,
-  CHARACTER_STRING_LITERAL,
-  BIT_STRING_LITERAL,
-  TYPENAME,
-  DOT_FIELD_NAME, /* '.' followed by <field name> */
-  CASE,
-  OF,
-  ESAC,
-  LOGIOR,
-  ORIF,
-  LOGXOR,
-  LOGAND,
-  ANDIF,
-  NOTEQUAL,
-  GEQ,
-  LEQ,
-  IN,
-  SLASH_SLASH,
-  MOD,
-  REM,
-  NOT,
-  POINTER,
-  RECEIVE,
-  UP,
-  IF,
-  THEN,
-  ELSE,
-  FI,
-  ELSIF,
-  ILLEGAL_TOKEN,
-  NUM,
-  PRED,
-  SUCC,
-  ABS,
-  CARD,
-  MAX_TOKEN,
-  MIN_TOKEN,
-  ADDR_TOKEN,
-  SIZE,
-  UPPER,
-  LOWER,
-  LENGTH,
-  ARRAY,
-  GDB_VARIABLE,
-  GDB_ASSIGNMENT
-};
-
-/* Forward declarations. */
-
-static void write_lower_upper_value PARAMS ((enum exp_opcode, struct type *));
-static enum ch_terminal match_bitstring_literal PARAMS ((void));
-static enum ch_terminal match_integer_literal PARAMS ((void));
-static enum ch_terminal match_character_literal PARAMS ((void));
-static enum ch_terminal match_string_literal PARAMS ((void));
-static enum ch_terminal match_float_literal PARAMS ((void));
-static enum ch_terminal match_float_literal PARAMS ((void));
-static int decode_integer_literal PARAMS ((LONGEST *, char **));
-static int decode_integer_value PARAMS ((int, char **, LONGEST *));
-static char *match_simple_name_string PARAMS ((void));
-static void growbuf_by_size PARAMS ((int));
-static void parse_untyped_expr PARAMS ((void));
-static void parse_if_expression PARAMS ((void));
-static void parse_else_alternative PARAMS ((void));
-static void parse_then_alternative PARAMS ((void));
-static void parse_expr PARAMS ((void));
-static void parse_operand0 PARAMS ((void));
-static void parse_operand1 PARAMS ((void));
-static void parse_operand2 PARAMS ((void));
-static void parse_operand3 PARAMS ((void));
-static void parse_operand4 PARAMS ((void));
-static void parse_operand5 PARAMS ((void));
-static void parse_operand6 PARAMS ((void));
-static void parse_primval PARAMS ((void));
-static void parse_tuple PARAMS ((struct type *));
-static void parse_opt_element_list PARAMS ((struct type *));
-static void parse_tuple_element PARAMS ((struct type *));
-static void parse_named_record_element PARAMS ((void));
-static void parse_call PARAMS ((void));
-static struct type *parse_mode_or_normal_call PARAMS ((void));
-#if 0
-static struct type *parse_mode_call PARAMS ((void));
-#endif
-static void parse_unary_call PARAMS ((void));
-static int parse_opt_untyped_expr PARAMS ((void));
-static void parse_case_label PARAMS ((void));
-static int expect PARAMS ((enum ch_terminal, char *));
-static void parse_expr PARAMS ((void));
-static void parse_primval PARAMS ((void));
-static void parse_untyped_expr PARAMS ((void));
-static int parse_opt_untyped_expr PARAMS ((void));
-static void parse_if_expression_body PARAMS((void));
-static enum ch_terminal ch_lex PARAMS ((void));
-INLINE static enum ch_terminal PEEK_TOKEN PARAMS ((void));
-static enum ch_terminal peek_token_ PARAMS ((int));
-static void forward_token_ PARAMS ((void));
-static void require PARAMS ((enum ch_terminal));
-static int check_token PARAMS ((enum ch_terminal));
-
-#define MAX_LOOK_AHEAD 2
-static enum ch_terminal terminal_buffer[MAX_LOOK_AHEAD+1] = {
-  TOKEN_NOT_READ, TOKEN_NOT_READ, TOKEN_NOT_READ};
-static YYSTYPE yylval;
-static YYSTYPE val_buffer[MAX_LOOK_AHEAD+1];
-
-/*int current_token, lookahead_token;*/
-
-INLINE static enum ch_terminal
-PEEK_TOKEN()
-{
-  if (terminal_buffer[0] == TOKEN_NOT_READ)
-    {
-      terminal_buffer[0] = ch_lex ();
-      val_buffer[0] = yylval;
-    }
-  return terminal_buffer[0];
-}
-#define PEEK_LVAL() val_buffer[0]
-#define PEEK_TOKEN1() peek_token_(1)
-#define PEEK_TOKEN2() peek_token_(2)
-static enum ch_terminal
-peek_token_ (i)
-     int i;
-{
-  if (i > MAX_LOOK_AHEAD)
-    fatal ("internal error - too much lookahead");
-  if (terminal_buffer[i] == TOKEN_NOT_READ)
-    {
-      terminal_buffer[i] = ch_lex ();
-      val_buffer[i] = yylval;
-    }
-  return terminal_buffer[i];
-}
-
-#if 0
-
-static void
-pushback_token (code, node)
-     enum ch_terminal code;
-     YYSTYPE node;
-{
-  int i;
-  if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ)
-    fatal ("internal error - cannot pushback token");
-  for (i = MAX_LOOK_AHEAD; i > 0; i--)
-    { 
-      terminal_buffer[i] = terminal_buffer[i - 1]; 
-      val_buffer[i] = val_buffer[i - 1];
-  }
-  terminal_buffer[0] = code;
-  val_buffer[0] = node;
-}
-
-#endif
-
-static void
-forward_token_()
-{
-  int i;
-  for (i = 0; i < MAX_LOOK_AHEAD; i++)
-    {
-      terminal_buffer[i] = terminal_buffer[i+1];
-      val_buffer[i] = val_buffer[i+1];
-    }
-  terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ;
-}
-#define FORWARD_TOKEN() forward_token_()
-
-/* Skip the next token.
-   if it isn't TOKEN, the parser is broken. */
-
-static void
-require(token)
-     enum ch_terminal token;
-{
-  if (PEEK_TOKEN() != token)
-    {
-      char buf[80];
-      sprintf (buf, "internal parser error - expected token %d", (int)token);
-      fatal(buf);
-    }
-  FORWARD_TOKEN();
-}
-
-static int
-check_token (token)
-     enum ch_terminal token;
-{
-  if (PEEK_TOKEN() != token)
-    return 0;
-  FORWARD_TOKEN ();
-  return 1;
-}
-
-/* return 0 if expected token was not found,
-   else return 1.
-*/
-static int
-expect (token, message)
-     enum ch_terminal token;
-     char *message;
-{
-  if (PEEK_TOKEN() != token)
-    {
-      if (message)
-	error (message);
-      else if (token < 256)
-	error ("syntax error - expected a '%c' here \"%s\"", token, lexptr);
-      else
-	error ("syntax error");
-      return 0;
-    }
-  else
-    FORWARD_TOKEN();
-  return 1;
-}
-
-#if 0
-static tree
-parse_opt_name_string (allow_all)
-     int allow_all; /* 1 if ALL is allowed as a postfix */
-{
-  int token = PEEK_TOKEN();
-  tree name;
-  if (token != NAME)
-    {
-      if (token == ALL && allow_all)
-	{
-	  FORWARD_TOKEN ();
-	  return ALL_POSTFIX;
-	}
-      return NULL_TREE;
-    }
-  name = PEEK_LVAL();
-  for (;;)
-    {
-      FORWARD_TOKEN ();
-      token = PEEK_TOKEN();
-      if (token != '!')
-	return name;
-      FORWARD_TOKEN();
-      token = PEEK_TOKEN();
-      if (token == ALL && allow_all)
-	return get_identifier3(IDENTIFIER_POINTER (name), "!", "*");
-      if (token != NAME)
-	{
-	  if (pass == 1)
-	    error ("'%s!' is not followed by an identifier",
-		   IDENTIFIER_POINTER (name));
-	  return name;
-	}
-      name = get_identifier3(IDENTIFIER_POINTER(name),
-			     "!", IDENTIFIER_POINTER(PEEK_LVAL()));
-    }
-}
-
-static tree
-parse_simple_name_string ()
-{
-  int token = PEEK_TOKEN();
-  tree name;
-  if (token != NAME)
-    {
-      error ("expected a name here");
-      return error_mark_node;
-    }
-  name = PEEK_LVAL ();
-  FORWARD_TOKEN ();
-  return name;
-}
-
-static tree
-parse_name_string ()
-{
-  tree name = parse_opt_name_string (0);
-  if (name)
-    return name;
-  if (pass == 1)
-    error ("expected a name string here");
-  return error_mark_node;
-}
-
-/* Matches: <name_string>
-   Returns if pass 1: the identifier.
-   Returns if pass 2: a decl or value for identifier. */
-
-static tree
-parse_name ()
-{
-  tree name = parse_name_string ();
-  if (pass == 1 || ignoring)
-    return name;
-  else
-    {
-      tree decl = lookup_name (name);
-      if (decl == NULL_TREE)
-	{
-	  error ("`%s' undeclared", IDENTIFIER_POINTER (name));
-	  return error_mark_node;
-	}
-      else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK)
-	return error_mark_node;
-      else if (TREE_CODE (decl) == CONST_DECL)
-	return DECL_INITIAL (decl);
-      else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE)
-	return convert_from_reference (decl);
-      else
-	return decl;
-    } 
-}
-#endif
-
-#if 0
-static void
-pushback_paren_expr (expr)
-     tree expr;
-{
-  if (pass == 1 && !ignoring)
-    expr = build1 (PAREN_EXPR, NULL_TREE, expr);
-  pushback_token (EXPR, expr);
-}
-#endif
-
-/* Matches: <case label> */
-
-static void
-parse_case_label ()
-{
-  if (check_token (ELSE))
-    error ("ELSE in tuples labels not implemented");
-  /* Does not handle the case of a mode name.  FIXME */
-  parse_expr ();
-  if (check_token (':'))
-    {
-      parse_expr ();
-      write_exp_elt_opcode (BINOP_RANGE);
-    }
-}
-
-static int
-parse_opt_untyped_expr ()
-{
-  switch (PEEK_TOKEN ())
-    {
-    case ',':
-    case ':':
-    case ')':
-      return 0;
-    default:
-      parse_untyped_expr ();
-      return 1;
-    }
-}
-
-static void
-parse_unary_call ()
-{
-  FORWARD_TOKEN ();
-  expect ('(', NULL);
-  parse_expr ();
-  expect (')', NULL);
-}
-
-/* Parse NAME '(' MODENAME ')'. */
-
-#if 0
-
-static struct type *
-parse_mode_call ()
-{
-  struct type *type;
-  FORWARD_TOKEN ();
-  expect ('(', NULL);
-  if (PEEK_TOKEN () != TYPENAME)
-    error ("expect MODENAME here `%s'", lexptr);
-  type = PEEK_LVAL().tsym.type;
-  FORWARD_TOKEN ();
-  expect (')', NULL);
-  return type;
-}
-
-#endif
-
-static struct type *
-parse_mode_or_normal_call ()
-{
-  struct type *type;
-  FORWARD_TOKEN ();
-  expect ('(', NULL);
-  if (PEEK_TOKEN () == TYPENAME)
-    {
-      type = PEEK_LVAL().tsym.type;
-      FORWARD_TOKEN ();
-    }
-  else
-    {
-      parse_expr ();
-      type = NULL;
-    }
-  expect (')', NULL);
-  return type;
-}
-
-/* Parse something that looks like a function call.
-   Assume we have parsed the function, and are at the '('. */
-
-static void
-parse_call ()
-{
-  int arg_count;
-  require ('(');
-  /* This is to save the value of arglist_len
-     being accumulated for each dimension. */
-  start_arglist ();
-  if (parse_opt_untyped_expr ())
-    {
-      int tok = PEEK_TOKEN ();
-      arglist_len = 1;
-      if (tok == UP || tok == ':')
-	{
-	  FORWARD_TOKEN ();
-	  parse_expr ();
-	  expect (')', "expected ')' to terminate slice");
-	  end_arglist ();
-	  write_exp_elt_opcode (tok == UP ? TERNOP_SLICE_COUNT
-				: TERNOP_SLICE);
-	  return;
-	}
-      while (check_token (','))
-	{
-	  parse_untyped_expr ();
-	  arglist_len++;
-	}
-    }
-  else
-    arglist_len = 0;
-  expect (')', NULL);
-  arg_count = end_arglist ();
-  write_exp_elt_opcode (MULTI_SUBSCRIPT);
-  write_exp_elt_longcst (arg_count);
-  write_exp_elt_opcode (MULTI_SUBSCRIPT);
-}
-
-static void
-parse_named_record_element ()
-{
-  struct stoken label;
-  char buf[256];
-
-  label = PEEK_LVAL ().sval;
-  sprintf (buf, "expected a field name here `%s'", lexptr);
-  expect (DOT_FIELD_NAME, buf);
-  if (check_token (','))
-    parse_named_record_element ();
-  else if (check_token (':'))
-    parse_expr ();
-  else
-    error ("syntax error near `%s' in named record tuple element", lexptr);
-  write_exp_elt_opcode (OP_LABELED);
-  write_exp_string (label);
-  write_exp_elt_opcode (OP_LABELED);
-}
-
-/* Returns one or more TREE_LIST nodes, in reverse order. */
-
-static void
-parse_tuple_element (type)
-     struct type *type;
-{
-  if (PEEK_TOKEN () == DOT_FIELD_NAME)
-    {
-      /* Parse a labelled structure tuple. */
-      parse_named_record_element ();
-      return;
-    }
-
-  if (check_token ('('))
-    {
-      if (check_token ('*'))
-	{
-	  expect (')', "missing ')' after '*' case label list");
-	  if (type)
-	    {
-	      if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
-		{
-		  /* do this as a range from low to high */
-		  struct type *range_type = TYPE_FIELD_TYPE (type, 0);
-		  LONGEST low_bound, high_bound;
-		  if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
-		    error ("cannot determine bounds for (*)");
-		  /* lower bound */
-		  write_exp_elt_opcode (OP_LONG);
-		  write_exp_elt_type (range_type);
-		  write_exp_elt_longcst (low_bound);
-		  write_exp_elt_opcode (OP_LONG);
-		  /* upper bound */
-		  write_exp_elt_opcode (OP_LONG);
-		  write_exp_elt_type (range_type);
-		  write_exp_elt_longcst (high_bound);
-		  write_exp_elt_opcode (OP_LONG);
-		  write_exp_elt_opcode (BINOP_RANGE);
-		}
-	      else
-		error ("(*) in invalid context");
-	    }
-	  else
-	    error ("(*) only possible with modename in front of tuple (mode[..])");
-	}
-      else
-	{
-	  parse_case_label ();
-	  while (check_token (','))
-	    {
-	      parse_case_label ();
-	      write_exp_elt_opcode (BINOP_COMMA);
-	    }
-	  expect (')', NULL);
-	}
-    }
-  else
-    parse_untyped_expr ();
-  if (check_token (':'))
-    {
-      /* A powerset range or a labeled Array. */
-      parse_untyped_expr ();
-      write_exp_elt_opcode (BINOP_RANGE);
-    }
-}
-
-/* Matches:  a COMMA-separated list of tuple elements.
-   Returns a list (of TREE_LIST nodes). */
-static void
-parse_opt_element_list (type)
-     struct type *type;
-{
-  arglist_len = 0;
-  if (PEEK_TOKEN () == ']')
-    return;
-  for (;;)
-    {
-      parse_tuple_element (type);
-      arglist_len++;
-      if (PEEK_TOKEN () == ']')
-	break;
-      if (!check_token (','))
-	error ("bad syntax in tuple");
-    }
-}
-
-/* Parses: '[' elements ']'
-   If modename is non-NULL it prefixed the tuple.  */
-
-static void
-parse_tuple (mode)
-     struct type *mode;
-{
-  struct type *type;
-  if (mode)
-    type = check_typedef (mode);
-  else
-    type = 0;
-  require ('[');
-  start_arglist ();
-  parse_opt_element_list (type);
-  expect (']', "missing ']' after tuple");
-  write_exp_elt_opcode (OP_ARRAY);
-  write_exp_elt_longcst ((LONGEST) 0);
-  write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
-  write_exp_elt_opcode (OP_ARRAY);
-  if (type)
-    {
-      if (TYPE_CODE (type) != TYPE_CODE_ARRAY
-	  && TYPE_CODE (type) != TYPE_CODE_STRUCT
-	  && TYPE_CODE (type) != TYPE_CODE_SET)
-	error ("invalid tuple mode");
-      write_exp_elt_opcode (UNOP_CAST);
-      write_exp_elt_type (mode);
-      write_exp_elt_opcode (UNOP_CAST);
-    }
-}
-
-static void
-parse_primval ()
-{
-  struct type *type;
-  enum exp_opcode op;
-  char *op_name;
-  switch (PEEK_TOKEN ())
-    {
-    case INTEGER_LITERAL: 
-    case CHARACTER_LITERAL:
-      write_exp_elt_opcode (OP_LONG);
-      write_exp_elt_type (PEEK_LVAL ().typed_val.type);
-      write_exp_elt_longcst (PEEK_LVAL ().typed_val.val);
-      write_exp_elt_opcode (OP_LONG);
-      FORWARD_TOKEN ();
-      break;
-    case BOOLEAN_LITERAL:
-      write_exp_elt_opcode (OP_BOOL);
-      write_exp_elt_longcst ((LONGEST) PEEK_LVAL ().ulval);
-      write_exp_elt_opcode (OP_BOOL);
-      FORWARD_TOKEN ();
-      break;
-    case FLOAT_LITERAL:
-      write_exp_elt_opcode (OP_DOUBLE);
-      write_exp_elt_type (builtin_type_double);
-      write_exp_elt_dblcst (PEEK_LVAL ().dval);
-      write_exp_elt_opcode (OP_DOUBLE);
-      FORWARD_TOKEN ();
-      break;
-    case EMPTINESS_LITERAL:
-      write_exp_elt_opcode (OP_LONG);
-      write_exp_elt_type (lookup_pointer_type (builtin_type_void));
-      write_exp_elt_longcst (0);
-      write_exp_elt_opcode (OP_LONG);
-      FORWARD_TOKEN ();
-      break;
-    case CHARACTER_STRING_LITERAL:
-      write_exp_elt_opcode (OP_STRING);
-      write_exp_string (PEEK_LVAL ().sval);
-      write_exp_elt_opcode (OP_STRING);
-      FORWARD_TOKEN ();
-      break;
-    case BIT_STRING_LITERAL:
-      write_exp_elt_opcode (OP_BITSTRING);
-      write_exp_bitstring (PEEK_LVAL ().sval);
-      write_exp_elt_opcode (OP_BITSTRING);
-      FORWARD_TOKEN ();
-      break;
-    case ARRAY:
-      FORWARD_TOKEN ();
-      /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
-	 which casts to an artificial array. */
-      expect ('(', NULL);
-      expect (')', NULL);
-      if (PEEK_TOKEN () != TYPENAME)
-	error ("missing MODENAME after ARRAY()");
-      type = PEEK_LVAL().tsym.type;
-      FORWARD_TOKEN ();
-      expect ('(', NULL);
-      parse_expr ();
-      expect (')', "missing right parenthesis");
-      type = create_array_type ((struct type *) NULL, type,
-				create_range_type ((struct type *) NULL,
-						   builtin_type_int, 0, 0));
-      TYPE_ARRAY_UPPER_BOUND_TYPE(type) = BOUND_CANNOT_BE_DETERMINED;
-      write_exp_elt_opcode (UNOP_CAST);
-      write_exp_elt_type (type);
-      write_exp_elt_opcode (UNOP_CAST);
-      break;
-#if 0
-    case CONST:
-    case EXPR:
-      val = PEEK_LVAL();
-      FORWARD_TOKEN ();
-      break;
-#endif
-    case '(':
-      FORWARD_TOKEN ();
-      parse_expr ();
-      expect (')', "missing right parenthesis");
-      break;
-    case '[':
-      parse_tuple (NULL);
-      break;
-    case GENERAL_PROCEDURE_NAME:
-    case LOCATION_NAME:
-      write_exp_elt_opcode (OP_VAR_VALUE);
-      write_exp_elt_block (NULL);
-      write_exp_elt_sym (PEEK_LVAL ().ssym.sym);
-      write_exp_elt_opcode (OP_VAR_VALUE);
-      FORWARD_TOKEN ();
-      break;
-    case GDB_VARIABLE:	/* gdb specific */
-      FORWARD_TOKEN ();
-      break;
-    case NUM:
-      parse_unary_call ();
-      write_exp_elt_opcode (UNOP_CAST);
-      write_exp_elt_type (builtin_type_int);
-      write_exp_elt_opcode (UNOP_CAST);
-      break;
-    case CARD:
-      parse_unary_call ();
-      write_exp_elt_opcode (UNOP_CARD);
-      break;
-    case MAX_TOKEN:
-      parse_unary_call ();
-      write_exp_elt_opcode (UNOP_CHMAX);
-      break;
-    case MIN_TOKEN:
-      parse_unary_call ();
-      write_exp_elt_opcode (UNOP_CHMIN);
-      break;
-    case PRED:      op_name = "PRED"; goto unimplemented_unary_builtin;
-    case SUCC:      op_name = "SUCC"; goto unimplemented_unary_builtin;
-    case ABS:       op_name = "ABS";  goto unimplemented_unary_builtin;
-    unimplemented_unary_builtin:
-      parse_unary_call ();
-      error ("not implemented:  %s builtin function", op_name);
-      break;
-    case ADDR_TOKEN:
-      parse_unary_call ();
-      write_exp_elt_opcode (UNOP_ADDR);
-      break;
-    case SIZE:
-      type = parse_mode_or_normal_call ();
-      if (type)
-	{ write_exp_elt_opcode (OP_LONG);
-	  write_exp_elt_type (builtin_type_int);
-	  CHECK_TYPEDEF (type);
-	  write_exp_elt_longcst ((LONGEST) TYPE_LENGTH (type));
-	  write_exp_elt_opcode (OP_LONG);
-	}
-      else
-	write_exp_elt_opcode (UNOP_SIZEOF);
-      break;
-    case LOWER:
-      op = UNOP_LOWER;
-      goto lower_upper;
-    case UPPER:
-      op = UNOP_UPPER;
-      goto lower_upper;
-    lower_upper:
-      type = parse_mode_or_normal_call ();
-      write_lower_upper_value (op, type);
-      break;
-    case LENGTH:
-      parse_unary_call ();
-      write_exp_elt_opcode (UNOP_LENGTH);
-      break;
-    case TYPENAME:
-      type = PEEK_LVAL ().tsym.type;
-      FORWARD_TOKEN ();
-      switch (PEEK_TOKEN())
-	{
-	case '[':
-	  parse_tuple (type);
-	  break;
-	case '(':
-	  FORWARD_TOKEN ();
-	  parse_expr ();
-	  expect (')', "missing right parenthesis");
-	  write_exp_elt_opcode (UNOP_CAST);
-	  write_exp_elt_type (type);
-	  write_exp_elt_opcode (UNOP_CAST);
-	  break;
-	default:
-	  error ("typename in invalid context");
-	}
-      break;
-      
-    default: 
-      error ("invalid expression syntax at `%s'", lexptr);
-    }
-  for (;;)
-    {
-      switch (PEEK_TOKEN ())
-	{
-	case DOT_FIELD_NAME:
-	  write_exp_elt_opcode (STRUCTOP_STRUCT);
-	  write_exp_string (PEEK_LVAL ().sval);
-	  write_exp_elt_opcode (STRUCTOP_STRUCT);
-	  FORWARD_TOKEN ();
-	  continue;
-	case POINTER:
-	  FORWARD_TOKEN ();
-	  if (PEEK_TOKEN () == TYPENAME)
-	    {
-	      type = PEEK_LVAL ().tsym.type;
-	      write_exp_elt_opcode (UNOP_CAST);
-	      write_exp_elt_type (lookup_pointer_type (type));
-	      write_exp_elt_opcode (UNOP_CAST);
-	      FORWARD_TOKEN ();
-	    }
-	  write_exp_elt_opcode (UNOP_IND);
-	  continue;
-	case OPEN_PAREN:
-	  parse_call ();
-	  continue;
-	case CHARACTER_STRING_LITERAL:
-	case CHARACTER_LITERAL:
-	case BIT_STRING_LITERAL:
-	  /* Handle string repetition. (See comment in parse_operand5.) */
-	  parse_primval ();
-	  write_exp_elt_opcode (MULTI_SUBSCRIPT);
-	  write_exp_elt_longcst (1);
-	  write_exp_elt_opcode (MULTI_SUBSCRIPT);
-	  continue;
-	case END_TOKEN:
-	case TOKEN_NOT_READ:
-	case INTEGER_LITERAL:
-	case BOOLEAN_LITERAL:
-	case FLOAT_LITERAL:
-	case GENERAL_PROCEDURE_NAME:
-	case LOCATION_NAME:
-	case EMPTINESS_LITERAL:
-	case TYPENAME:
-	case CASE:
-	case OF:
-	case ESAC:
-	case LOGIOR:
-	case ORIF:
-	case LOGXOR:
-	case LOGAND:
-	case ANDIF:
-	case NOTEQUAL:
-	case GEQ:
-	case LEQ:
-	case IN:
-	case SLASH_SLASH:
-	case MOD:
-	case REM:
-	case NOT:
-	case RECEIVE:
-	case UP:
-	case IF:
-	case THEN:
-	case ELSE:
-	case FI:
-	case ELSIF:
-	case ILLEGAL_TOKEN:
-	case NUM:
-	case PRED:
-	case SUCC:
-	case ABS:
-	case CARD:
-	case MAX_TOKEN:
-	case MIN_TOKEN:
-	case ADDR_TOKEN:
-	case SIZE:
-	case UPPER:
-	case LOWER:
-	case LENGTH:
-	case ARRAY:
-	case GDB_VARIABLE:
-	case GDB_ASSIGNMENT:
-	  break;
-	}
-      break;
-    }
-  return;
-}
-
-static void
-parse_operand6 ()
-{
-  if (check_token (RECEIVE))
-    {
-      parse_primval ();
-      error ("not implemented:  RECEIVE expression");
-    }
-  else if (check_token (POINTER))
-    {
-      parse_primval ();
-      write_exp_elt_opcode (UNOP_ADDR);
-    }
-  else
-    parse_primval();
-}
-
-static void
-parse_operand5()
-{
-  enum exp_opcode op;
-  /* We are supposed to be looking for a <string repetition operator>,
-     but in general we can't distinguish that from a parenthesized
-     expression.  This is especially difficult if we allow the
-     string operand to be a constant expression (as requested by
-     some users), and not just a string literal.
-     Consider:  LPRN expr RPRN LPRN expr RPRN
-     Is that a function call or string repetition?
-     Instead, we handle string repetition in parse_primval,
-     and build_generalized_call. */
-  switch (PEEK_TOKEN())
-    {
-    case NOT:  op = UNOP_LOGICAL_NOT; break;
-    case '-':  op = UNOP_NEG; break;
-    default:
-      op = OP_NULL;
-    }
-  if (op != OP_NULL)
-    FORWARD_TOKEN();
-  parse_operand6();
-  if (op != OP_NULL)
-    write_exp_elt_opcode (op);
-}
-
-static void
-parse_operand4 ()
-{
-  enum exp_opcode op;
-  parse_operand5();
-  for (;;)
-    {
-      switch (PEEK_TOKEN())
-	{
-	case '*':  op = BINOP_MUL; break;
-	case '/':  op = BINOP_DIV; break;
-	case MOD:  op = BINOP_MOD; break;
-	case REM:  op = BINOP_REM; break;
-	default:
-	  return;
-	}
-      FORWARD_TOKEN();
-      parse_operand5();
-      write_exp_elt_opcode (op);
-    }
-}
-
-static void
-parse_operand3 ()
-{
-  enum exp_opcode op;
-  parse_operand4 ();
-  for (;;)
-    {
-      switch (PEEK_TOKEN())
-	{
-	case '+':    op = BINOP_ADD; break;
-	case '-':    op = BINOP_SUB; break;
-	case SLASH_SLASH: op = BINOP_CONCAT; break;
-	default:
-	  return;
-	}
-      FORWARD_TOKEN();
-      parse_operand4();
-      write_exp_elt_opcode (op);
-    }
-}
-
-static void
-parse_operand2 ()
-{
-  enum exp_opcode op;
-  parse_operand3 ();
-  for (;;)
-    {
-      if (check_token (IN))
-	{
-	  parse_operand3();
-	  write_exp_elt_opcode (BINOP_IN);
-	}
-      else
-	{
-	  switch (PEEK_TOKEN())
-	    {
-	    case '>':      op = BINOP_GTR; break;
-	    case GEQ:      op = BINOP_GEQ; break;
-	    case '<':      op = BINOP_LESS; break;
-	    case LEQ:      op = BINOP_LEQ; break;
-	    case '=':      op = BINOP_EQUAL; break;
-	    case NOTEQUAL: op = BINOP_NOTEQUAL; break;
-	    default:
-	      return;
-	    }
-	  FORWARD_TOKEN();
-	  parse_operand3();
-	  write_exp_elt_opcode (op);
-	}
-    }
-}
-
-static void
-parse_operand1 ()
-{
-  enum exp_opcode op;
-  parse_operand2 ();
-  for (;;)
-    {
-      switch (PEEK_TOKEN())
-	{
-	case LOGAND: op = BINOP_BITWISE_AND; break;
-	case ANDIF:  op = BINOP_LOGICAL_AND; break;
-	default:
-	  return;
-	}
-      FORWARD_TOKEN();
-      parse_operand2();
-      write_exp_elt_opcode (op);
-    }
-}
-
-static void
-parse_operand0 ()
-{ 
-  enum exp_opcode op;
-  parse_operand1();
-  for (;;)
-    {
-      switch (PEEK_TOKEN())
-	{
-	case LOGIOR:  op = BINOP_BITWISE_IOR; break;
-	case LOGXOR:  op = BINOP_BITWISE_XOR; break;
-	case ORIF:    op = BINOP_LOGICAL_OR; break;
-	default:
-	  return;
-	}
-      FORWARD_TOKEN();
-      parse_operand1();
-      write_exp_elt_opcode (op);
-    }
-}
-
-static void
-parse_expr ()
-{
-  parse_operand0 ();
-  if (check_token (GDB_ASSIGNMENT))
-    {
-      parse_expr ();
-      write_exp_elt_opcode (BINOP_ASSIGN);
-    }
-}
-
-static void
-parse_then_alternative ()
-{
-  expect (THEN, "missing 'THEN' in 'IF' expression");
-  parse_expr ();
-}
-
-static void
-parse_else_alternative ()
-{
-  if (check_token (ELSIF))
-    parse_if_expression_body ();
-  else if (check_token (ELSE))
-    parse_expr ();
-  else
-    error ("missing ELSE/ELSIF in IF expression");
-}
-
-/* Matches: <boolean expression> <then alternative> <else alternative> */
-
-static void
-parse_if_expression_body ()
-{
-  parse_expr ();
-  parse_then_alternative ();
-  parse_else_alternative ();
-  write_exp_elt_opcode (TERNOP_COND);
-}
-
-static void
-parse_if_expression ()
-{
-  require (IF);
-  parse_if_expression_body ();
-  expect (FI, "missing 'FI' at end of conditional expression");
-}
-
-/* An <untyped_expr> is a superset of <expr>.  It also includes
-   <conditional expressions> and untyped <tuples>, whose types
-   are not given by their constituents.  Hence, these are only
-   allowed in certain contexts that expect a certain type.
-   You should call convert() to fix up the <untyped_expr>. */
-
-static void
-parse_untyped_expr ()
-{
-  switch (PEEK_TOKEN())
-    {
-    case IF:
-      parse_if_expression ();
-      return;
-    case CASE:
-      error ("not implemented:  CASE expression");
-    case '(':
-      switch (PEEK_TOKEN1())
-	{
-	case IF:
-	case CASE:
-	  goto skip_lprn;
-	case '[':
-	skip_lprn:
-	  FORWARD_TOKEN ();
-	  parse_untyped_expr ();
-	  expect (')', "missing ')'");
-	  return;
-	default: ;
-	  /* fall through */
-	}
-    default:
-      parse_operand0 ();
-    }
-}
-
-int
-chill_parse ()
-{
-  terminal_buffer[0] = TOKEN_NOT_READ;
-  if (PEEK_TOKEN () == TYPENAME && PEEK_TOKEN1 () == END_TOKEN)
-    {
-      write_exp_elt_opcode(OP_TYPE);
-      write_exp_elt_type(PEEK_LVAL ().tsym.type);
-      write_exp_elt_opcode(OP_TYPE);
-      FORWARD_TOKEN ();
-    }
-  else
-    parse_expr ();
-  if (terminal_buffer[0] != END_TOKEN)
-    {
-      if (comma_terminates && terminal_buffer[0] == ',')
-	lexptr--;  /* Put the comma back.  */
-      else
-	error ("Junk after end of expression.");
-    }
-  return 0;
-}
-
-
-/* Implementation of a dynamically expandable buffer for processing input
-   characters acquired through lexptr and building a value to return in
-   yylval. */
-
-static char *tempbuf;		/* Current buffer contents */
-static int tempbufsize;		/* Size of allocated buffer */
-static int tempbufindex;	/* Current index into buffer */
-
-#define GROWBY_MIN_SIZE 64	/* Minimum amount to grow buffer by */
-
-#define CHECKBUF(size) \
-  do { \
-    if (tempbufindex + (size) >= tempbufsize) \
-      { \
-	growbuf_by_size (size); \
-      } \
-  } while (0);
-
-/* Grow the static temp buffer if necessary, including allocating the first one
-   on demand. */
-
-static void
-growbuf_by_size (count)
-     int count;
-{
-  int growby;
-
-  growby = max (count, GROWBY_MIN_SIZE);
-  tempbufsize += growby;
-  if (tempbuf == NULL)
-    {
-      tempbuf = (char *) xmalloc (tempbufsize);
-    }
-  else
-    {
-      tempbuf = (char *) xrealloc (tempbuf, tempbufsize);
-    }
-}
-
-/* Try to consume a simple name string token.  If successful, returns
-   a pointer to a nullbyte terminated copy of the name that can be used
-   in symbol table lookups.  If not successful, returns NULL. */
-
-static char *
-match_simple_name_string ()
-{
-  char *tokptr = lexptr;
-
-  if (isalpha (*tokptr) || *tokptr == '_')
-    {
-      char *result;
-      do {
-	tokptr++;
-      } while (isalnum (*tokptr) || (*tokptr == '_'));
-      yylval.sval.ptr = lexptr;
-      yylval.sval.length = tokptr - lexptr;
-      lexptr = tokptr;
-      result = copy_name (yylval.sval);
-      return result;
-    }
-  return (NULL);
-}
-
-/* Start looking for a value composed of valid digits as set by the base
-   in use.  Note that '_' characters are valid anywhere, in any quantity,
-   and are simply ignored.  Since we must find at least one valid digit,
-   or reject this token as an integer literal, we keep track of how many
-   digits we have encountered. */
-  
-static int
-decode_integer_value (base, tokptrptr, ivalptr)
-  int base;
-  char **tokptrptr;
-  LONGEST *ivalptr;
-{
-  char *tokptr = *tokptrptr;
-  int temp;
-  int digits = 0;
-
-  while (*tokptr != '\0')
-    {
-      temp = *tokptr;
-      if (isupper (temp))
-        temp = tolower (temp);
-      tokptr++;
-      switch (temp)
-	{
-	case '_':
-	  continue;
-	case '0':  case '1':  case '2':  case '3':  case '4':
-	case '5':  case '6':  case '7':  case '8':  case '9':
-	  temp -= '0';
-	  break;
-	case 'a':  case 'b':  case 'c':  case 'd':  case 'e': case 'f':
-	  temp -= 'a';
-	  temp += 10;
-	  break;
-	default:
-	  temp = base;
-	  break;
-	}
-      if (temp < base)
-	{
-	  digits++;
-	  *ivalptr *= base;
-	  *ivalptr += temp;
-	}
-      else
-	{
-	  /* Found something not in domain for current base. */
-	  tokptr--;	/* Unconsume what gave us indigestion. */
-	  break;
-	}
-    }
-  
-  /* If we didn't find any digits, then we don't have a valid integer
-     value, so reject the entire token.  Otherwise, update the lexical
-     scan pointer, and return non-zero for success. */
-  
-  if (digits == 0)
-    {
-      return (0);
-    }
-  else
-    {
-      *tokptrptr = tokptr;
-      return (1);
-    }
-}
-
-static int
-decode_integer_literal (valptr, tokptrptr)
-  LONGEST *valptr;
-  char **tokptrptr;
-{
-  char *tokptr = *tokptrptr;
-  int base = 0;
-  LONGEST ival = 0;
-  int explicit_base = 0;
-  
-  /* Look for an explicit base specifier, which is optional. */
-  
-  switch (*tokptr)
-    {
-    case 'd':
-    case 'D':
-      explicit_base++;
-      base = 10;
-      tokptr++;
-      break;
-    case 'b':
-    case 'B':
-      explicit_base++;
-      base = 2;
-      tokptr++;
-      break;
-    case 'h':
-    case 'H':
-      explicit_base++;
-      base = 16;
-      tokptr++;
-      break;
-    case 'o':
-    case 'O':
-      explicit_base++;
-      base = 8;
-      tokptr++;
-      break;
-    default:
-      base = 10;
-      break;
-    }
-  
-  /* If we found an explicit base ensure that the character after the
-     explicit base is a single quote. */
-  
-  if (explicit_base && (*tokptr++ != '\''))
-    {
-      return (0);
-    }
-  
-  /* Attempt to decode whatever follows as an integer value in the
-     indicated base, updating the token pointer in the process and
-     computing the value into ival.  Also, if we have an explicit
-     base, then the next character must not be a single quote, or we
-     have a bitstring literal, so reject the entire token in this case.
-     Otherwise, update the lexical scan pointer, and return non-zero
-     for success. */
-
-  if (!decode_integer_value (base, &tokptr, &ival))
-    {
-      return (0);
-    }
-  else if (explicit_base && (*tokptr == '\''))
-    {
-      return (0);
-    }
-  else
-    {
-      *valptr = ival;
-      *tokptrptr = tokptr;
-      return (1);
-    }
-}
-
-/*  If it wasn't for the fact that floating point values can contain '_'
-    characters, we could just let strtod do all the hard work by letting it
-    try to consume as much of the current token buffer as possible and
-    find a legal conversion.  Unfortunately we need to filter out the '_'
-    characters before calling strtod, which we do by copying the other
-    legal chars to a local buffer to be converted.  However since we also
-    need to keep track of where the last unconsumed character in the input
-    buffer is, we have transfer only as many characters as may compose a
-    legal floating point value. */
-    
-static enum ch_terminal
-match_float_literal ()
-{
-  char *tokptr = lexptr;
-  char *buf;
-  char *copy;
-  double dval;
-  extern double strtod ();
-  
-  /* Make local buffer in which to build the string to convert.  This is
-     required because underscores are valid in chill floating point numbers
-     but not in the string passed to strtod to convert.  The string will be
-     no longer than our input string. */
-     
-  copy = buf = (char *) alloca (strlen (tokptr) + 1);
-
-  /* Transfer all leading digits to the conversion buffer, discarding any
-     underscores. */
-
-  while (isdigit (*tokptr) || *tokptr == '_')
-    {
-      if (*tokptr != '_')
-	{
-	  *copy++ = *tokptr;
-	}
-      tokptr++;
-    }
-
-  /* Now accept either a '.', or one of [eEdD].  Dot is legal regardless
-     of whether we found any leading digits, and we simply accept it and
-     continue on to look for the fractional part and/or exponent.  One of
-     [eEdD] is legal only if we have seen digits, and means that there
-     is no fractional part.  If we find neither of these, then this is
-     not a floating point number, so return failure. */
-
-  switch (*tokptr++)
-    {
-      case '.':
-        /* Accept and then look for fractional part and/or exponent. */
-	*copy++ = '.';
-	break;
-
-      case 'e':
-      case 'E':
-      case 'd':
-      case 'D':
-	if (copy == buf)
-	  {
-	    return (0);
-	  }
-	*copy++ = 'e';
-	goto collect_exponent;
-	break;
-
-      default:
-	return (0);
-        break;
-    }
-
-  /* We found a '.', copy any fractional digits to the conversion buffer, up
-     to the first nondigit, non-underscore character. */
-
-  while (isdigit (*tokptr) || *tokptr == '_')
-    {
-      if (*tokptr != '_')
-	{
-	  *copy++ = *tokptr;
-	}
-      tokptr++;
-    }
-
-  /* Look for an exponent, which must start with one of [eEdD].  If none
-     is found, jump directly to trying to convert what we have collected
-     so far. */
-
-  switch (*tokptr)
-    {
-      case 'e':
-      case 'E':
-      case 'd':
-      case 'D':
-	*copy++ = 'e';
-	tokptr++;
-	break;
-      default:
-	goto convert_float;
-	break;
-    }
-
-  /* Accept an optional '-' or '+' following one of [eEdD]. */
-
-  collect_exponent:
-  if (*tokptr == '+' || *tokptr == '-')
-    {
-      *copy++ = *tokptr++;
-    }
-
-  /* Now copy an exponent into the conversion buffer.  Note that at the 
-     moment underscores are *not* allowed in exponents. */
-
-  while (isdigit (*tokptr))
-    {
-      *copy++ = *tokptr++;
-    }
-
-  /* If we transfered any chars to the conversion buffer, try to interpret its
-     contents as a floating point value.  If any characters remain, then we
-     must not have a valid floating point string. */
-
-  convert_float:
-  *copy = '\0';
-  if (copy != buf)
-      {
-        dval = strtod (buf, &copy);
-        if (*copy == '\0')
-	  {
-	    yylval.dval = dval;
-	    lexptr = tokptr;
-	    return (FLOAT_LITERAL);
-	  }
-      }
-  return (0);
-}
-
-/* Recognize a string literal.  A string literal is a sequence
-   of characters enclosed in matching single or double quotes, except that
-   a single character inside single quotes is a character literal, which
-   we reject as a string literal.  To embed the terminator character inside
-   a string, it is simply doubled (I.E. "this""is""one""string") */
-
-static enum ch_terminal
-match_string_literal ()
-{
-  char *tokptr = lexptr;
-  int in_ctrlseq = 0;
-  LONGEST ival;
-
-  for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
-    {
-      CHECKBUF (1);
-    tryagain: ;
-      if (in_ctrlseq)
-	{
-	  /* skip possible whitespaces */
-	  while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
-	    tokptr++;
-	  if (*tokptr == ')')
-	    {
-	      in_ctrlseq = 0;
-	      tokptr++;
-	      goto tryagain;
-	    }
-	  else if (*tokptr != ',')
-	    error ("Invalid control sequence");
-	  tokptr++;
-	  /* skip possible whitespaces */
-	  while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
-	    tokptr++;
-	  if (!decode_integer_literal (&ival, &tokptr))
-	    error ("Invalid control sequence");
-	  tokptr--;
-	}
-      else if (*tokptr == *lexptr)
-	{
-	  if (*(tokptr + 1) == *lexptr)
-	    {
-	      ival = *tokptr++;
-	    }
-	  else
-	    {
-	      break;
-	    }
-	}
-      else if (*tokptr == '^')
-	{
-	  if (*(tokptr + 1) == '(')
-	    {
-	      in_ctrlseq = 1;
-	      tokptr += 2;
-	      if (!decode_integer_literal (&ival, &tokptr))
-		error ("Invalid control sequence");
-	      tokptr--;
-	    }
-	  else if (*(tokptr + 1) == '^')
-	    ival = *tokptr++;
-	  else
-	    error ("Invalid control sequence");
-	}
-      else
-	ival = *tokptr;
-      tempbuf[tempbufindex++] = ival;
-    }
-  if (in_ctrlseq)
-    error ("Invalid control sequence");
-
-  if (*tokptr == '\0'					/* no terminator */
-      || (tempbufindex == 1 && *tokptr == '\''))	/* char literal */
-    {
-      return (0);
-    }
-  else
-    {
-      tempbuf[tempbufindex] = '\0';
-      yylval.sval.ptr = tempbuf;
-      yylval.sval.length = tempbufindex;
-      lexptr = ++tokptr;
-      return (CHARACTER_STRING_LITERAL);
-    }
-}
-
-/* Recognize a character literal.  A character literal is single character
-   or a control sequence, enclosed in single quotes.  A control sequence
-   is a comma separated list of one or more integer literals, enclosed
-   in parenthesis and introduced with a circumflex character.
-
-   EX:  'a'  '^(7)'  '^(7,8)'
-
-   As a GNU chill extension, the syntax C'xx' is also recognized as a 
-   character literal, where xx is a hex value for the character.
-
-   Note that more than a single character, enclosed in single quotes, is
-   a string literal.
-
-   Returns CHARACTER_LITERAL if a match is found.
-   */
-
-static enum ch_terminal
-match_character_literal ()
-{
-  char *tokptr = lexptr;
-  LONGEST ival = 0;
-  
-  if ((*tokptr == 'c' || *tokptr == 'C') && (*(tokptr + 1) == '\''))
-    {
-      /* We have a GNU chill extension form, so skip the leading "C'",
-	 decode the hex value, and then ensure that we have a trailing
-	 single quote character. */
-      tokptr += 2;
-      if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
-	{
-	  return (0);
-	}
-      tokptr++;
-    }
-  else if (*tokptr == '\'')
-    {
-      tokptr++;
-
-      /* Determine which form we have, either a control sequence or the
-	 single character form. */
-      
-      if (*tokptr == '^')
-	{
-	  if (*(tokptr + 1) == '(')
-	    {
-	      /* Match and decode a control sequence.  Return zero if we don't
-		 find a valid integer literal, or if the next unconsumed character
-		 after the integer literal is not the trailing ')'. */
-	      tokptr += 2;
-	      if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
-		{
-		  return (0);
-		}
-	    }
-	  else if (*(tokptr + 1) == '^')
-	    {
-	      ival = *tokptr;
-	      tokptr += 2;
-	    }
-	  else
-	    /* fail */
-	    error ("Invalid control sequence");
-	}
-      else if (*tokptr == '\'')
-	{
-	  /* this must be duplicated */
-	  ival = *tokptr;
-	  tokptr += 2;
-	}
-      else
-	{
-	  ival = *tokptr++;
-	}
-
-      /* The trailing quote has not yet been consumed.  If we don't find
-	 it, then we have no match. */
-      
-      if (*tokptr++ != '\'')
-	{
-	  return (0);
-	}
-    }
-  else
-    {
-      /* Not a character literal. */
-      return (0);
-    }
-  yylval.typed_val.val = ival;
-  yylval.typed_val.type = builtin_type_chill_char;
-  lexptr = tokptr;
-  return (CHARACTER_LITERAL);
-}
-
-/* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
-   Note that according to 5.2.4.2, a single "_" is also a valid integer
-   literal, however GNU-chill requires there to be at least one "digit"
-   in any integer literal. */
-
-static enum ch_terminal
-match_integer_literal ()
-{
-  char *tokptr = lexptr;
-  LONGEST ival;
-  
-  if (!decode_integer_literal (&ival, &tokptr))
-    {
-      return (0);
-    }
-  else 
-    {
-      yylval.typed_val.val = ival;
-#if defined(CC_HAS_LONG_LONG) && defined(__STDC__)
-      if (ival > (LONGEST)2147483647U || ival < -(LONGEST)2147483648U)
-	yylval.typed_val.type = builtin_type_long_long;
-      else
-#endif
-	yylval.typed_val.type = builtin_type_int;
-      lexptr = tokptr;
-      return (INTEGER_LITERAL);
-    }
-}
-
-/* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
-   Note that according to 5.2.4.8, a single "_" is also a valid bit-string
-   literal, however GNU-chill requires there to be at least one "digit"
-   in any bit-string literal. */
-
-static enum ch_terminal
-match_bitstring_literal ()
-{
-  register char *tokptr = lexptr;
-  int bitoffset = 0;
-  int bitcount = 0;
-  int bits_per_char;
-  int digit;
-  
-  tempbufindex = 0;
-  CHECKBUF (1);
-  tempbuf[0] = 0;
-
-  /* Look for the required explicit base specifier. */
-  
-  switch (*tokptr++)
-    {
-    case 'b':
-    case 'B':
-      bits_per_char = 1;
-      break;
-    case 'o':
-    case 'O':
-      bits_per_char = 3;
-      break;
-    case 'h':
-    case 'H':
-      bits_per_char = 4;
-      break;
-    default:
-      return (0);
-      break;
-    }
-
-  /* Ensure that the character after the explicit base is a single quote. */
-  
-  if (*tokptr++ != '\'')
-    {
-      return (0);
-    }
-  
-  while (*tokptr != '\0' && *tokptr != '\'')
-    {
-      digit = *tokptr;
-      if (isupper (digit))
-        digit = tolower (digit);
-      tokptr++;
-      switch (digit)
-	{
-	  case '_':
-	    continue;
-	  case '0':  case '1':  case '2':  case '3':  case '4':
-	  case '5':  case '6':  case '7':  case '8':  case '9':
-	    digit -= '0';
-	    break;
-	  case 'a':  case 'b':  case 'c':  case 'd':  case 'e': case 'f':
-	    digit -= 'a';
-	    digit += 10;
-	    break;
-	  default:
-	    /* this is not a bitstring literal, probably an integer */
-	    return 0;
-	}
-      if (digit >= 1 << bits_per_char)
-	{
-	  /* Found something not in domain for current base. */
-	  error ("Too-large digit in bitstring or integer.");
-	}
-      else
-	{
-	  /* Extract bits from digit, packing them into the bitstring byte. */
-	  int k = TARGET_BYTE_ORDER == BIG_ENDIAN ? bits_per_char - 1 : 0;
-	  for (; TARGET_BYTE_ORDER == BIG_ENDIAN ? k >= 0 : k < bits_per_char;
-	       TARGET_BYTE_ORDER == BIG_ENDIAN ? k-- : k++)
-	    {
-	      bitcount++;
-	      if (digit & (1 << k))
-		{
-		  tempbuf[tempbufindex] |=
-		    (TARGET_BYTE_ORDER == BIG_ENDIAN)
-		      ? (1 << (HOST_CHAR_BIT - 1 - bitoffset))
-			: (1 << bitoffset);
-		}
-	      bitoffset++;
-	      if (bitoffset == HOST_CHAR_BIT)
-		{
-		  bitoffset = 0;
-		  tempbufindex++;
-		  CHECKBUF(1);
-		  tempbuf[tempbufindex] = 0;
-		}
-	    }
-	}
-    }
-  
-  /* Verify that we consumed everything up to the trailing single quote,
-     and that we found some bits (IE not just underbars). */
-
-  if (*tokptr++ != '\'')
-    {
-      return (0);
-    }
-  else 
-    {
-      yylval.sval.ptr = tempbuf;
-      yylval.sval.length = bitcount;
-      lexptr = tokptr;
-      return (BIT_STRING_LITERAL);
-    }
-}
-
-struct token
-{
-  char *operator;
-  int token;
-};
-
-static const struct token idtokentab[] =
-{
-    { "array", ARRAY },
-    { "length", LENGTH },
-    { "lower", LOWER },
-    { "upper", UPPER },
-    { "andif", ANDIF },
-    { "pred", PRED },
-    { "succ", SUCC },
-    { "card", CARD },
-    { "size", SIZE },
-    { "orif", ORIF },
-    { "num", NUM },
-    { "abs", ABS },
-    { "max", MAX_TOKEN },
-    { "min", MIN_TOKEN },
-    { "mod", MOD },
-    { "rem", REM },
-    { "not", NOT },
-    { "xor", LOGXOR },
-    { "and", LOGAND },
-    { "in", IN },
-    { "or", LOGIOR },
-    { "up", UP },
-    { "addr", ADDR_TOKEN },
-    { "null", EMPTINESS_LITERAL }
-};
-
-static const struct token tokentab2[] =
-{
-    { ":=", GDB_ASSIGNMENT },
-    { "//", SLASH_SLASH },
-    { "->", POINTER },
-    { "/=", NOTEQUAL },
-    { "<=", LEQ },
-    { ">=", GEQ }
-};
-
-/* Read one token, getting characters through lexptr.  */
-/* This is where we will check to make sure that the language and the
-   operators used are compatible.  */
-
-static enum ch_terminal
-ch_lex ()
-{
-    unsigned int i;
-    enum ch_terminal token;
-    char *inputname;
-    struct symbol *sym;
-
-    /* Skip over any leading whitespace. */
-    while (isspace (*lexptr))
-	{
-	    lexptr++;
-	}
-    /* Look for special single character cases which can't be the first
-       character of some other multicharacter token. */
-    switch (*lexptr)
-	{
-	    case '\0':
-	        return END_TOKEN;
-	    case ',':
-	    case '=':
-	    case ';':
-	    case '!':
-	    case '+':
-	    case '*':
-	    case '(':
-	    case ')':
-	    case '[':
-	    case ']':
-		return (*lexptr++);
-	}
-    /* Look for characters which start a particular kind of multicharacter
-       token, such as a character literal, register name, convenience
-       variable name, string literal, etc. */
-    switch (*lexptr)
-      {
-	case '\'':
-	case '\"':
-	  /* First try to match a string literal, which is any
-	     sequence of characters enclosed in matching single or double
-	     quotes, except that a single character inside single quotes
-	     is a character literal, so we have to catch that case also. */
-	  token = match_string_literal ();
-	  if (token != 0)
-	    {
-	      return (token);
-	    }
-	  if (*lexptr == '\'')
-	    {
-	      token = match_character_literal ();
-	      if (token != 0)
-		{
-		  return (token);
-		}
-	    }
-	  break;
-        case 'C':
-        case 'c':
-	  token = match_character_literal ();
-	  if (token != 0)
-	    {
-	      return (token);
-	    }
-	  break;
-	case '$':
-	  yylval.sval.ptr = lexptr;
-	  do {
-	    lexptr++;
-	  } while (isalnum (*lexptr) || *lexptr == '_' || *lexptr == '$');
-	  yylval.sval.length = lexptr - yylval.sval.ptr;
-	  write_dollar_variable (yylval.sval);
-	  return GDB_VARIABLE;
-	  break;
-      }
-    /* See if it is a special token of length 2.  */
-    for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
-	{
-	    if (STREQN (lexptr, tokentab2[i].operator, 2))
-		{
-		    lexptr += 2;
-		    return (tokentab2[i].token);
-		}
-	}
-    /* Look for single character cases which which could be the first
-       character of some other multicharacter token, but aren't, or we
-       would already have found it. */
-    switch (*lexptr)
-	{
-	    case '-':
-	    case ':':
-	    case '/':
-	    case '<':
-	    case '>':
-		return (*lexptr++);
-	}
-    /* Look for a float literal before looking for an integer literal, so
-       we match as much of the input stream as possible. */
-    token = match_float_literal ();
-    if (token != 0)
-	{
-	    return (token);
-	}
-    token = match_bitstring_literal ();
-    if (token != 0)
-	{
-	    return (token);
-	}
-    token = match_integer_literal ();
-    if (token != 0)
-	{
-	    return (token);
-	}
-
-    /* Try to match a simple name string, and if a match is found, then
-       further classify what sort of name it is and return an appropriate
-       token.  Note that attempting to match a simple name string consumes
-       the token from lexptr, so we can't back out if we later find that
-       we can't classify what sort of name it is. */
-
-    inputname = match_simple_name_string ();
-
-    if (inputname != NULL)
-      {
-	char *simplename = (char*) alloca (strlen (inputname) + 1);
-
-	char *dptr = simplename, *sptr = inputname;
-	for (; *sptr; sptr++)
-	  *dptr++ = isupper (*sptr) ? tolower(*sptr) : *sptr;
-	*dptr = '\0';
-
-	/* See if it is a reserved identifier. */
-	for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
-	    {
-		if (STREQ (simplename, idtokentab[i].operator))
-		    {
-			return (idtokentab[i].token);
-		    }
-	    }
-
-	/* Look for other special tokens. */
-	if (STREQ (simplename, "true"))
-	    {
-		yylval.ulval = 1;
-		return (BOOLEAN_LITERAL);
-	    }
-	if (STREQ (simplename, "false"))
-	    {
-		yylval.ulval = 0;
-		return (BOOLEAN_LITERAL);
-	    }
-
-	sym = lookup_symbol (inputname, expression_context_block,
-			     VAR_NAMESPACE, (int *) NULL,
-			     (struct symtab **) NULL);
-	if (sym == NULL && strcmp (inputname, simplename) != 0)
-	  {
-	    sym = lookup_symbol (simplename, expression_context_block,
-				 VAR_NAMESPACE, (int *) NULL,
-				 (struct symtab **) NULL);
-	  }
-	if (sym != NULL)
-	  {
-	    yylval.ssym.stoken.ptr = NULL;
-	    yylval.ssym.stoken.length = 0;
-	    yylval.ssym.sym = sym;
-	    yylval.ssym.is_a_field_of_this = 0;	/* FIXME, C++'ism */
-	    switch (SYMBOL_CLASS (sym))
-	      {
-	      case LOC_BLOCK:
-		/* Found a procedure name. */
-		return (GENERAL_PROCEDURE_NAME);
-	      case LOC_STATIC:
-		/* Found a global or local static variable. */
-		return (LOCATION_NAME);
-	      case LOC_REGISTER:
-	      case LOC_ARG:
-	      case LOC_REF_ARG:
-	      case LOC_REGPARM:
-	      case LOC_REGPARM_ADDR:
-	      case LOC_LOCAL:
-	      case LOC_LOCAL_ARG:
-	      case LOC_BASEREG:
-	      case LOC_BASEREG_ARG:
-		if (innermost_block == NULL
-		    || contained_in (block_found, innermost_block))
-		  {
-		    innermost_block = block_found;
-		  }
-		return (LOCATION_NAME);
-		break;
-	      case LOC_CONST:
-	      case LOC_LABEL:
-		return (LOCATION_NAME);
-		break;
-	      case LOC_TYPEDEF:
-		yylval.tsym.type = SYMBOL_TYPE (sym);
-		return TYPENAME;
-	      case LOC_UNDEF:
-	      case LOC_CONST_BYTES:
-	      case LOC_OPTIMIZED_OUT:
-		error ("Symbol \"%s\" names no location.", inputname);
-		break;
-	      case LOC_UNRESOLVED:
-		error ("unhandled SYMBOL_CLASS in ch_lex()");
-		break;
-	      }
-	  }
-	else if (!have_full_symbols () && !have_partial_symbols ())
-	  {
-	    error ("No symbol table is loaded.  Use the \"file\" command.");
-	  }
-	else
-	  {
-	    error ("No symbol \"%s\" in current context.", inputname);
-	  }
-      }
-
-    /* Catch single character tokens which are not part of some
-       longer token. */
-
-    switch (*lexptr)
-      {
-	case '.':			/* Not float for example. */
-	  lexptr++;
-	  while (isspace (*lexptr)) lexptr++;
-	  inputname = match_simple_name_string ();
-	  if (!inputname)
-	    return '.';
-	  return DOT_FIELD_NAME;
-      }
-
-    return (ILLEGAL_TOKEN);
-}
-
-static void
-write_lower_upper_value (opcode, type)
-     enum exp_opcode opcode;  /* Either UNOP_LOWER or UNOP_UPPER */
-     struct type *type;
-{
-  if (type == NULL)
-    write_exp_elt_opcode (opcode);
-  else
-    {
-      struct type *result_type;
-      LONGEST val = type_lower_upper (opcode, type, &result_type);
-      write_exp_elt_opcode (OP_LONG);
-      write_exp_elt_type (result_type);
-      write_exp_elt_longcst (val);
-      write_exp_elt_opcode (OP_LONG);
-    }
-}
-
-void
-chill_error (msg)
-     char *msg;
-{
-  /* Never used. */
-}