1/* YACC parser for Go expressions, for GDB.
2
3   Copyright (C) 2012-2020 Free Software Foundation, Inc.
4
5   This file is part of GDB.
6
7   This program is free software; you can redistribute it and/or modify
8   it under the terms of the GNU General Public License as published by
9   the Free Software Foundation; either version 3 of the License, or
10   (at your option) any later version.
11
12   This program is distributed in the hope that it will be useful,
13   but WITHOUT ANY WARRANTY; without even the implied warranty of
14   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15   GNU General Public License for more details.
16
17   You should have received a copy of the GNU General Public License
18   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19
20/* This file is derived from c-exp.y, p-exp.y.  */
21
22/* Parse a Go expression from text in a string,
23   and return the result as a struct expression pointer.
24   That structure contains arithmetic operations in reverse polish,
25   with constants represented by operations that are followed by special data.
26   See expression.h for the details of the format.
27   What is important here is that it can be built up sequentially
28   during the process of parsing; the lower levels of the tree always
29   come first in the result.
30
31   Note that malloc's and realloc's in this file are transformed to
32   xmalloc and xrealloc respectively by the same sed command in the
33   makefile that remaps any other malloc/realloc inserted by the parser
34   generator.  Doing this with #defines and trying to control the interaction
35   with include files (<malloc.h> and <stdlib.h> for example) just became
36   too messy, particularly when such includes can be inserted at random
37   times by the parser generator.  */
38
39/* Known bugs or limitations:
40
41   - Unicode
42   - &^
43   - '_' (blank identifier)
44   - automatic deref of pointers
45   - method expressions
46   - interfaces, channels, etc.
47
48   And lots of other things.
49   I'm sure there's some cleanup to do.
50*/
51
52%{
53
54#include "defs.h"
55#include <ctype.h>
56#include "expression.h"
57#include "value.h"
58#include "parser-defs.h"
59#include "language.h"
60#include "c-lang.h"
61#include "go-lang.h"
62#include "bfd.h" /* Required by objfiles.h.  */
63#include "symfile.h" /* Required by objfiles.h.  */
64#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
65#include "charset.h"
66#include "block.h"
67
68#define parse_type(ps) builtin_type (ps->gdbarch ())
69
70/* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
71   etc).  */
72#define GDB_YY_REMAP_PREFIX go_
73#include "yy-remap.h"
74
75/* The state of the parser, used internally when we are parsing the
76   expression.  */
77
78static struct parser_state *pstate = NULL;
79
80int yyparse (void);
81
82static int yylex (void);
83
84static void yyerror (const char *);
85
86%}
87
88/* Although the yacc "value" of an expression is not used,
89   since the result is stored in the structure being created,
90   other node types do have values.  */
91
92%union
93  {
94    LONGEST lval;
95    struct {
96      LONGEST val;
97      struct type *type;
98    } typed_val_int;
99    struct {
100      gdb_byte val[16];
101      struct type *type;
102    } typed_val_float;
103    struct stoken sval;
104    struct symtoken ssym;
105    struct type *tval;
106    struct typed_stoken tsval;
107    struct ttype tsym;
108    int voidval;
109    enum exp_opcode opcode;
110    struct internalvar *ivar;
111    struct stoken_vector svec;
112  }
113
114%{
115/* YYSTYPE gets defined by %union.  */
116static int parse_number (struct parser_state *,
117			 const char *, int, int, YYSTYPE *);
118%}
119
120%type <voidval> exp exp1 type_exp start variable lcurly
121%type <lval> rcurly
122%type <tval> type
123
124%token <typed_val_int> INT
125%token <typed_val_float> FLOAT
126
127/* Both NAME and TYPENAME tokens represent symbols in the input,
128   and both convey their data as strings.
129   But a TYPENAME is a string that happens to be defined as a type
130   or builtin type name (such as int or char)
131   and a NAME is any other symbol.
132   Contexts where this distinction is not important can use the
133   nonterminal "name", which matches either NAME or TYPENAME.  */
134
135%token <tsval> RAW_STRING
136%token <tsval> STRING
137%token <tsval> CHAR
138%token <ssym> NAME
139%token <tsym> TYPENAME /* Not TYPE_NAME cus already taken.  */
140%token <voidval> COMPLETE
141/*%type <sval> name*/
142%type <svec> string_exp
143%type <ssym> name_not_typename
144
145/* A NAME_OR_INT is a symbol which is not known in the symbol table,
146   but which would parse as a valid number in the current input radix.
147   E.g. "c" when input_radix==16.  Depending on the parse, it will be
148   turned into a name or into a number.  */
149%token <ssym> NAME_OR_INT
150
151%token <lval> TRUE_KEYWORD FALSE_KEYWORD
152%token STRUCT_KEYWORD INTERFACE_KEYWORD TYPE_KEYWORD CHAN_KEYWORD
153%token SIZEOF_KEYWORD
154%token LEN_KEYWORD CAP_KEYWORD
155%token NEW_KEYWORD
156%token IOTA_KEYWORD NIL_KEYWORD
157%token CONST_KEYWORD
158%token DOTDOTDOT
159%token ENTRY
160%token ERROR
161
162/* Special type cases.  */
163%token BYTE_KEYWORD /* An alias of uint8.  */
164
165%token <sval> DOLLAR_VARIABLE
166
167%token <opcode> ASSIGN_MODIFY
168
169%left ','
170%left ABOVE_COMMA
171%right '=' ASSIGN_MODIFY
172%right '?'
173%left OROR
174%left ANDAND
175%left '|'
176%left '^'
177%left '&'
178%left ANDNOT
179%left EQUAL NOTEQUAL
180%left '<' '>' LEQ GEQ
181%left LSH RSH
182%left '@'
183%left '+' '-'
184%left '*' '/' '%'
185%right UNARY INCREMENT DECREMENT
186%right LEFT_ARROW '.' '[' '('
187
188
189%%
190
191start   :	exp1
192	|	type_exp
193	;
194
195type_exp:	type
196			{ write_exp_elt_opcode (pstate, OP_TYPE);
197			  write_exp_elt_type (pstate, $1);
198			  write_exp_elt_opcode (pstate, OP_TYPE); }
199	;
200
201/* Expressions, including the comma operator.  */
202exp1	:	exp
203	|	exp1 ',' exp
204			{ write_exp_elt_opcode (pstate, BINOP_COMMA); }
205	;
206
207/* Expressions, not including the comma operator.  */
208exp	:	'*' exp    %prec UNARY
209			{ write_exp_elt_opcode (pstate, UNOP_IND); }
210	;
211
212exp	:	'&' exp    %prec UNARY
213			{ write_exp_elt_opcode (pstate, UNOP_ADDR); }
214	;
215
216exp	:	'-' exp    %prec UNARY
217			{ write_exp_elt_opcode (pstate, UNOP_NEG); }
218	;
219
220exp	:	'+' exp    %prec UNARY
221			{ write_exp_elt_opcode (pstate, UNOP_PLUS); }
222	;
223
224exp	:	'!' exp    %prec UNARY
225			{ write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
226	;
227
228exp	:	'^' exp    %prec UNARY
229			{ write_exp_elt_opcode (pstate, UNOP_COMPLEMENT); }
230	;
231
232exp	:	exp INCREMENT    %prec UNARY
233			{ write_exp_elt_opcode (pstate, UNOP_POSTINCREMENT); }
234	;
235
236exp	:	exp DECREMENT    %prec UNARY
237			{ write_exp_elt_opcode (pstate, UNOP_POSTDECREMENT); }
238	;
239
240/* foo->bar is not in Go.  May want as a gdb extension.  Later.  */
241
242exp	:	exp '.' name_not_typename
243			{ write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
244			  write_exp_string (pstate, $3.stoken);
245			  write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
246	;
247
248exp	:	exp '.' name_not_typename COMPLETE
249			{ pstate->mark_struct_expression ();
250			  write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
251			  write_exp_string (pstate, $3.stoken);
252			  write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
253	;
254
255exp	:	exp '.' COMPLETE
256			{ struct stoken s;
257			  pstate->mark_struct_expression ();
258			  write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
259			  s.ptr = "";
260			  s.length = 0;
261			  write_exp_string (pstate, s);
262			  write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
263	;
264
265exp	:	exp '[' exp1 ']'
266			{ write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT); }
267	;
268
269exp	:	exp '('
270			/* This is to save the value of arglist_len
271			   being accumulated by an outer function call.  */
272			{ pstate->start_arglist (); }
273		arglist ')'	%prec LEFT_ARROW
274			{ write_exp_elt_opcode (pstate, OP_FUNCALL);
275			  write_exp_elt_longcst (pstate,
276						 pstate->end_arglist ());
277			  write_exp_elt_opcode (pstate, OP_FUNCALL); }
278	;
279
280lcurly	:	'{'
281			{ pstate->start_arglist (); }
282	;
283
284arglist	:
285	;
286
287arglist	:	exp
288			{ pstate->arglist_len = 1; }
289	;
290
291arglist	:	arglist ',' exp   %prec ABOVE_COMMA
292			{ pstate->arglist_len++; }
293	;
294
295rcurly	:	'}'
296			{ $$ = pstate->end_arglist () - 1; }
297	;
298
299exp	:	lcurly type rcurly exp  %prec UNARY
300			{ write_exp_elt_opcode (pstate, UNOP_MEMVAL);
301			  write_exp_elt_type (pstate, $2);
302			  write_exp_elt_opcode (pstate, UNOP_MEMVAL); }
303	;
304
305exp	:	type '(' exp ')'  %prec UNARY
306			{ write_exp_elt_opcode (pstate, UNOP_CAST);
307			  write_exp_elt_type (pstate, $1);
308			  write_exp_elt_opcode (pstate, UNOP_CAST); }
309	;
310
311exp	:	'(' exp1 ')'
312			{ }
313	;
314
315/* Binary operators in order of decreasing precedence.  */
316
317exp	:	exp '@' exp
318			{ write_exp_elt_opcode (pstate, BINOP_REPEAT); }
319	;
320
321exp	:	exp '*' exp
322			{ write_exp_elt_opcode (pstate, BINOP_MUL); }
323	;
324
325exp	:	exp '/' exp
326			{ write_exp_elt_opcode (pstate, BINOP_DIV); }
327	;
328
329exp	:	exp '%' exp
330			{ write_exp_elt_opcode (pstate, BINOP_REM); }
331	;
332
333exp	:	exp '+' exp
334			{ write_exp_elt_opcode (pstate, BINOP_ADD); }
335	;
336
337exp	:	exp '-' exp
338			{ write_exp_elt_opcode (pstate, BINOP_SUB); }
339	;
340
341exp	:	exp LSH exp
342			{ write_exp_elt_opcode (pstate, BINOP_LSH); }
343	;
344
345exp	:	exp RSH exp
346			{ write_exp_elt_opcode (pstate, BINOP_RSH); }
347	;
348
349exp	:	exp EQUAL exp
350			{ write_exp_elt_opcode (pstate, BINOP_EQUAL); }
351	;
352
353exp	:	exp NOTEQUAL exp
354			{ write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
355	;
356
357exp	:	exp LEQ exp
358			{ write_exp_elt_opcode (pstate, BINOP_LEQ); }
359	;
360
361exp	:	exp GEQ exp
362			{ write_exp_elt_opcode (pstate, BINOP_GEQ); }
363	;
364
365exp	:	exp '<' exp
366			{ write_exp_elt_opcode (pstate, BINOP_LESS); }
367	;
368
369exp	:	exp '>' exp
370			{ write_exp_elt_opcode (pstate, BINOP_GTR); }
371	;
372
373exp	:	exp '&' exp
374			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
375	;
376
377exp	:	exp '^' exp
378			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
379	;
380
381exp	:	exp '|' exp
382			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
383	;
384
385exp	:	exp ANDAND exp
386			{ write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
387	;
388
389exp	:	exp OROR exp
390			{ write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
391	;
392
393exp	:	exp '?' exp ':' exp	%prec '?'
394			{ write_exp_elt_opcode (pstate, TERNOP_COND); }
395	;
396
397exp	:	exp '=' exp
398			{ write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
399	;
400
401exp	:	exp ASSIGN_MODIFY exp
402			{ write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
403			  write_exp_elt_opcode (pstate, $2);
404			  write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
405	;
406
407exp	:	INT
408			{ write_exp_elt_opcode (pstate, OP_LONG);
409			  write_exp_elt_type (pstate, $1.type);
410			  write_exp_elt_longcst (pstate, (LONGEST)($1.val));
411			  write_exp_elt_opcode (pstate, OP_LONG); }
412	;
413
414exp	:	CHAR
415			{
416			  struct stoken_vector vec;
417			  vec.len = 1;
418			  vec.tokens = &$1;
419			  write_exp_string_vector (pstate, $1.type, &vec);
420			}
421	;
422
423exp	:	NAME_OR_INT
424			{ YYSTYPE val;
425			  parse_number (pstate, $1.stoken.ptr,
426					$1.stoken.length, 0, &val);
427			  write_exp_elt_opcode (pstate, OP_LONG);
428			  write_exp_elt_type (pstate, val.typed_val_int.type);
429			  write_exp_elt_longcst (pstate, (LONGEST)
430						 val.typed_val_int.val);
431			  write_exp_elt_opcode (pstate, OP_LONG);
432			}
433	;
434
435
436exp	:	FLOAT
437			{ write_exp_elt_opcode (pstate, OP_FLOAT);
438			  write_exp_elt_type (pstate, $1.type);
439			  write_exp_elt_floatcst (pstate, $1.val);
440			  write_exp_elt_opcode (pstate, OP_FLOAT); }
441	;
442
443exp	:	variable
444	;
445
446exp	:	DOLLAR_VARIABLE
447			{
448			  write_dollar_variable (pstate, $1);
449			}
450	;
451
452exp	:	SIZEOF_KEYWORD '(' type ')'  %prec UNARY
453			{
454			  /* TODO(dje): Go objects in structs.  */
455			  write_exp_elt_opcode (pstate, OP_LONG);
456			  /* TODO(dje): What's the right type here?  */
457			  write_exp_elt_type
458			    (pstate,
459			     parse_type (pstate)->builtin_unsigned_int);
460			  $3 = check_typedef ($3);
461			  write_exp_elt_longcst (pstate,
462						 (LONGEST) TYPE_LENGTH ($3));
463			  write_exp_elt_opcode (pstate, OP_LONG);
464			}
465	;
466
467exp	:	SIZEOF_KEYWORD  '(' exp ')'  %prec UNARY
468			{
469			  /* TODO(dje): Go objects in structs.  */
470			  write_exp_elt_opcode (pstate, UNOP_SIZEOF);
471			}
472
473string_exp:
474		STRING
475			{
476			  /* We copy the string here, and not in the
477			     lexer, to guarantee that we do not leak a
478			     string.  */
479			  /* Note that we NUL-terminate here, but just
480			     for convenience.  */
481			  struct typed_stoken *vec = XNEW (struct typed_stoken);
482			  $$.len = 1;
483			  $$.tokens = vec;
484
485			  vec->type = $1.type;
486			  vec->length = $1.length;
487			  vec->ptr = (char *) malloc ($1.length + 1);
488			  memcpy (vec->ptr, $1.ptr, $1.length + 1);
489			}
490
491	|	string_exp '+' STRING
492			{
493			  /* Note that we NUL-terminate here, but just
494			     for convenience.  */
495			  char *p;
496			  ++$$.len;
497			  $$.tokens = XRESIZEVEC (struct typed_stoken,
498						  $$.tokens, $$.len);
499
500			  p = (char *) malloc ($3.length + 1);
501			  memcpy (p, $3.ptr, $3.length + 1);
502
503			  $$.tokens[$$.len - 1].type = $3.type;
504			  $$.tokens[$$.len - 1].length = $3.length;
505			  $$.tokens[$$.len - 1].ptr = p;
506			}
507	;
508
509exp	:	string_exp  %prec ABOVE_COMMA
510			{
511			  int i;
512
513			  write_exp_string_vector (pstate, 0 /*always utf8*/,
514						   &$1);
515			  for (i = 0; i < $1.len; ++i)
516			    free ($1.tokens[i].ptr);
517			  free ($1.tokens);
518			}
519	;
520
521exp	:	TRUE_KEYWORD
522			{ write_exp_elt_opcode (pstate, OP_BOOL);
523			  write_exp_elt_longcst (pstate, (LONGEST) $1);
524			  write_exp_elt_opcode (pstate, OP_BOOL); }
525	;
526
527exp	:	FALSE_KEYWORD
528			{ write_exp_elt_opcode (pstate, OP_BOOL);
529			  write_exp_elt_longcst (pstate, (LONGEST) $1);
530			  write_exp_elt_opcode (pstate, OP_BOOL); }
531	;
532
533variable:	name_not_typename ENTRY
534			{ struct symbol *sym = $1.sym.symbol;
535
536			  if (sym == NULL
537			      || !SYMBOL_IS_ARGUMENT (sym)
538			      || !symbol_read_needs_frame (sym))
539			    error (_("@entry can be used only for function "
540				     "parameters, not for \"%s\""),
541				   copy_name ($1.stoken).c_str ());
542
543			  write_exp_elt_opcode (pstate, OP_VAR_ENTRY_VALUE);
544			  write_exp_elt_sym (pstate, sym);
545			  write_exp_elt_opcode (pstate, OP_VAR_ENTRY_VALUE);
546			}
547	;
548
549variable:	name_not_typename
550			{ struct block_symbol sym = $1.sym;
551
552			  if (sym.symbol)
553			    {
554			      if (symbol_read_needs_frame (sym.symbol))
555				pstate->block_tracker->update (sym);
556
557			      write_exp_elt_opcode (pstate, OP_VAR_VALUE);
558			      write_exp_elt_block (pstate, sym.block);
559			      write_exp_elt_sym (pstate, sym.symbol);
560			      write_exp_elt_opcode (pstate, OP_VAR_VALUE);
561			    }
562			  else if ($1.is_a_field_of_this)
563			    {
564			      /* TODO(dje): Can we get here?
565				 E.g., via a mix of c++ and go?  */
566			      gdb_assert_not_reached ("go with `this' field");
567			    }
568			  else
569			    {
570			      struct bound_minimal_symbol msymbol;
571			      std::string arg = copy_name ($1.stoken);
572
573			      msymbol =
574				lookup_bound_minimal_symbol (arg.c_str ());
575			      if (msymbol.minsym != NULL)
576				write_exp_msymbol (pstate, msymbol);
577			      else if (!have_full_symbols ()
578				       && !have_partial_symbols ())
579				error (_("No symbol table is loaded.  "
580				       "Use the \"file\" command."));
581			      else
582				error (_("No symbol \"%s\" in current context."),
583				       arg.c_str ());
584			    }
585			}
586	;
587
588/* TODO
589method_exp: PACKAGENAME '.' name '.' name
590			{
591			}
592	;
593*/
594
595type  /* Implements (approximately): [*] type-specifier */
596	:	'*' type
597			{ $$ = lookup_pointer_type ($2); }
598	|	TYPENAME
599			{ $$ = $1.type; }
600/*
601	|	STRUCT_KEYWORD name
602			{ $$ = lookup_struct (copy_name ($2),
603					      expression_context_block); }
604*/
605	|	BYTE_KEYWORD
606			{ $$ = builtin_go_type (pstate->gdbarch ())
607			    ->builtin_uint8; }
608	;
609
610/* TODO
611name	:	NAME { $$ = $1.stoken; }
612	|	TYPENAME { $$ = $1.stoken; }
613	|	NAME_OR_INT  { $$ = $1.stoken; }
614	;
615*/
616
617name_not_typename
618	:	NAME
619/* These would be useful if name_not_typename was useful, but it is just
620   a fake for "variable", so these cause reduce/reduce conflicts because
621   the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
622   =exp) or just an exp.  If name_not_typename was ever used in an lvalue
623   context where only a name could occur, this might be useful.
624	|	NAME_OR_INT
625*/
626	;
627
628%%
629
630/* Take care of parsing a number (anything that starts with a digit).
631   Set yylval and return the token type; update lexptr.
632   LEN is the number of characters in it.  */
633
634/* FIXME: Needs some error checking for the float case.  */
635/* FIXME(dje): IWBN to use c-exp.y's parse_number if we could.
636   That will require moving the guts into a function that we both call
637   as our YYSTYPE is different than c-exp.y's  */
638
639static int
640parse_number (struct parser_state *par_state,
641	      const char *p, int len, int parsed_float, YYSTYPE *putithere)
642{
643  /* FIXME: Shouldn't these be unsigned?  We don't deal with negative values
644     here, and we do kind of silly things like cast to unsigned.  */
645  LONGEST n = 0;
646  LONGEST prevn = 0;
647  ULONGEST un;
648
649  int i = 0;
650  int c;
651  int base = input_radix;
652  int unsigned_p = 0;
653
654  /* Number of "L" suffixes encountered.  */
655  int long_p = 0;
656
657  /* We have found a "L" or "U" suffix.  */
658  int found_suffix = 0;
659
660  ULONGEST high_bit;
661  struct type *signed_type;
662  struct type *unsigned_type;
663
664  if (parsed_float)
665    {
666      const struct builtin_go_type *builtin_go_types
667	= builtin_go_type (par_state->gdbarch ());
668
669      /* Handle suffixes: 'f' for float32, 'l' for long double.
670	 FIXME: This appears to be an extension -- do we want this?  */
671      if (len >= 1 && tolower (p[len - 1]) == 'f')
672	{
673	  putithere->typed_val_float.type
674	    = builtin_go_types->builtin_float32;
675	  len--;
676	}
677      else if (len >= 1 && tolower (p[len - 1]) == 'l')
678	{
679	  putithere->typed_val_float.type
680	    = parse_type (par_state)->builtin_long_double;
681	  len--;
682	}
683      /* Default type for floating-point literals is float64.  */
684      else
685        {
686	  putithere->typed_val_float.type
687	    = builtin_go_types->builtin_float64;
688        }
689
690      if (!parse_float (p, len,
691			putithere->typed_val_float.type,
692			putithere->typed_val_float.val))
693        return ERROR;
694      return FLOAT;
695    }
696
697  /* Handle base-switching prefixes 0x, 0t, 0d, 0.  */
698  if (p[0] == '0')
699    switch (p[1])
700      {
701      case 'x':
702      case 'X':
703	if (len >= 3)
704	  {
705	    p += 2;
706	    base = 16;
707	    len -= 2;
708	  }
709	break;
710
711      case 'b':
712      case 'B':
713	if (len >= 3)
714	  {
715	    p += 2;
716	    base = 2;
717	    len -= 2;
718	  }
719	break;
720
721      case 't':
722      case 'T':
723      case 'd':
724      case 'D':
725	if (len >= 3)
726	  {
727	    p += 2;
728	    base = 10;
729	    len -= 2;
730	  }
731	break;
732
733      default:
734	base = 8;
735	break;
736      }
737
738  while (len-- > 0)
739    {
740      c = *p++;
741      if (c >= 'A' && c <= 'Z')
742	c += 'a' - 'A';
743      if (c != 'l' && c != 'u')
744	n *= base;
745      if (c >= '0' && c <= '9')
746	{
747	  if (found_suffix)
748	    return ERROR;
749	  n += i = c - '0';
750	}
751      else
752	{
753	  if (base > 10 && c >= 'a' && c <= 'f')
754	    {
755	      if (found_suffix)
756		return ERROR;
757	      n += i = c - 'a' + 10;
758	    }
759	  else if (c == 'l')
760	    {
761	      ++long_p;
762	      found_suffix = 1;
763	    }
764	  else if (c == 'u')
765	    {
766	      unsigned_p = 1;
767	      found_suffix = 1;
768	    }
769	  else
770	    return ERROR;	/* Char not a digit */
771	}
772      if (i >= base)
773	return ERROR;		/* Invalid digit in this base.  */
774
775      /* Portably test for overflow (only works for nonzero values, so make
776	 a second check for zero).  FIXME: Can't we just make n and prevn
777	 unsigned and avoid this?  */
778      if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
779	unsigned_p = 1;		/* Try something unsigned.  */
780
781      /* Portably test for unsigned overflow.
782	 FIXME: This check is wrong; for example it doesn't find overflow
783	 on 0x123456789 when LONGEST is 32 bits.  */
784      if (c != 'l' && c != 'u' && n != 0)
785	{
786	  if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
787	    error (_("Numeric constant too large."));
788	}
789      prevn = n;
790    }
791
792  /* An integer constant is an int, a long, or a long long.  An L
793     suffix forces it to be long; an LL suffix forces it to be long
794     long.  If not forced to a larger size, it gets the first type of
795     the above that it fits in.  To figure out whether it fits, we
796     shift it right and see whether anything remains.  Note that we
797     can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
798     operation, because many compilers will warn about such a shift
799     (which always produces a zero result).  Sometimes gdbarch_int_bit
800     or gdbarch_long_bit will be that big, sometimes not.  To deal with
801     the case where it is we just always shift the value more than
802     once, with fewer bits each time.  */
803
804  un = (ULONGEST)n >> 2;
805  if (long_p == 0
806      && (un >> (gdbarch_int_bit (par_state->gdbarch ()) - 2)) == 0)
807    {
808      high_bit
809        = ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
810
811      /* A large decimal (not hex or octal) constant (between INT_MAX
812	 and UINT_MAX) is a long or unsigned long, according to ANSI,
813	 never an unsigned int, but this code treats it as unsigned
814	 int.  This probably should be fixed.  GCC gives a warning on
815	 such constants.  */
816
817      unsigned_type = parse_type (par_state)->builtin_unsigned_int;
818      signed_type = parse_type (par_state)->builtin_int;
819    }
820  else if (long_p <= 1
821	   && (un >> (gdbarch_long_bit (par_state->gdbarch ()) - 2)) == 0)
822    {
823      high_bit
824	= ((ULONGEST)1) << (gdbarch_long_bit (par_state->gdbarch ()) - 1);
825      unsigned_type = parse_type (par_state)->builtin_unsigned_long;
826      signed_type = parse_type (par_state)->builtin_long;
827    }
828  else
829    {
830      int shift;
831      if (sizeof (ULONGEST) * HOST_CHAR_BIT
832	  < gdbarch_long_long_bit (par_state->gdbarch ()))
833	/* A long long does not fit in a LONGEST.  */
834	shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
835      else
836	shift = (gdbarch_long_long_bit (par_state->gdbarch ()) - 1);
837      high_bit = (ULONGEST) 1 << shift;
838      unsigned_type = parse_type (par_state)->builtin_unsigned_long_long;
839      signed_type = parse_type (par_state)->builtin_long_long;
840    }
841
842   putithere->typed_val_int.val = n;
843
844   /* If the high bit of the worked out type is set then this number
845      has to be unsigned.  */
846
847   if (unsigned_p || (n & high_bit))
848     {
849       putithere->typed_val_int.type = unsigned_type;
850     }
851   else
852     {
853       putithere->typed_val_int.type = signed_type;
854     }
855
856   return INT;
857}
858
859/* Temporary obstack used for holding strings.  */
860static struct obstack tempbuf;
861static int tempbuf_init;
862
863/* Parse a string or character literal from TOKPTR.  The string or
864   character may be wide or unicode.  *OUTPTR is set to just after the
865   end of the literal in the input string.  The resulting token is
866   stored in VALUE.  This returns a token value, either STRING or
867   CHAR, depending on what was parsed.  *HOST_CHARS is set to the
868   number of host characters in the literal.  */
869
870static int
871parse_string_or_char (const char *tokptr, const char **outptr,
872		      struct typed_stoken *value, int *host_chars)
873{
874  int quote;
875
876  /* Build the gdb internal form of the input string in tempbuf.  Note
877     that the buffer is null byte terminated *only* for the
878     convenience of debugging gdb itself and printing the buffer
879     contents when the buffer contains no embedded nulls.  Gdb does
880     not depend upon the buffer being null byte terminated, it uses
881     the length string instead.  This allows gdb to handle C strings
882     (as well as strings in other languages) with embedded null
883     bytes */
884
885  if (!tempbuf_init)
886    tempbuf_init = 1;
887  else
888    obstack_free (&tempbuf, NULL);
889  obstack_init (&tempbuf);
890
891  /* Skip the quote.  */
892  quote = *tokptr;
893  ++tokptr;
894
895  *host_chars = 0;
896
897  while (*tokptr)
898    {
899      char c = *tokptr;
900      if (c == '\\')
901	{
902	  ++tokptr;
903	  *host_chars += c_parse_escape (&tokptr, &tempbuf);
904	}
905      else if (c == quote)
906	break;
907      else
908	{
909	  obstack_1grow (&tempbuf, c);
910	  ++tokptr;
911	  /* FIXME: this does the wrong thing with multi-byte host
912	     characters.  We could use mbrlen here, but that would
913	     make "set host-charset" a bit less useful.  */
914	  ++*host_chars;
915	}
916    }
917
918  if (*tokptr != quote)
919    {
920      if (quote == '"')
921	error (_("Unterminated string in expression."));
922      else
923	error (_("Unmatched single quote."));
924    }
925  ++tokptr;
926
927  value->type = C_STRING | (quote == '\'' ? C_CHAR : 0); /*FIXME*/
928  value->ptr = (char *) obstack_base (&tempbuf);
929  value->length = obstack_object_size (&tempbuf);
930
931  *outptr = tokptr;
932
933  return quote == '\'' ? CHAR : STRING;
934}
935
936struct token
937{
938  const char *oper;
939  int token;
940  enum exp_opcode opcode;
941};
942
943static const struct token tokentab3[] =
944  {
945    {">>=", ASSIGN_MODIFY, BINOP_RSH},
946    {"<<=", ASSIGN_MODIFY, BINOP_LSH},
947    /*{"&^=", ASSIGN_MODIFY, BINOP_BITWISE_ANDNOT}, TODO */
948    {"...", DOTDOTDOT, OP_NULL},
949  };
950
951static const struct token tokentab2[] =
952  {
953    {"+=", ASSIGN_MODIFY, BINOP_ADD},
954    {"-=", ASSIGN_MODIFY, BINOP_SUB},
955    {"*=", ASSIGN_MODIFY, BINOP_MUL},
956    {"/=", ASSIGN_MODIFY, BINOP_DIV},
957    {"%=", ASSIGN_MODIFY, BINOP_REM},
958    {"|=", ASSIGN_MODIFY, BINOP_BITWISE_IOR},
959    {"&=", ASSIGN_MODIFY, BINOP_BITWISE_AND},
960    {"^=", ASSIGN_MODIFY, BINOP_BITWISE_XOR},
961    {"++", INCREMENT, BINOP_END},
962    {"--", DECREMENT, BINOP_END},
963    /*{"->", RIGHT_ARROW, BINOP_END}, Doesn't exist in Go.  */
964    {"<-", LEFT_ARROW, BINOP_END},
965    {"&&", ANDAND, BINOP_END},
966    {"||", OROR, BINOP_END},
967    {"<<", LSH, BINOP_END},
968    {">>", RSH, BINOP_END},
969    {"==", EQUAL, BINOP_END},
970    {"!=", NOTEQUAL, BINOP_END},
971    {"<=", LEQ, BINOP_END},
972    {">=", GEQ, BINOP_END},
973    /*{"&^", ANDNOT, BINOP_END}, TODO */
974  };
975
976/* Identifier-like tokens.  */
977static const struct token ident_tokens[] =
978  {
979    {"true", TRUE_KEYWORD, OP_NULL},
980    {"false", FALSE_KEYWORD, OP_NULL},
981    {"nil", NIL_KEYWORD, OP_NULL},
982    {"const", CONST_KEYWORD, OP_NULL},
983    {"struct", STRUCT_KEYWORD, OP_NULL},
984    {"type", TYPE_KEYWORD, OP_NULL},
985    {"interface", INTERFACE_KEYWORD, OP_NULL},
986    {"chan", CHAN_KEYWORD, OP_NULL},
987    {"byte", BYTE_KEYWORD, OP_NULL}, /* An alias of uint8.  */
988    {"len", LEN_KEYWORD, OP_NULL},
989    {"cap", CAP_KEYWORD, OP_NULL},
990    {"new", NEW_KEYWORD, OP_NULL},
991    {"iota", IOTA_KEYWORD, OP_NULL},
992  };
993
994/* This is set if a NAME token appeared at the very end of the input
995   string, with no whitespace separating the name from the EOF.  This
996   is used only when parsing to do field name completion.  */
997static int saw_name_at_eof;
998
999/* This is set if the previously-returned token was a structure
1000   operator -- either '.' or ARROW.  This is used only when parsing to
1001   do field name completion.  */
1002static int last_was_structop;
1003
1004/* Depth of parentheses.  */
1005static int paren_depth;
1006
1007/* Read one token, getting characters through lexptr.  */
1008
1009static int
1010lex_one_token (struct parser_state *par_state)
1011{
1012  int c;
1013  int namelen;
1014  unsigned int i;
1015  const char *tokstart;
1016  int saw_structop = last_was_structop;
1017
1018  last_was_structop = 0;
1019
1020 retry:
1021
1022  par_state->prev_lexptr = par_state->lexptr;
1023
1024  tokstart = par_state->lexptr;
1025  /* See if it is a special token of length 3.  */
1026  for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1027    if (strncmp (tokstart, tokentab3[i].oper, 3) == 0)
1028      {
1029	par_state->lexptr += 3;
1030	yylval.opcode = tokentab3[i].opcode;
1031	return tokentab3[i].token;
1032      }
1033
1034  /* See if it is a special token of length 2.  */
1035  for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1036    if (strncmp (tokstart, tokentab2[i].oper, 2) == 0)
1037      {
1038	par_state->lexptr += 2;
1039	yylval.opcode = tokentab2[i].opcode;
1040	/* NOTE: -> doesn't exist in Go, so we don't need to watch for
1041	   setting last_was_structop here.  */
1042	return tokentab2[i].token;
1043      }
1044
1045  switch (c = *tokstart)
1046    {
1047    case 0:
1048      if (saw_name_at_eof)
1049	{
1050	  saw_name_at_eof = 0;
1051	  return COMPLETE;
1052	}
1053      else if (saw_structop)
1054	return COMPLETE;
1055      else
1056        return 0;
1057
1058    case ' ':
1059    case '\t':
1060    case '\n':
1061      par_state->lexptr++;
1062      goto retry;
1063
1064    case '[':
1065    case '(':
1066      paren_depth++;
1067      par_state->lexptr++;
1068      return c;
1069
1070    case ']':
1071    case ')':
1072      if (paren_depth == 0)
1073	return 0;
1074      paren_depth--;
1075      par_state->lexptr++;
1076      return c;
1077
1078    case ',':
1079      if (pstate->comma_terminates
1080          && paren_depth == 0)
1081	return 0;
1082      par_state->lexptr++;
1083      return c;
1084
1085    case '.':
1086      /* Might be a floating point number.  */
1087      if (par_state->lexptr[1] < '0' || par_state->lexptr[1] > '9')
1088	{
1089	  if (pstate->parse_completion)
1090	    last_was_structop = 1;
1091	  goto symbol;		/* Nope, must be a symbol. */
1092	}
1093      /* FALL THRU.  */
1094
1095    case '0':
1096    case '1':
1097    case '2':
1098    case '3':
1099    case '4':
1100    case '5':
1101    case '6':
1102    case '7':
1103    case '8':
1104    case '9':
1105      {
1106	/* It's a number.  */
1107	int got_dot = 0, got_e = 0, toktype;
1108	const char *p = tokstart;
1109	int hex = input_radix > 10;
1110
1111	if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1112	  {
1113	    p += 2;
1114	    hex = 1;
1115	  }
1116
1117	for (;; ++p)
1118	  {
1119	    /* This test includes !hex because 'e' is a valid hex digit
1120	       and thus does not indicate a floating point number when
1121	       the radix is hex.  */
1122	    if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1123	      got_dot = got_e = 1;
1124	    /* This test does not include !hex, because a '.' always indicates
1125	       a decimal floating point number regardless of the radix.  */
1126	    else if (!got_dot && *p == '.')
1127	      got_dot = 1;
1128	    else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1129		     && (*p == '-' || *p == '+'))
1130	      /* This is the sign of the exponent, not the end of the
1131		 number.  */
1132	      continue;
1133	    /* We will take any letters or digits.  parse_number will
1134	       complain if past the radix, or if L or U are not final.  */
1135	    else if ((*p < '0' || *p > '9')
1136		     && ((*p < 'a' || *p > 'z')
1137				  && (*p < 'A' || *p > 'Z')))
1138	      break;
1139	  }
1140	toktype = parse_number (par_state, tokstart, p - tokstart,
1141				got_dot|got_e, &yylval);
1142        if (toktype == ERROR)
1143	  {
1144	    char *err_copy = (char *) alloca (p - tokstart + 1);
1145
1146	    memcpy (err_copy, tokstart, p - tokstart);
1147	    err_copy[p - tokstart] = 0;
1148	    error (_("Invalid number \"%s\"."), err_copy);
1149	  }
1150	par_state->lexptr = p;
1151	return toktype;
1152      }
1153
1154    case '@':
1155      {
1156	const char *p = &tokstart[1];
1157	size_t len = strlen ("entry");
1158
1159	while (isspace (*p))
1160	  p++;
1161	if (strncmp (p, "entry", len) == 0 && !isalnum (p[len])
1162	    && p[len] != '_')
1163	  {
1164	    par_state->lexptr = &p[len];
1165	    return ENTRY;
1166	  }
1167      }
1168      /* FALLTHRU */
1169    case '+':
1170    case '-':
1171    case '*':
1172    case '/':
1173    case '%':
1174    case '|':
1175    case '&':
1176    case '^':
1177    case '~':
1178    case '!':
1179    case '<':
1180    case '>':
1181    case '?':
1182    case ':':
1183    case '=':
1184    case '{':
1185    case '}':
1186    symbol:
1187      par_state->lexptr++;
1188      return c;
1189
1190    case '\'':
1191    case '"':
1192    case '`':
1193      {
1194	int host_len;
1195	int result = parse_string_or_char (tokstart, &par_state->lexptr,
1196					   &yylval.tsval, &host_len);
1197	if (result == CHAR)
1198	  {
1199	    if (host_len == 0)
1200	      error (_("Empty character constant."));
1201	    else if (host_len > 2 && c == '\'')
1202	      {
1203		++tokstart;
1204		namelen = par_state->lexptr - tokstart - 1;
1205		goto tryname;
1206	      }
1207	    else if (host_len > 1)
1208	      error (_("Invalid character constant."));
1209	  }
1210	return result;
1211      }
1212    }
1213
1214  if (!(c == '_' || c == '$'
1215	|| (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1216    /* We must have come across a bad character (e.g. ';').  */
1217    error (_("Invalid character '%c' in expression."), c);
1218
1219  /* It's a name.  See how long it is.  */
1220  namelen = 0;
1221  for (c = tokstart[namelen];
1222       (c == '_' || c == '$' || (c >= '0' && c <= '9')
1223	|| (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));)
1224    {
1225      c = tokstart[++namelen];
1226    }
1227
1228  /* The token "if" terminates the expression and is NOT removed from
1229     the input stream.  It doesn't count if it appears in the
1230     expansion of a macro.  */
1231  if (namelen == 2
1232      && tokstart[0] == 'i'
1233      && tokstart[1] == 'f')
1234    {
1235      return 0;
1236    }
1237
1238  /* For the same reason (breakpoint conditions), "thread N"
1239     terminates the expression.  "thread" could be an identifier, but
1240     an identifier is never followed by a number without intervening
1241     punctuation.
1242     Handle abbreviations of these, similarly to
1243     breakpoint.c:find_condition_and_thread.
1244     TODO: Watch for "goroutine" here?  */
1245  if (namelen >= 1
1246      && strncmp (tokstart, "thread", namelen) == 0
1247      && (tokstart[namelen] == ' ' || tokstart[namelen] == '\t'))
1248    {
1249      const char *p = tokstart + namelen + 1;
1250
1251      while (*p == ' ' || *p == '\t')
1252	p++;
1253      if (*p >= '0' && *p <= '9')
1254	return 0;
1255    }
1256
1257  par_state->lexptr += namelen;
1258
1259  tryname:
1260
1261  yylval.sval.ptr = tokstart;
1262  yylval.sval.length = namelen;
1263
1264  /* Catch specific keywords.  */
1265  std::string copy = copy_name (yylval.sval);
1266  for (i = 0; i < sizeof (ident_tokens) / sizeof (ident_tokens[0]); i++)
1267    if (copy == ident_tokens[i].oper)
1268      {
1269	/* It is ok to always set this, even though we don't always
1270	   strictly need to.  */
1271	yylval.opcode = ident_tokens[i].opcode;
1272	return ident_tokens[i].token;
1273      }
1274
1275  if (*tokstart == '$')
1276    return DOLLAR_VARIABLE;
1277
1278  if (pstate->parse_completion && *par_state->lexptr == '\0')
1279    saw_name_at_eof = 1;
1280  return NAME;
1281}
1282
1283/* An object of this type is pushed on a FIFO by the "outer" lexer.  */
1284struct token_and_value
1285{
1286  int token;
1287  YYSTYPE value;
1288};
1289
1290/* A FIFO of tokens that have been read but not yet returned to the
1291   parser.  */
1292static std::vector<token_and_value> token_fifo;
1293
1294/* Non-zero if the lexer should return tokens from the FIFO.  */
1295static int popping;
1296
1297/* Temporary storage for yylex; this holds symbol names as they are
1298   built up.  */
1299static auto_obstack name_obstack;
1300
1301/* Build "package.name" in name_obstack.
1302   For convenience of the caller, the name is NUL-terminated,
1303   but the NUL is not included in the recorded length.  */
1304
1305static struct stoken
1306build_packaged_name (const char *package, int package_len,
1307		     const char *name, int name_len)
1308{
1309  struct stoken result;
1310
1311  name_obstack.clear ();
1312  obstack_grow (&name_obstack, package, package_len);
1313  obstack_grow_str (&name_obstack, ".");
1314  obstack_grow (&name_obstack, name, name_len);
1315  obstack_grow (&name_obstack, "", 1);
1316  result.ptr = (char *) obstack_base (&name_obstack);
1317  result.length = obstack_object_size (&name_obstack) - 1;
1318
1319  return result;
1320}
1321
1322/* Return non-zero if NAME is a package name.
1323   BLOCK is the scope in which to interpret NAME; this can be NULL
1324   to mean the global scope.  */
1325
1326static int
1327package_name_p (const char *name, const struct block *block)
1328{
1329  struct symbol *sym;
1330  struct field_of_this_result is_a_field_of_this;
1331
1332  sym = lookup_symbol (name, block, STRUCT_DOMAIN, &is_a_field_of_this).symbol;
1333
1334  if (sym
1335      && SYMBOL_CLASS (sym) == LOC_TYPEDEF
1336      && SYMBOL_TYPE (sym)->code () == TYPE_CODE_MODULE)
1337    return 1;
1338
1339  return 0;
1340}
1341
1342/* Classify a (potential) function in the "unsafe" package.
1343   We fold these into "keywords" to keep things simple, at least until
1344   something more complex is warranted.  */
1345
1346static int
1347classify_unsafe_function (struct stoken function_name)
1348{
1349  std::string copy = copy_name (function_name);
1350
1351  if (copy == "Sizeof")
1352    {
1353      yylval.sval = function_name;
1354      return SIZEOF_KEYWORD;
1355    }
1356
1357  error (_("Unknown function in `unsafe' package: %s"), copy.c_str ());
1358}
1359
1360/* Classify token(s) "name1.name2" where name1 is known to be a package.
1361   The contents of the token are in `yylval'.
1362   Updates yylval and returns the new token type.
1363
1364   The result is one of NAME, NAME_OR_INT, or TYPENAME.  */
1365
1366static int
1367classify_packaged_name (const struct block *block)
1368{
1369  struct block_symbol sym;
1370  struct field_of_this_result is_a_field_of_this;
1371
1372  std::string copy = copy_name (yylval.sval);
1373
1374  sym = lookup_symbol (copy.c_str (), block, VAR_DOMAIN, &is_a_field_of_this);
1375
1376  if (sym.symbol)
1377    {
1378      yylval.ssym.sym = sym;
1379      yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1380    }
1381
1382  return NAME;
1383}
1384
1385/* Classify a NAME token.
1386   The contents of the token are in `yylval'.
1387   Updates yylval and returns the new token type.
1388   BLOCK is the block in which lookups start; this can be NULL
1389   to mean the global scope.
1390
1391   The result is one of NAME, NAME_OR_INT, or TYPENAME.  */
1392
1393static int
1394classify_name (struct parser_state *par_state, const struct block *block)
1395{
1396  struct type *type;
1397  struct block_symbol sym;
1398  struct field_of_this_result is_a_field_of_this;
1399
1400  std::string copy = copy_name (yylval.sval);
1401
1402  /* Try primitive types first so they win over bad/weird debug info.  */
1403  type = language_lookup_primitive_type (par_state->language (),
1404					 par_state->gdbarch (),
1405					 copy.c_str ());
1406  if (type != NULL)
1407    {
1408      /* NOTE: We take advantage of the fact that yylval coming in was a
1409	 NAME, and that struct ttype is a compatible extension of struct
1410	 stoken, so yylval.tsym.stoken is already filled in.  */
1411      yylval.tsym.type = type;
1412      return TYPENAME;
1413    }
1414
1415  /* TODO: What about other types?  */
1416
1417  sym = lookup_symbol (copy.c_str (), block, VAR_DOMAIN, &is_a_field_of_this);
1418
1419  if (sym.symbol)
1420    {
1421      yylval.ssym.sym = sym;
1422      yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1423      return NAME;
1424    }
1425
1426  /* If we didn't find a symbol, look again in the current package.
1427     This is to, e.g., make "p global_var" work without having to specify
1428     the package name.  We intentionally only looks for objects in the
1429     current package.  */
1430
1431  {
1432    char *current_package_name = go_block_package_name (block);
1433
1434    if (current_package_name != NULL)
1435      {
1436	struct stoken sval =
1437	  build_packaged_name (current_package_name,
1438			       strlen (current_package_name),
1439			       copy.c_str (), copy.size ());
1440
1441	xfree (current_package_name);
1442	sym = lookup_symbol (sval.ptr, block, VAR_DOMAIN,
1443			     &is_a_field_of_this);
1444	if (sym.symbol)
1445	  {
1446	    yylval.ssym.stoken = sval;
1447	    yylval.ssym.sym = sym;
1448	    yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1449	    return NAME;
1450	  }
1451      }
1452  }
1453
1454  /* Input names that aren't symbols but ARE valid hex numbers, when
1455     the input radix permits them, can be names or numbers depending
1456     on the parse.  Note we support radixes > 16 here.  */
1457  if ((copy[0] >= 'a' && copy[0] < 'a' + input_radix - 10)
1458      || (copy[0] >= 'A' && copy[0] < 'A' + input_radix - 10))
1459    {
1460      YYSTYPE newlval;	/* Its value is ignored.  */
1461      int hextype = parse_number (par_state, copy.c_str (),
1462				  yylval.sval.length, 0, &newlval);
1463      if (hextype == INT)
1464	{
1465	  yylval.ssym.sym.symbol = NULL;
1466	  yylval.ssym.sym.block = NULL;
1467	  yylval.ssym.is_a_field_of_this = 0;
1468	  return NAME_OR_INT;
1469	}
1470    }
1471
1472  yylval.ssym.sym.symbol = NULL;
1473  yylval.ssym.sym.block = NULL;
1474  yylval.ssym.is_a_field_of_this = 0;
1475  return NAME;
1476}
1477
1478/* This is taken from c-exp.y mostly to get something working.
1479   The basic structure has been kept because we may yet need some of it.  */
1480
1481static int
1482yylex (void)
1483{
1484  token_and_value current, next;
1485
1486  if (popping && !token_fifo.empty ())
1487    {
1488      token_and_value tv = token_fifo[0];
1489      token_fifo.erase (token_fifo.begin ());
1490      yylval = tv.value;
1491      /* There's no need to fall through to handle package.name
1492	 as that can never happen here.  In theory.  */
1493      return tv.token;
1494    }
1495  popping = 0;
1496
1497  current.token = lex_one_token (pstate);
1498
1499  /* TODO: Need a way to force specifying name1 as a package.
1500     .name1.name2 ?  */
1501
1502  if (current.token != NAME)
1503    return current.token;
1504
1505  /* See if we have "name1 . name2".  */
1506
1507  current.value = yylval;
1508  next.token = lex_one_token (pstate);
1509  next.value = yylval;
1510
1511  if (next.token == '.')
1512    {
1513      token_and_value name2;
1514
1515      name2.token = lex_one_token (pstate);
1516      name2.value = yylval;
1517
1518      if (name2.token == NAME)
1519	{
1520	  /* Ok, we have "name1 . name2".  */
1521	  std::string copy = copy_name (current.value.sval);
1522
1523	  if (copy == "unsafe")
1524	    {
1525	      popping = 1;
1526	      return classify_unsafe_function (name2.value.sval);
1527	    }
1528
1529	  if (package_name_p (copy.c_str (), pstate->expression_context_block))
1530	    {
1531	      popping = 1;
1532	      yylval.sval = build_packaged_name (current.value.sval.ptr,
1533						 current.value.sval.length,
1534						 name2.value.sval.ptr,
1535						 name2.value.sval.length);
1536	      return classify_packaged_name (pstate->expression_context_block);
1537	    }
1538	}
1539
1540      token_fifo.push_back (next);
1541      token_fifo.push_back (name2);
1542    }
1543  else
1544    token_fifo.push_back (next);
1545
1546  /* If we arrive here we don't have a package-qualified name.  */
1547
1548  popping = 1;
1549  yylval = current.value;
1550  return classify_name (pstate, pstate->expression_context_block);
1551}
1552
1553int
1554go_parse (struct parser_state *par_state)
1555{
1556  /* Setting up the parser state.  */
1557  scoped_restore pstate_restore = make_scoped_restore (&pstate);
1558  gdb_assert (par_state != NULL);
1559  pstate = par_state;
1560
1561  scoped_restore restore_yydebug = make_scoped_restore (&yydebug,
1562							parser_debug);
1563
1564  /* Initialize some state used by the lexer.  */
1565  last_was_structop = 0;
1566  saw_name_at_eof = 0;
1567  paren_depth = 0;
1568
1569  token_fifo.clear ();
1570  popping = 0;
1571  name_obstack.clear ();
1572
1573  return yyparse ();
1574}
1575
1576static void
1577yyerror (const char *msg)
1578{
1579  if (pstate->prev_lexptr)
1580    pstate->lexptr = pstate->prev_lexptr;
1581
1582  error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);
1583}
1584