2002-04-18 Pierre Muller <muller@ics.u-strasbg.fr>
[external/binutils.git] / gdb / p-exp.y
1 /* YACC parser for Pascal expressions, for GDB.
2    Copyright 2000
3    Free Software Foundation, Inc.
4
5 This file is part of GDB.
6
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
20
21 /* This file is derived from c-exp.y */
22
23 /* Parse a Pascal expression from text in a string,
24    and return the result as a  struct expression  pointer.
25    That structure contains arithmetic operations in reverse polish,
26    with constants represented by operations that are followed by special data.
27    See expression.h for the details of the format.
28    What is important here is that it can be built up sequentially
29    during the process of parsing; the lower levels of the tree always
30    come first in the result.
31
32    Note that malloc's and realloc's in this file are transformed to
33    xmalloc and xrealloc respectively by the same sed command in the
34    makefile that remaps any other malloc/realloc inserted by the parser
35    generator.  Doing this with #defines and trying to control the interaction
36    with include files (<malloc.h> and <stdlib.h> for example) just became
37    too messy, particularly when such includes can be inserted at random
38    times by the parser generator.  */
39
40 /* Known bugs or limitations:
41     - pascal string operations are not supported at all.
42     - there are some problems with boolean types.
43     - Pascal type hexadecimal constants are not supported
44       because they conflict with the internal variables format.
45    Probably also lots of other problems, less well defined PM */
46 %{
47
48 #include "defs.h"
49 #include "gdb_string.h"
50 #include <ctype.h>
51 #include "expression.h"
52 #include "value.h"
53 #include "parser-defs.h"
54 #include "language.h"
55 #include "p-lang.h"
56 #include "bfd.h" /* Required by objfiles.h.  */
57 #include "symfile.h" /* Required by objfiles.h.  */
58 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
59
60 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
61    as well as gratuitiously global symbol names, so we can have multiple
62    yacc generated parsers in gdb.  Note that these are only the variables
63    produced by yacc.  If other parser generators (bison, byacc, etc) produce
64    additional global names that conflict at link time, then those parser
65    generators need to be fixed instead of adding those names to this list. */
66
67 #define yymaxdepth pascal_maxdepth
68 #define yyparse pascal_parse
69 #define yylex   pascal_lex
70 #define yyerror pascal_error
71 #define yylval  pascal_lval
72 #define yychar  pascal_char
73 #define yydebug pascal_debug
74 #define yypact  pascal_pact     
75 #define yyr1    pascal_r1                       
76 #define yyr2    pascal_r2                       
77 #define yydef   pascal_def              
78 #define yychk   pascal_chk              
79 #define yypgo   pascal_pgo              
80 #define yyact   pascal_act
81 #define yyexca  pascal_exca
82 #define yyerrflag pascal_errflag
83 #define yynerrs pascal_nerrs
84 #define yyps    pascal_ps
85 #define yypv    pascal_pv
86 #define yys     pascal_s
87 #define yy_yys  pascal_yys
88 #define yystate pascal_state
89 #define yytmp   pascal_tmp
90 #define yyv     pascal_v
91 #define yy_yyv  pascal_yyv
92 #define yyval   pascal_val
93 #define yylloc  pascal_lloc
94 #define yyreds  pascal_reds             /* With YYDEBUG defined */
95 #define yytoks  pascal_toks             /* With YYDEBUG defined */
96 #define yylhs   pascal_yylhs
97 #define yylen   pascal_yylen
98 #define yydefred pascal_yydefred
99 #define yydgoto pascal_yydgoto
100 #define yysindex pascal_yysindex
101 #define yyrindex pascal_yyrindex
102 #define yygindex pascal_yygindex
103 #define yytable  pascal_yytable
104 #define yycheck  pascal_yycheck
105
106 #ifndef YYDEBUG
107 #define YYDEBUG 0               /* Default to no yydebug support */
108 #endif
109
110 int yyparse (void);
111
112 static int yylex (void);
113
114 void
115 yyerror (char *);
116
117 static char * uptok (char *, int);
118 %}
119
120 /* Although the yacc "value" of an expression is not used,
121    since the result is stored in the structure being created,
122    other node types do have values.  */
123
124 %union
125   {
126     LONGEST lval;
127     struct {
128       LONGEST val;
129       struct type *type;
130     } typed_val_int;
131     struct {
132       DOUBLEST dval;
133       struct type *type;
134     } typed_val_float;
135     struct symbol *sym;
136     struct type *tval;
137     struct stoken sval;
138     struct ttype tsym;
139     struct symtoken ssym;
140     int voidval;
141     struct block *bval;
142     enum exp_opcode opcode;
143     struct internalvar *ivar;
144
145     struct type **tvec;
146     int *ivec;
147   }
148
149 %{
150 /* YYSTYPE gets defined by %union */
151 static int
152 parse_number (char *, int, int, YYSTYPE *);
153 %}
154
155 %type <voidval> exp exp1 type_exp start variable qualified_name
156 %type <tval> type typebase
157 /* %type <bval> block */
158
159 /* Fancy type parsing.  */
160 %type <tval> ptype
161
162 %token <typed_val_int> INT
163 %token <typed_val_float> FLOAT
164
165 /* Both NAME and TYPENAME tokens represent symbols in the input,
166    and both convey their data as strings.
167    But a TYPENAME is a string that happens to be defined as a typedef
168    or builtin type name (such as int or char)
169    and a NAME is any other symbol.
170    Contexts where this distinction is not important can use the
171    nonterminal "name", which matches either NAME or TYPENAME.  */
172
173 %token <sval> STRING
174 %token <ssym> NAME /* BLOCKNAME defined below to give it higher precedence. */
175 %token <tsym> TYPENAME
176 %type <sval> name
177 %type <ssym> name_not_typename
178
179 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
180    but which would parse as a valid number in the current input radix.
181    E.g. "c" when input_radix==16.  Depending on the parse, it will be
182    turned into a name or into a number.  */
183
184 %token <ssym> NAME_OR_INT
185
186 %token STRUCT CLASS SIZEOF COLONCOLON
187 %token ERROR
188
189 /* Special type cases, put in to allow the parser to distinguish different
190    legal basetypes.  */
191
192 %token <voidval> VARIABLE
193
194
195 /* Object pascal */
196 %token THIS
197 %token <lval> TRUE FALSE
198
199 %left ','
200 %left ABOVE_COMMA
201 %right ASSIGN
202 %left NOT
203 %left OR
204 %left XOR
205 %left ANDAND
206 %left '=' NOTEQUAL
207 %left '<' '>' LEQ GEQ
208 %left LSH RSH DIV MOD
209 %left '@'
210 %left '+' '-'
211 %left '*' '/'
212 %right UNARY INCREMENT DECREMENT
213 %right ARROW '.' '[' '('
214 %left '^'
215 %token <ssym> BLOCKNAME
216 %type <bval> block
217 %left COLONCOLON
218
219 \f
220 %%
221
222 start   :       exp1
223         |       type_exp
224         ;
225
226 type_exp:       type
227                         { write_exp_elt_opcode(OP_TYPE);
228                           write_exp_elt_type($1);
229                           write_exp_elt_opcode(OP_TYPE);}
230         ;
231
232 /* Expressions, including the comma operator.  */
233 exp1    :       exp
234         |       exp1 ',' exp
235                         { write_exp_elt_opcode (BINOP_COMMA); }
236         ;
237
238 /* Expressions, not including the comma operator.  */
239 exp     :       exp '^'   %prec UNARY
240                         { write_exp_elt_opcode (UNOP_IND); }
241
242 exp     :       '@' exp    %prec UNARY
243                         { write_exp_elt_opcode (UNOP_ADDR); }
244
245 exp     :       '-' exp    %prec UNARY
246                         { write_exp_elt_opcode (UNOP_NEG); }
247         ;
248
249 exp     :       NOT exp    %prec UNARY
250                         { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
251         ;
252
253 exp     :       INCREMENT '(' exp ')'   %prec UNARY
254                         { write_exp_elt_opcode (UNOP_PREINCREMENT); }
255         ;
256
257 exp     :       DECREMENT  '(' exp ')'   %prec UNARY
258                         { write_exp_elt_opcode (UNOP_PREDECREMENT); }
259         ;
260
261 exp     :       exp '.' name
262                         { write_exp_elt_opcode (STRUCTOP_STRUCT);
263                           write_exp_string ($3);
264                           write_exp_elt_opcode (STRUCTOP_STRUCT); }
265         ;
266
267 exp     :       exp '[' exp1 ']'
268                         { write_exp_elt_opcode (BINOP_SUBSCRIPT); }
269         ;
270
271 exp     :       exp '('
272                         /* This is to save the value of arglist_len
273                            being accumulated by an outer function call.  */
274                         { start_arglist (); }
275                 arglist ')'     %prec ARROW
276                         { write_exp_elt_opcode (OP_FUNCALL);
277                           write_exp_elt_longcst ((LONGEST) end_arglist ());
278                           write_exp_elt_opcode (OP_FUNCALL); }
279         ;
280
281 arglist :
282          | exp
283                         { arglist_len = 1; }
284          | arglist ',' exp   %prec ABOVE_COMMA
285                         { arglist_len++; }
286         ;
287
288 exp     :       type '(' exp ')' %prec UNARY
289                         { write_exp_elt_opcode (UNOP_CAST);
290                           write_exp_elt_type ($1);
291                           write_exp_elt_opcode (UNOP_CAST); }
292         ;
293
294 exp     :       '(' exp1 ')'
295                         { }
296         ;
297
298 /* Binary operators in order of decreasing precedence.  */
299
300 exp     :       exp '*' exp
301                         { write_exp_elt_opcode (BINOP_MUL); }
302         ;
303
304 exp     :       exp '/' exp
305                         { write_exp_elt_opcode (BINOP_DIV); }
306         ;
307
308 exp     :       exp DIV exp
309                         { write_exp_elt_opcode (BINOP_INTDIV); }
310         ;
311
312 exp     :       exp MOD exp
313                         { write_exp_elt_opcode (BINOP_REM); }
314         ;
315
316 exp     :       exp '+' exp
317                         { write_exp_elt_opcode (BINOP_ADD); }
318         ;
319
320 exp     :       exp '-' exp
321                         { write_exp_elt_opcode (BINOP_SUB); }
322         ;
323
324 exp     :       exp LSH exp
325                         { write_exp_elt_opcode (BINOP_LSH); }
326         ;
327
328 exp     :       exp RSH exp
329                         { write_exp_elt_opcode (BINOP_RSH); }
330         ;
331
332 exp     :       exp '=' exp
333                         { write_exp_elt_opcode (BINOP_EQUAL); }
334         ;
335
336 exp     :       exp NOTEQUAL exp
337                         { write_exp_elt_opcode (BINOP_NOTEQUAL); }
338         ;
339
340 exp     :       exp LEQ exp
341                         { write_exp_elt_opcode (BINOP_LEQ); }
342         ;
343
344 exp     :       exp GEQ exp
345                         { write_exp_elt_opcode (BINOP_GEQ); }
346         ;
347
348 exp     :       exp '<' exp
349                         { write_exp_elt_opcode (BINOP_LESS); }
350         ;
351
352 exp     :       exp '>' exp
353                         { write_exp_elt_opcode (BINOP_GTR); }
354         ;
355
356 exp     :       exp ANDAND exp
357                         { write_exp_elt_opcode (BINOP_BITWISE_AND); }
358         ;
359
360 exp     :       exp XOR exp
361                         { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
362         ;
363
364 exp     :       exp OR exp
365                         { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
366         ;
367
368 exp     :       exp ASSIGN exp
369                         { write_exp_elt_opcode (BINOP_ASSIGN); }
370         ;
371
372 exp     :       TRUE
373                         { write_exp_elt_opcode (OP_BOOL);
374                           write_exp_elt_longcst ((LONGEST) $1);
375                           write_exp_elt_opcode (OP_BOOL); }
376         ;
377
378 exp     :       FALSE
379                         { write_exp_elt_opcode (OP_BOOL);
380                           write_exp_elt_longcst ((LONGEST) $1);
381                           write_exp_elt_opcode (OP_BOOL); }
382         ;
383
384 exp     :       INT
385                         { write_exp_elt_opcode (OP_LONG);
386                           write_exp_elt_type ($1.type);
387                           write_exp_elt_longcst ((LONGEST)($1.val));
388                           write_exp_elt_opcode (OP_LONG); }
389         ;
390
391 exp     :       NAME_OR_INT
392                         { YYSTYPE val;
393                           parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
394                           write_exp_elt_opcode (OP_LONG);
395                           write_exp_elt_type (val.typed_val_int.type);
396                           write_exp_elt_longcst ((LONGEST)val.typed_val_int.val);
397                           write_exp_elt_opcode (OP_LONG);
398                         }
399         ;
400
401
402 exp     :       FLOAT
403                         { write_exp_elt_opcode (OP_DOUBLE);
404                           write_exp_elt_type ($1.type);
405                           write_exp_elt_dblcst ($1.dval);
406                           write_exp_elt_opcode (OP_DOUBLE); }
407         ;
408
409 exp     :       variable
410         ;
411
412 exp     :       VARIABLE
413                         /* Already written by write_dollar_variable. */
414         ;
415
416 exp     :       SIZEOF '(' type ')'     %prec UNARY
417                         { write_exp_elt_opcode (OP_LONG);
418                           write_exp_elt_type (builtin_type_int);
419                           CHECK_TYPEDEF ($3);
420                           write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
421                           write_exp_elt_opcode (OP_LONG); }
422         ;
423
424 exp     :       STRING
425                         { /* C strings are converted into array constants with
426                              an explicit null byte added at the end.  Thus
427                              the array upper bound is the string length.
428                              There is no such thing in C as a completely empty
429                              string. */
430                           char *sp = $1.ptr; int count = $1.length;
431                           while (count-- > 0)
432                             {
433                               write_exp_elt_opcode (OP_LONG);
434                               write_exp_elt_type (builtin_type_char);
435                               write_exp_elt_longcst ((LONGEST)(*sp++));
436                               write_exp_elt_opcode (OP_LONG);
437                             }
438                           write_exp_elt_opcode (OP_LONG);
439                           write_exp_elt_type (builtin_type_char);
440                           write_exp_elt_longcst ((LONGEST)'\0');
441                           write_exp_elt_opcode (OP_LONG);
442                           write_exp_elt_opcode (OP_ARRAY);
443                           write_exp_elt_longcst ((LONGEST) 0);
444                           write_exp_elt_longcst ((LONGEST) ($1.length));
445                           write_exp_elt_opcode (OP_ARRAY); }
446         ;
447
448 /* Object pascal  */
449 exp     :       THIS
450                         { write_exp_elt_opcode (OP_THIS);
451                           write_exp_elt_opcode (OP_THIS); }
452         ;
453
454 /* end of object pascal.  */
455
456 block   :       BLOCKNAME
457                         {
458                           if ($1.sym != 0)
459                               $$ = SYMBOL_BLOCK_VALUE ($1.sym);
460                           else
461                             {
462                               struct symtab *tem =
463                                   lookup_symtab (copy_name ($1.stoken));
464                               if (tem)
465                                 $$ = BLOCKVECTOR_BLOCK (BLOCKVECTOR (tem), STATIC_BLOCK);
466                               else
467                                 error ("No file or function \"%s\".",
468                                        copy_name ($1.stoken));
469                             }
470                         }
471         ;
472
473 block   :       block COLONCOLON name
474                         { struct symbol *tem
475                             = lookup_symbol (copy_name ($3), $1,
476                                              VAR_NAMESPACE, (int *) NULL,
477                                              (struct symtab **) NULL);
478                           if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
479                             error ("No function \"%s\" in specified context.",
480                                    copy_name ($3));
481                           $$ = SYMBOL_BLOCK_VALUE (tem); }
482         ;
483
484 variable:       block COLONCOLON name
485                         { struct symbol *sym;
486                           sym = lookup_symbol (copy_name ($3), $1,
487                                                VAR_NAMESPACE, (int *) NULL,
488                                                (struct symtab **) NULL);
489                           if (sym == 0)
490                             error ("No symbol \"%s\" in specified context.",
491                                    copy_name ($3));
492
493                           write_exp_elt_opcode (OP_VAR_VALUE);
494                           /* block_found is set by lookup_symbol.  */
495                           write_exp_elt_block (block_found);
496                           write_exp_elt_sym (sym);
497                           write_exp_elt_opcode (OP_VAR_VALUE); }
498         ;
499
500 qualified_name: typebase COLONCOLON name
501                         {
502                           struct type *type = $1;
503                           if (TYPE_CODE (type) != TYPE_CODE_STRUCT
504                               && TYPE_CODE (type) != TYPE_CODE_UNION)
505                             error ("`%s' is not defined as an aggregate type.",
506                                    TYPE_NAME (type));
507
508                           write_exp_elt_opcode (OP_SCOPE);
509                           write_exp_elt_type (type);
510                           write_exp_string ($3);
511                           write_exp_elt_opcode (OP_SCOPE);
512                         }
513         ;
514
515 variable:       qualified_name
516         |       COLONCOLON name
517                         {
518                           char *name = copy_name ($2);
519                           struct symbol *sym;
520                           struct minimal_symbol *msymbol;
521
522                           sym =
523                             lookup_symbol (name, (const struct block *) NULL,
524                                            VAR_NAMESPACE, (int *) NULL,
525                                            (struct symtab **) NULL);
526                           if (sym)
527                             {
528                               write_exp_elt_opcode (OP_VAR_VALUE);
529                               write_exp_elt_block (NULL);
530                               write_exp_elt_sym (sym);
531                               write_exp_elt_opcode (OP_VAR_VALUE);
532                               break;
533                             }
534
535                           msymbol = lookup_minimal_symbol (name, NULL, NULL);
536                           if (msymbol != NULL)
537                             {
538                               write_exp_msymbol (msymbol,
539                                                  lookup_function_type (builtin_type_int),
540                                                  builtin_type_int);
541                             }
542                           else
543                             if (!have_full_symbols () && !have_partial_symbols ())
544                               error ("No symbol table is loaded.  Use the \"file\" command.");
545                             else
546                               error ("No symbol \"%s\" in current context.", name);
547                         }
548         ;
549
550 variable:       name_not_typename
551                         { struct symbol *sym = $1.sym;
552
553                           if (sym)
554                             {
555                               if (symbol_read_needs_frame (sym))
556                                 {
557                                   if (innermost_block == 0 ||
558                                       contained_in (block_found,
559                                                     innermost_block))
560                                     innermost_block = block_found;
561                                 }
562
563                               write_exp_elt_opcode (OP_VAR_VALUE);
564                               /* We want to use the selected frame, not
565                                  another more inner frame which happens to
566                                  be in the same block.  */
567                               write_exp_elt_block (NULL);
568                               write_exp_elt_sym (sym);
569                               write_exp_elt_opcode (OP_VAR_VALUE);
570                             }
571                           else if ($1.is_a_field_of_this)
572                             {
573                               /* Object pascal: it hangs off of `this'.  Must
574                                  not inadvertently convert from a method call
575                                  to data ref.  */
576                               if (innermost_block == 0 ||
577                                   contained_in (block_found, innermost_block))
578                                 innermost_block = block_found;
579                               write_exp_elt_opcode (OP_THIS);
580                               write_exp_elt_opcode (OP_THIS);
581                               write_exp_elt_opcode (STRUCTOP_PTR);
582                               write_exp_string ($1.stoken);
583                               write_exp_elt_opcode (STRUCTOP_PTR);
584                             }
585                           else
586                             {
587                               struct minimal_symbol *msymbol;
588                               register char *arg = copy_name ($1.stoken);
589
590                               msymbol =
591                                 lookup_minimal_symbol (arg, NULL, NULL);
592                               if (msymbol != NULL)
593                                 {
594                                   write_exp_msymbol (msymbol,
595                                                      lookup_function_type (builtin_type_int),
596                                                      builtin_type_int);
597                                 }
598                               else if (!have_full_symbols () && !have_partial_symbols ())
599                                 error ("No symbol table is loaded.  Use the \"file\" command.");
600                               else
601                                 error ("No symbol \"%s\" in current context.",
602                                        copy_name ($1.stoken));
603                             }
604                         }
605         ;
606
607
608 ptype   :       typebase
609         ;
610
611 /* We used to try to recognize more pointer to member types here, but
612    that didn't work (shift/reduce conflicts meant that these rules never
613    got executed).  The problem is that
614      int (foo::bar::baz::bizzle)
615    is a function type but
616      int (foo::bar::baz::bizzle::*)
617    is a pointer to member type.  Stroustrup loses again!  */
618
619 type    :       ptype
620         |       typebase COLONCOLON '*'
621                         { $$ = lookup_member_type (builtin_type_int, $1); }
622         ;
623
624 typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
625         :       TYPENAME
626                         { $$ = $1.type; }
627         |       STRUCT name
628                         { $$ = lookup_struct (copy_name ($2),
629                                               expression_context_block); }
630         |       CLASS name
631                         { $$ = lookup_struct (copy_name ($2),
632                                               expression_context_block); }
633         /* "const" and "volatile" are curently ignored.  A type qualifier
634            after the type is handled in the ptype rule.  I think these could
635            be too.  */
636         ;
637
638 name    :       NAME { $$ = $1.stoken; }
639         |       BLOCKNAME { $$ = $1.stoken; }
640         |       TYPENAME { $$ = $1.stoken; }
641         |       NAME_OR_INT  { $$ = $1.stoken; }
642         ;
643
644 name_not_typename :     NAME
645         |       BLOCKNAME
646 /* These would be useful if name_not_typename was useful, but it is just
647    a fake for "variable", so these cause reduce/reduce conflicts because
648    the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
649    =exp) or just an exp.  If name_not_typename was ever used in an lvalue
650    context where only a name could occur, this might be useful.
651         |       NAME_OR_INT
652  */
653         ;
654
655 %%
656
657 /* Take care of parsing a number (anything that starts with a digit).
658    Set yylval and return the token type; update lexptr.
659    LEN is the number of characters in it.  */
660
661 /*** Needs some error checking for the float case ***/
662
663 static int
664 parse_number (p, len, parsed_float, putithere)
665      register char *p;
666      register int len;
667      int parsed_float;
668      YYSTYPE *putithere;
669 {
670   /* FIXME: Shouldn't these be unsigned?  We don't deal with negative values
671      here, and we do kind of silly things like cast to unsigned.  */
672   register LONGEST n = 0;
673   register LONGEST prevn = 0;
674   ULONGEST un;
675
676   register int i = 0;
677   register int c;
678   register int base = input_radix;
679   int unsigned_p = 0;
680
681   /* Number of "L" suffixes encountered.  */
682   int long_p = 0;
683
684   /* We have found a "L" or "U" suffix.  */
685   int found_suffix = 0;
686
687   ULONGEST high_bit;
688   struct type *signed_type;
689   struct type *unsigned_type;
690
691   if (parsed_float)
692     {
693       /* It's a float since it contains a point or an exponent.  */
694       char c;
695       int num = 0;      /* number of tokens scanned by scanf */
696       char saved_char = p[len];
697
698       p[len] = 0;       /* null-terminate the token */
699       if (sizeof (putithere->typed_val_float.dval) <= sizeof (float))
700         num = sscanf (p, "%g%c", (float *) &putithere->typed_val_float.dval,&c);
701       else if (sizeof (putithere->typed_val_float.dval) <= sizeof (double))
702         num = sscanf (p, "%lg%c", (double *) &putithere->typed_val_float.dval,&c);
703       else
704         {
705 #ifdef SCANF_HAS_LONG_DOUBLE
706           num = sscanf (p, "%Lg%c", &putithere->typed_val_float.dval,&c);
707 #else
708           /* Scan it into a double, then assign it to the long double.
709              This at least wins with values representable in the range
710              of doubles. */
711           double temp;
712           num = sscanf (p, "%lg%c", &temp,&c);
713           putithere->typed_val_float.dval = temp;
714 #endif
715         }
716       p[len] = saved_char;      /* restore the input stream */
717       if (num != 1)             /* check scanf found ONLY a float ... */
718         return ERROR;
719       /* See if it has `f' or `l' suffix (float or long double).  */
720
721       c = tolower (p[len - 1]);
722
723       if (c == 'f')
724         putithere->typed_val_float.type = builtin_type_float;
725       else if (c == 'l')
726         putithere->typed_val_float.type = builtin_type_long_double;
727       else if (isdigit (c) || c == '.')
728         putithere->typed_val_float.type = builtin_type_double;
729       else
730         return ERROR;
731
732       return FLOAT;
733     }
734
735   /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
736   if (p[0] == '0')
737     switch (p[1])
738       {
739       case 'x':
740       case 'X':
741         if (len >= 3)
742           {
743             p += 2;
744             base = 16;
745             len -= 2;
746           }
747         break;
748
749       case 't':
750       case 'T':
751       case 'd':
752       case 'D':
753         if (len >= 3)
754           {
755             p += 2;
756             base = 10;
757             len -= 2;
758           }
759         break;
760
761       default:
762         base = 8;
763         break;
764       }
765
766   while (len-- > 0)
767     {
768       c = *p++;
769       if (c >= 'A' && c <= 'Z')
770         c += 'a' - 'A';
771       if (c != 'l' && c != 'u')
772         n *= base;
773       if (c >= '0' && c <= '9')
774         {
775           if (found_suffix)
776             return ERROR;
777           n += i = c - '0';
778         }
779       else
780         {
781           if (base > 10 && c >= 'a' && c <= 'f')
782             {
783               if (found_suffix)
784                 return ERROR;
785               n += i = c - 'a' + 10;
786             }
787           else if (c == 'l')
788             {
789               ++long_p;
790               found_suffix = 1;
791             }
792           else if (c == 'u')
793             {
794               unsigned_p = 1;
795               found_suffix = 1;
796             }
797           else
798             return ERROR;       /* Char not a digit */
799         }
800       if (i >= base)
801         return ERROR;           /* Invalid digit in this base */
802
803       /* Portably test for overflow (only works for nonzero values, so make
804          a second check for zero).  FIXME: Can't we just make n and prevn
805          unsigned and avoid this?  */
806       if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
807         unsigned_p = 1;         /* Try something unsigned */
808
809       /* Portably test for unsigned overflow.
810          FIXME: This check is wrong; for example it doesn't find overflow
811          on 0x123456789 when LONGEST is 32 bits.  */
812       if (c != 'l' && c != 'u' && n != 0)
813         {       
814           if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
815             error ("Numeric constant too large.");
816         }
817       prevn = n;
818     }
819
820   /* An integer constant is an int, a long, or a long long.  An L
821      suffix forces it to be long; an LL suffix forces it to be long
822      long.  If not forced to a larger size, it gets the first type of
823      the above that it fits in.  To figure out whether it fits, we
824      shift it right and see whether anything remains.  Note that we
825      can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
826      operation, because many compilers will warn about such a shift
827      (which always produces a zero result).  Sometimes TARGET_INT_BIT
828      or TARGET_LONG_BIT will be that big, sometimes not.  To deal with
829      the case where it is we just always shift the value more than
830      once, with fewer bits each time.  */
831
832   un = (ULONGEST)n >> 2;
833   if (long_p == 0
834       && (un >> (TARGET_INT_BIT - 2)) == 0)
835     {
836       high_bit = ((ULONGEST)1) << (TARGET_INT_BIT-1);
837
838       /* A large decimal (not hex or octal) constant (between INT_MAX
839          and UINT_MAX) is a long or unsigned long, according to ANSI,
840          never an unsigned int, but this code treats it as unsigned
841          int.  This probably should be fixed.  GCC gives a warning on
842          such constants.  */
843
844       unsigned_type = builtin_type_unsigned_int;
845       signed_type = builtin_type_int;
846     }
847   else if (long_p <= 1
848            && (un >> (TARGET_LONG_BIT - 2)) == 0)
849     {
850       high_bit = ((ULONGEST)1) << (TARGET_LONG_BIT-1);
851       unsigned_type = builtin_type_unsigned_long;
852       signed_type = builtin_type_long;
853     }
854   else
855     {
856       int shift;
857       if (sizeof (ULONGEST) * HOST_CHAR_BIT < TARGET_LONG_LONG_BIT)
858         /* A long long does not fit in a LONGEST.  */
859         shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
860       else
861         shift = (TARGET_LONG_LONG_BIT - 1);
862       high_bit = (ULONGEST) 1 << shift;
863       unsigned_type = builtin_type_unsigned_long_long;
864       signed_type = builtin_type_long_long;
865     }
866
867    putithere->typed_val_int.val = n;
868
869    /* If the high bit of the worked out type is set then this number
870       has to be unsigned. */
871
872    if (unsigned_p || (n & high_bit))
873      {
874        putithere->typed_val_int.type = unsigned_type;
875      }
876    else
877      {
878        putithere->typed_val_int.type = signed_type;
879      }
880
881    return INT;
882 }
883
884 struct token
885 {
886   char *operator;
887   int token;
888   enum exp_opcode opcode;
889 };
890
891 static const struct token tokentab3[] =
892   {
893     {"shr", RSH, BINOP_END},
894     {"shl", LSH, BINOP_END},
895     {"and", ANDAND, BINOP_END},
896     {"div", DIV, BINOP_END},
897     {"not", NOT, BINOP_END},
898     {"mod", MOD, BINOP_END},
899     {"inc", INCREMENT, BINOP_END},
900     {"dec", DECREMENT, BINOP_END},
901     {"xor", XOR, BINOP_END}
902   };
903
904 static const struct token tokentab2[] =
905   {
906     {"or", OR, BINOP_END},
907     {"<>", NOTEQUAL, BINOP_END},
908     {"<=", LEQ, BINOP_END},
909     {">=", GEQ, BINOP_END},
910     {":=", ASSIGN, BINOP_END}
911   };
912
913 /* Allocate uppercased var */
914 /* make an uppercased copy of tokstart */
915 static char * uptok (tokstart, namelen)
916   char *tokstart;
917   int namelen;
918 {
919   int i;
920   char *uptokstart = (char *)malloc(namelen+1);
921   for (i = 0;i <= namelen;i++)
922     {
923       if ((tokstart[i]>='a' && tokstart[i]<='z'))
924         uptokstart[i] = tokstart[i]-('a'-'A');
925       else
926         uptokstart[i] = tokstart[i];
927     }
928   uptokstart[namelen]='\0';
929   return uptokstart;
930 }
931 /* Read one token, getting characters through lexptr.  */
932
933
934 static int
935 yylex ()
936 {
937   int c;
938   int namelen;
939   unsigned int i;
940   char *tokstart;
941   char *uptokstart;
942   char *tokptr;
943   char *p;
944   int explen, tempbufindex;
945   static char *tempbuf;
946   static int tempbufsize;
947
948  retry:
949
950   tokstart = lexptr;
951   explen = strlen (lexptr);
952   /* See if it is a special token of length 3.  */
953   if (explen > 2)
954     for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
955       if (strncasecmp (tokstart, tokentab3[i].operator, 3) == 0
956           && (!isalpha (tokentab3[i].operator[0]) || explen == 3
957               || (!isalpha (tokstart[3]) && !isdigit (tokstart[3]) && tokstart[3] != '_')))
958         {
959           lexptr += 3;
960           yylval.opcode = tokentab3[i].opcode;
961           return tokentab3[i].token;
962         }
963
964   /* See if it is a special token of length 2.  */
965   if (explen > 1)
966   for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
967       if (strncasecmp (tokstart, tokentab2[i].operator, 2) == 0
968           && (!isalpha (tokentab2[i].operator[0]) || explen == 2
969               || (!isalpha (tokstart[2]) && !isdigit (tokstart[2]) && tokstart[2] != '_')))
970         {
971           lexptr += 2;
972           yylval.opcode = tokentab2[i].opcode;
973           return tokentab2[i].token;
974         }
975
976   switch (c = *tokstart)
977     {
978     case 0:
979       return 0;
980
981     case ' ':
982     case '\t':
983     case '\n':
984       lexptr++;
985       goto retry;
986
987     case '\'':
988       /* We either have a character constant ('0' or '\177' for example)
989          or we have a quoted symbol reference ('foo(int,int)' in object pascal
990          for example). */
991       lexptr++;
992       c = *lexptr++;
993       if (c == '\\')
994         c = parse_escape (&lexptr);
995       else if (c == '\'')
996         error ("Empty character constant.");
997
998       yylval.typed_val_int.val = c;
999       yylval.typed_val_int.type = builtin_type_char;
1000
1001       c = *lexptr++;
1002       if (c != '\'')
1003         {
1004           namelen = skip_quoted (tokstart) - tokstart;
1005           if (namelen > 2)
1006             {
1007               lexptr = tokstart + namelen;
1008               if (lexptr[-1] != '\'')
1009                 error ("Unmatched single quote.");
1010               namelen -= 2;
1011               tokstart++;
1012               uptokstart = uptok(tokstart,namelen);
1013               goto tryname;
1014             }
1015           error ("Invalid character constant.");
1016         }
1017       return INT;
1018
1019     case '(':
1020       paren_depth++;
1021       lexptr++;
1022       return c;
1023
1024     case ')':
1025       if (paren_depth == 0)
1026         return 0;
1027       paren_depth--;
1028       lexptr++;
1029       return c;
1030
1031     case ',':
1032       if (comma_terminates && paren_depth == 0)
1033         return 0;
1034       lexptr++;
1035       return c;
1036
1037     case '.':
1038       /* Might be a floating point number.  */
1039       if (lexptr[1] < '0' || lexptr[1] > '9')
1040         goto symbol;            /* Nope, must be a symbol. */
1041       /* FALL THRU into number case.  */
1042
1043     case '0':
1044     case '1':
1045     case '2':
1046     case '3':
1047     case '4':
1048     case '5':
1049     case '6':
1050     case '7':
1051     case '8':
1052     case '9':
1053       {
1054         /* It's a number.  */
1055         int got_dot = 0, got_e = 0, toktype;
1056         register char *p = tokstart;
1057         int hex = input_radix > 10;
1058
1059         if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1060           {
1061             p += 2;
1062             hex = 1;
1063           }
1064         else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1065           {
1066             p += 2;
1067             hex = 0;
1068           }
1069
1070         for (;; ++p)
1071           {
1072             /* This test includes !hex because 'e' is a valid hex digit
1073                and thus does not indicate a floating point number when
1074                the radix is hex.  */
1075             if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1076               got_dot = got_e = 1;
1077             /* This test does not include !hex, because a '.' always indicates
1078                a decimal floating point number regardless of the radix.  */
1079             else if (!got_dot && *p == '.')
1080               got_dot = 1;
1081             else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1082                      && (*p == '-' || *p == '+'))
1083               /* This is the sign of the exponent, not the end of the
1084                  number.  */
1085               continue;
1086             /* We will take any letters or digits.  parse_number will
1087                complain if past the radix, or if L or U are not final.  */
1088             else if ((*p < '0' || *p > '9')
1089                      && ((*p < 'a' || *p > 'z')
1090                                   && (*p < 'A' || *p > 'Z')))
1091               break;
1092           }
1093         toktype = parse_number (tokstart, p - tokstart, got_dot|got_e, &yylval);
1094         if (toktype == ERROR)
1095           {
1096             char *err_copy = (char *) alloca (p - tokstart + 1);
1097
1098             memcpy (err_copy, tokstart, p - tokstart);
1099             err_copy[p - tokstart] = 0;
1100             error ("Invalid number \"%s\".", err_copy);
1101           }
1102         lexptr = p;
1103         return toktype;
1104       }
1105
1106     case '+':
1107     case '-':
1108     case '*':
1109     case '/':
1110     case '|':
1111     case '&':
1112     case '^':
1113     case '~':
1114     case '!':
1115     case '@':
1116     case '<':
1117     case '>':
1118     case '[':
1119     case ']':
1120     case '?':
1121     case ':':
1122     case '=':
1123     case '{':
1124     case '}':
1125     symbol:
1126       lexptr++;
1127       return c;
1128
1129     case '"':
1130
1131       /* Build the gdb internal form of the input string in tempbuf,
1132          translating any standard C escape forms seen.  Note that the
1133          buffer is null byte terminated *only* for the convenience of
1134          debugging gdb itself and printing the buffer contents when
1135          the buffer contains no embedded nulls.  Gdb does not depend
1136          upon the buffer being null byte terminated, it uses the length
1137          string instead.  This allows gdb to handle C strings (as well
1138          as strings in other languages) with embedded null bytes */
1139
1140       tokptr = ++tokstart;
1141       tempbufindex = 0;
1142
1143       do {
1144         /* Grow the static temp buffer if necessary, including allocating
1145            the first one on demand. */
1146         if (tempbufindex + 1 >= tempbufsize)
1147           {
1148             tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1149           }
1150         switch (*tokptr)
1151           {
1152           case '\0':
1153           case '"':
1154             /* Do nothing, loop will terminate. */
1155             break;
1156           case '\\':
1157             tokptr++;
1158             c = parse_escape (&tokptr);
1159             if (c == -1)
1160               {
1161                 continue;
1162               }
1163             tempbuf[tempbufindex++] = c;
1164             break;
1165           default:
1166             tempbuf[tempbufindex++] = *tokptr++;
1167             break;
1168           }
1169       } while ((*tokptr != '"') && (*tokptr != '\0'));
1170       if (*tokptr++ != '"')
1171         {
1172           error ("Unterminated string in expression.");
1173         }
1174       tempbuf[tempbufindex] = '\0';     /* See note above */
1175       yylval.sval.ptr = tempbuf;
1176       yylval.sval.length = tempbufindex;
1177       lexptr = tokptr;
1178       return (STRING);
1179     }
1180
1181   if (!(c == '_' || c == '$'
1182         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1183     /* We must have come across a bad character (e.g. ';').  */
1184     error ("Invalid character '%c' in expression.", c);
1185
1186   /* It's a name.  See how long it is.  */
1187   namelen = 0;
1188   for (c = tokstart[namelen];
1189        (c == '_' || c == '$' || (c >= '0' && c <= '9')
1190         || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1191     {
1192       /* Template parameter lists are part of the name.
1193          FIXME: This mishandles `print $a<4&&$a>3'.  */
1194       if (c == '<')
1195         {
1196           int i = namelen;
1197           int nesting_level = 1;
1198           while (tokstart[++i])
1199             {
1200               if (tokstart[i] == '<')
1201                 nesting_level++;
1202               else if (tokstart[i] == '>')
1203                 {
1204                   if (--nesting_level == 0)
1205                     break;
1206                 }
1207             }
1208           if (tokstart[i] == '>')
1209             namelen = i;
1210           else
1211             break;
1212         }
1213
1214       /* do NOT uppercase internals because of registers !!! */
1215       c = tokstart[++namelen];
1216     }
1217
1218   uptokstart = uptok(tokstart,namelen);
1219
1220   /* The token "if" terminates the expression and is NOT
1221      removed from the input stream.  */
1222   if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1223     {
1224       return 0;
1225     }
1226
1227   lexptr += namelen;
1228
1229   tryname:
1230
1231   /* Catch specific keywords.  Should be done with a data structure.  */
1232   switch (namelen)
1233     {
1234     case 6:
1235       if (STREQ (uptokstart, "OBJECT"))
1236         return CLASS;
1237       if (STREQ (uptokstart, "RECORD"))
1238         return STRUCT;
1239       if (STREQ (uptokstart, "SIZEOF"))
1240         return SIZEOF;
1241       break;
1242     case 5:
1243       if (STREQ (uptokstart, "CLASS"))
1244         return CLASS;
1245       if (STREQ (uptokstart, "FALSE"))
1246         {
1247           yylval.lval = 0;
1248           return FALSE;
1249         }
1250       break;
1251     case 4:
1252       if (STREQ (uptokstart, "TRUE"))
1253         {
1254           yylval.lval = 1;
1255           return TRUE;
1256         }
1257       if (STREQ (uptokstart, "SELF"))
1258         {
1259           /* here we search for 'this' like
1260              inserted in FPC stabs debug info */
1261           static const char this_name[] =
1262                                  { /* CPLUS_MARKER,*/ 't', 'h', 'i', 's', '\0' };
1263
1264           if (lookup_symbol (this_name, expression_context_block,
1265                              VAR_NAMESPACE, (int *) NULL,
1266                              (struct symtab **) NULL))
1267             return THIS;
1268         }
1269       break;
1270     default:
1271       break;
1272     }
1273
1274   yylval.sval.ptr = tokstart;
1275   yylval.sval.length = namelen;
1276
1277   if (*tokstart == '$')
1278     {
1279       /* $ is the normal prefix for pascal hexadecimal values
1280         but this conflicts with the GDB use for debugger variables
1281         so in expression to enter hexadecimal values
1282         we still need to use C syntax with 0xff  */
1283       write_dollar_variable (yylval.sval);
1284       return VARIABLE;
1285     }
1286
1287   /* Use token-type BLOCKNAME for symbols that happen to be defined as
1288      functions or symtabs.  If this is not so, then ...
1289      Use token-type TYPENAME for symbols that happen to be defined
1290      currently as names of types; NAME for other symbols.
1291      The caller is not constrained to care about the distinction.  */
1292   {
1293     char *tmp = copy_name (yylval.sval);
1294     struct symbol *sym;
1295     int is_a_field_of_this = 0;
1296     int hextype;
1297
1298     sym = lookup_symbol (tmp, expression_context_block,
1299                          VAR_NAMESPACE,
1300                          &is_a_field_of_this,
1301                          (struct symtab **) NULL);
1302     /* second chance uppercased (as Free Pascal does).  */
1303     if (!sym && !is_a_field_of_this)
1304       {
1305        for (i = 0; i <= namelen; i++)
1306          {
1307            if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1308              tmp[i] -= ('a'-'A');
1309          }
1310        sym = lookup_symbol (tmp, expression_context_block,
1311                         VAR_NAMESPACE,
1312                         &is_a_field_of_this,
1313                         (struct symtab **) NULL);
1314        if (sym || is_a_field_of_this)
1315          for (i = 0; i <= namelen; i++)
1316            {
1317              if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1318                tokstart[i] -= ('a'-'A');
1319            }
1320       }
1321     /* Third chance Capitalized (as GPC does).  */
1322     if (!sym && !is_a_field_of_this)
1323       {
1324        for (i = 0; i <= namelen; i++)
1325          {
1326            if (i == 0)
1327              {
1328               if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1329                 tmp[i] -= ('a'-'A');
1330              }
1331            else
1332            if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1333              tmp[i] -= ('A'-'a');
1334           }
1335        sym = lookup_symbol (tmp, expression_context_block,
1336                          VAR_NAMESPACE,
1337                          &is_a_field_of_this,
1338                          (struct symtab **) NULL);
1339         if (sym || is_a_field_of_this)
1340           for (i = 0; i <= namelen; i++)
1341             {
1342               if (i == 0)
1343                 {
1344                   if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1345                     tokstart[i] -= ('a'-'A');
1346                 }
1347               else
1348                 if ((tokstart[i] >= 'A' && tokstart[i] <= 'Z'))
1349                   tokstart[i] -= ('A'-'a');
1350             }
1351       }
1352     /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1353        no psymtabs (coff, xcoff, or some future change to blow away the
1354        psymtabs once once symbols are read).  */
1355     if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK) ||
1356         lookup_symtab (tmp))
1357       {
1358         yylval.ssym.sym = sym;
1359         yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1360         return BLOCKNAME;
1361       }
1362     if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1363         {
1364 #if 1
1365           /* Despite the following flaw, we need to keep this code enabled.
1366              Because we can get called from check_stub_method, if we don't
1367              handle nested types then it screws many operations in any
1368              program which uses nested types.  */
1369           /* In "A::x", if x is a member function of A and there happens
1370              to be a type (nested or not, since the stabs don't make that
1371              distinction) named x, then this code incorrectly thinks we
1372              are dealing with nested types rather than a member function.  */
1373
1374           char *p;
1375           char *namestart;
1376           struct symbol *best_sym;
1377
1378           /* Look ahead to detect nested types.  This probably should be
1379              done in the grammar, but trying seemed to introduce a lot
1380              of shift/reduce and reduce/reduce conflicts.  It's possible
1381              that it could be done, though.  Or perhaps a non-grammar, but
1382              less ad hoc, approach would work well.  */
1383
1384           /* Since we do not currently have any way of distinguishing
1385              a nested type from a non-nested one (the stabs don't tell
1386              us whether a type is nested), we just ignore the
1387              containing type.  */
1388
1389           p = lexptr;
1390           best_sym = sym;
1391           while (1)
1392             {
1393               /* Skip whitespace.  */
1394               while (*p == ' ' || *p == '\t' || *p == '\n')
1395                 ++p;
1396               if (*p == ':' && p[1] == ':')
1397                 {
1398                   /* Skip the `::'.  */
1399                   p += 2;
1400                   /* Skip whitespace.  */
1401                   while (*p == ' ' || *p == '\t' || *p == '\n')
1402                     ++p;
1403                   namestart = p;
1404                   while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1405                          || (*p >= 'a' && *p <= 'z')
1406                          || (*p >= 'A' && *p <= 'Z'))
1407                     ++p;
1408                   if (p != namestart)
1409                     {
1410                       struct symbol *cur_sym;
1411                       /* As big as the whole rest of the expression, which is
1412                          at least big enough.  */
1413                       char *ncopy = alloca (strlen (tmp)+strlen (namestart)+3);
1414                       char *tmp1;
1415
1416                       tmp1 = ncopy;
1417                       memcpy (tmp1, tmp, strlen (tmp));
1418                       tmp1 += strlen (tmp);
1419                       memcpy (tmp1, "::", 2);
1420                       tmp1 += 2;
1421                       memcpy (tmp1, namestart, p - namestart);
1422                       tmp1[p - namestart] = '\0';
1423                       cur_sym = lookup_symbol (ncopy, expression_context_block,
1424                                                VAR_NAMESPACE, (int *) NULL,
1425                                                (struct symtab **) NULL);
1426                       if (cur_sym)
1427                         {
1428                           if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1429                             {
1430                               best_sym = cur_sym;
1431                               lexptr = p;
1432                             }
1433                           else
1434                             break;
1435                         }
1436                       else
1437                         break;
1438                     }
1439                   else
1440                     break;
1441                 }
1442               else
1443                 break;
1444             }
1445
1446           yylval.tsym.type = SYMBOL_TYPE (best_sym);
1447 #else /* not 0 */
1448           yylval.tsym.type = SYMBOL_TYPE (sym);
1449 #endif /* not 0 */
1450           return TYPENAME;
1451         }
1452     if ((yylval.tsym.type = lookup_primitive_typename (tmp)) != 0)
1453         return TYPENAME;
1454
1455     /* Input names that aren't symbols but ARE valid hex numbers,
1456        when the input radix permits them, can be names or numbers
1457        depending on the parse.  Note we support radixes > 16 here.  */
1458     if (!sym &&
1459         ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10) ||
1460          (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1461       {
1462         YYSTYPE newlval;        /* Its value is ignored.  */
1463         hextype = parse_number (tokstart, namelen, 0, &newlval);
1464         if (hextype == INT)
1465           {
1466             yylval.ssym.sym = sym;
1467             yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1468             return NAME_OR_INT;
1469           }
1470       }
1471
1472     free(uptokstart);
1473     /* Any other kind of symbol */
1474     yylval.ssym.sym = sym;
1475     yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1476     return NAME;
1477   }
1478 }
1479
1480 void
1481 yyerror (msg)
1482      char *msg;
1483 {
1484   error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
1485 }