OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gdb-6.8/] [gdb/] [m2-exp.y] - Blame information for rev 857

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 24 jeremybenn
/* YACC grammar for Modula-2 expressions, for GDB.
2
   Copyright (C) 1986, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1999,
3
   2000, 2007, 2008 Free Software Foundation, Inc.
4
   Generated from expread.y (now c-exp.y) and contributed by the Department
5
   of Computer Science at the State University of New York at Buffalo, 1991.
6
 
7
This file is part of GDB.
8
 
9
This program is free software; you can redistribute it and/or modify
10
it under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2 of the License, or
12
(at your option) any later version.
13
 
14
This program is distributed in the hope that it will be useful,
15
but WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17
GNU General Public License for more details.
18
 
19
You should have received a copy of the GNU General Public License
20
along with this program; if not, write to the Free Software
21
Foundation, Inc., 51 Franklin Street, Fifth Floor,
22
Boston, MA 02110-1301, USA.  */
23
 
24
/* Parse a Modula-2 expression from text in a string,
25
   and return the result as a  struct expression  pointer.
26
   That structure contains arithmetic operations in reverse polish,
27
   with constants represented by operations that are followed by special data.
28
   See expression.h for the details of the format.
29
   What is important here is that it can be built up sequentially
30
   during the process of parsing; the lower levels of the tree always
31
   come first in the result.
32
 
33
   Note that malloc's and realloc's in this file are transformed to
34
   xmalloc and xrealloc respectively by the same sed command in the
35
   makefile that remaps any other malloc/realloc inserted by the parser
36
   generator.  Doing this with #defines and trying to control the interaction
37
   with include files ( and  for example) just became
38
   too messy, particularly when such includes can be inserted at random
39
   times by the parser generator. */
40
 
41
%{
42
 
43
#include "defs.h"
44
#include "gdb_string.h"
45
#include "expression.h"
46
#include "language.h"
47
#include "value.h"
48
#include "parser-defs.h"
49
#include "m2-lang.h"
50
#include "bfd.h" /* Required by objfiles.h.  */
51
#include "symfile.h" /* Required by objfiles.h.  */
52
#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
53
#include "block.h"
54
 
55
/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
56
   as well as gratuitiously global symbol names, so we can have multiple
57
   yacc generated parsers in gdb.  Note that these are only the variables
58
   produced by yacc.  If other parser generators (bison, byacc, etc) produce
59
   additional global names that conflict at link time, then those parser
60
   generators need to be fixed instead of adding those names to this list. */
61
 
62
#define yymaxdepth m2_maxdepth
63
#define yyparse m2_parse
64
#define yylex   m2_lex
65
#define yyerror m2_error
66
#define yylval  m2_lval
67
#define yychar  m2_char
68
#define yydebug m2_debug
69
#define yypact  m2_pact
70
#define yyr1    m2_r1
71
#define yyr2    m2_r2
72
#define yydef   m2_def
73
#define yychk   m2_chk
74
#define yypgo   m2_pgo
75
#define yyact   m2_act
76
#define yyexca  m2_exca
77
#define yyerrflag m2_errflag
78
#define yynerrs m2_nerrs
79
#define yyps    m2_ps
80
#define yypv    m2_pv
81
#define yys     m2_s
82
#define yy_yys  m2_yys
83
#define yystate m2_state
84
#define yytmp   m2_tmp
85
#define yyv     m2_v
86
#define yy_yyv  m2_yyv
87
#define yyval   m2_val
88
#define yylloc  m2_lloc
89
#define yyreds  m2_reds         /* With YYDEBUG defined */
90
#define yytoks  m2_toks         /* With YYDEBUG defined */
91
#define yyname  m2_name         /* With YYDEBUG defined */
92
#define yyrule  m2_rule         /* With YYDEBUG defined */
93
#define yylhs   m2_yylhs
94
#define yylen   m2_yylen
95
#define yydefred m2_yydefred
96
#define yydgoto m2_yydgoto
97
#define yysindex m2_yysindex
98
#define yyrindex m2_yyrindex
99
#define yygindex m2_yygindex
100
#define yytable  m2_yytable
101
#define yycheck  m2_yycheck
102
 
103
#ifndef YYDEBUG
104
#define YYDEBUG 1               /* Default to yydebug support */
105
#endif
106
 
107
#define YYFPRINTF parser_fprintf
108
 
109
int yyparse (void);
110
 
111
static int yylex (void);
112
 
113
void yyerror (char *);
114
 
115
#if 0
116
static char *make_qualname (char *, char *);
117
#endif
118
 
119
static int parse_number (int);
120
 
121
/* The sign of the number being parsed. */
122
static int number_sign = 1;
123
 
124
/* The block that the module specified by the qualifer on an identifer is
125
   contained in, */
126
#if 0
127
static struct block *modblock=0;
128
#endif
129
 
130
%}
131
 
132
/* Although the yacc "value" of an expression is not used,
133
   since the result is stored in the structure being created,
134
   other node types do have values.  */
135
 
136
%union
137
  {
138
    LONGEST lval;
139
    ULONGEST ulval;
140
    DOUBLEST dval;
141
    struct symbol *sym;
142
    struct type *tval;
143
    struct stoken sval;
144
    int voidval;
145
    struct block *bval;
146
    enum exp_opcode opcode;
147
    struct internalvar *ivar;
148
 
149
    struct type **tvec;
150
    int *ivec;
151
  }
152
 
153
%type  exp type_exp start set
154
%type  variable
155
%type  type
156
%type  block
157
%type  fblock
158
 
159
%token  INT HEX ERROR
160
%token  UINT M2_TRUE M2_FALSE CHAR
161
%token  FLOAT
162
 
163
/* Both NAME and TYPENAME tokens represent symbols in the input,
164
   and both convey their data as strings.
165
   But a TYPENAME is a string that happens to be defined as a typedef
166
   or builtin type name (such as int or char)
167
   and a NAME is any other symbol.
168
 
169
   Contexts where this distinction is not important can use the
170
   nonterminal "name", which matches either NAME or TYPENAME.  */
171
 
172
%token  STRING
173
%token  NAME BLOCKNAME IDENT VARNAME
174
%token  TYPENAME
175
 
176
%token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
177
%token TSIZE
178
%token INC DEC INCL EXCL
179
 
180
/* The GDB scope operator */
181
%token COLONCOLON
182
 
183
%token  INTERNAL_VAR
184
 
185
/* M2 tokens */
186
%left ','
187
%left ABOVE_COMMA
188
%nonassoc ASSIGN
189
%left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
190
%left OROR
191
%left LOGICAL_AND '&'
192
%left '@'
193
%left '+' '-'
194
%left '*' '/' DIV MOD
195
%right UNARY
196
%right '^' DOT '[' '('
197
%right NOT '~'
198
%left COLONCOLON QID
199
/* This is not an actual token ; it is used for precedence.
200
%right QID
201
*/
202
 
203
 
204
%%
205
 
206
start   :       exp
207
        |       type_exp
208
        ;
209
 
210
type_exp:       type
211
                { write_exp_elt_opcode(OP_TYPE);
212
                  write_exp_elt_type($1);
213
                  write_exp_elt_opcode(OP_TYPE);
214
                }
215
        ;
216
 
217
/* Expressions */
218
 
219
exp     :       exp '^'   %prec UNARY
220
                        { write_exp_elt_opcode (UNOP_IND); }
221
        ;
222
 
223
exp     :       '-'
224
                        { number_sign = -1; }
225
                exp    %prec UNARY
226
                        { number_sign = 1;
227
                          write_exp_elt_opcode (UNOP_NEG); }
228
        ;
229
 
230
exp     :       '+' exp    %prec UNARY
231
                { write_exp_elt_opcode(UNOP_PLUS); }
232
        ;
233
 
234
exp     :       not_exp exp %prec UNARY
235
                        { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
236
        ;
237
 
238
not_exp :       NOT
239
        |       '~'
240
        ;
241
 
242
exp     :       CAP '(' exp ')'
243
                        { write_exp_elt_opcode (UNOP_CAP); }
244
        ;
245
 
246
exp     :       ORD '(' exp ')'
247
                        { write_exp_elt_opcode (UNOP_ORD); }
248
        ;
249
 
250
exp     :       ABS '(' exp ')'
251
                        { write_exp_elt_opcode (UNOP_ABS); }
252
        ;
253
 
254
exp     :       HIGH '(' exp ')'
255
                        { write_exp_elt_opcode (UNOP_HIGH); }
256
        ;
257
 
258
exp     :       MIN_FUNC '(' type ')'
259
                        { write_exp_elt_opcode (UNOP_MIN);
260
                          write_exp_elt_type ($3);
261
                          write_exp_elt_opcode (UNOP_MIN); }
262
        ;
263
 
264
exp     :       MAX_FUNC '(' type ')'
265
                        { write_exp_elt_opcode (UNOP_MAX);
266
                          write_exp_elt_type ($3);
267
                          write_exp_elt_opcode (UNOP_MIN); }
268
        ;
269
 
270
exp     :       FLOAT_FUNC '(' exp ')'
271
                        { write_exp_elt_opcode (UNOP_FLOAT); }
272
        ;
273
 
274
exp     :       VAL '(' type ',' exp ')'
275
                        { write_exp_elt_opcode (BINOP_VAL);
276
                          write_exp_elt_type ($3);
277
                          write_exp_elt_opcode (BINOP_VAL); }
278
        ;
279
 
280
exp     :       CHR '(' exp ')'
281
                        { write_exp_elt_opcode (UNOP_CHR); }
282
        ;
283
 
284
exp     :       ODD '(' exp ')'
285
                        { write_exp_elt_opcode (UNOP_ODD); }
286
        ;
287
 
288
exp     :       TRUNC '(' exp ')'
289
                        { write_exp_elt_opcode (UNOP_TRUNC); }
290
        ;
291
 
292
exp     :       TSIZE '(' exp ')'
293
                        { write_exp_elt_opcode (UNOP_SIZEOF); }
294
        ;
295
 
296
exp     :       SIZE exp       %prec UNARY
297
                        { write_exp_elt_opcode (UNOP_SIZEOF); }
298
        ;
299
 
300
 
301
exp     :       INC '(' exp ')'
302
                        { write_exp_elt_opcode(UNOP_PREINCREMENT); }
303
        ;
304
 
305
exp     :       INC '(' exp ',' exp ')'
306
                        { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
307
                          write_exp_elt_opcode(BINOP_ADD);
308
                          write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
309
        ;
310
 
311
exp     :       DEC '(' exp ')'
312
                        { write_exp_elt_opcode(UNOP_PREDECREMENT);}
313
        ;
314
 
315
exp     :       DEC '(' exp ',' exp ')'
316
                        { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
317
                          write_exp_elt_opcode(BINOP_SUB);
318
                          write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
319
        ;
320
 
321
exp     :       exp DOT NAME
322
                        { write_exp_elt_opcode (STRUCTOP_STRUCT);
323
                          write_exp_string ($3);
324
                          write_exp_elt_opcode (STRUCTOP_STRUCT); }
325
        ;
326
 
327
exp     :       set
328
        ;
329
 
330
exp     :       exp IN set
331
                        { error("Sets are not implemented.");}
332
        ;
333
 
334
exp     :       INCL '(' exp ',' exp ')'
335
                        { error("Sets are not implemented.");}
336
        ;
337
 
338
exp     :       EXCL '(' exp ',' exp ')'
339
                        { error("Sets are not implemented.");}
340
        ;
341
 
342
set     :       '{' arglist '}'
343
                        { error("Sets are not implemented.");}
344
        |       type '{' arglist '}'
345
                        { error("Sets are not implemented.");}
346
        ;
347
 
348
 
349
/* Modula-2 array subscript notation [a,b,c...] */
350
exp     :       exp '['
351
                        /* This function just saves the number of arguments
352
                           that follow in the list.  It is *not* specific to
353
                           function types */
354
                        { start_arglist(); }
355
                non_empty_arglist ']'  %prec DOT
356
                        { write_exp_elt_opcode (MULTI_SUBSCRIPT);
357
                          write_exp_elt_longcst ((LONGEST) end_arglist());
358
                          write_exp_elt_opcode (MULTI_SUBSCRIPT); }
359
        ;
360
 
361
exp     :       exp '[' exp ']'
362
                        { write_exp_elt_opcode (BINOP_SUBSCRIPT); }
363
        ;
364
 
365
exp     :       exp '('
366
                        /* This is to save the value of arglist_len
367
                           being accumulated by an outer function call.  */
368
                        { start_arglist (); }
369
                arglist ')'     %prec DOT
370
                        { write_exp_elt_opcode (OP_FUNCALL);
371
                          write_exp_elt_longcst ((LONGEST) end_arglist ());
372
                          write_exp_elt_opcode (OP_FUNCALL); }
373
        ;
374
 
375
arglist :
376
        ;
377
 
378
arglist :       exp
379
                        { arglist_len = 1; }
380
        ;
381
 
382
arglist :       arglist ',' exp   %prec ABOVE_COMMA
383
                        { arglist_len++; }
384
        ;
385
 
386
non_empty_arglist
387
        :       exp
388
                        { arglist_len = 1; }
389
        ;
390
 
391
non_empty_arglist
392
        :       non_empty_arglist ',' exp %prec ABOVE_COMMA
393
                        { arglist_len++; }
394
        ;
395
 
396
/* GDB construct */
397
exp     :       '{' type '}' exp  %prec UNARY
398
                        { write_exp_elt_opcode (UNOP_MEMVAL);
399
                          write_exp_elt_type ($2);
400
                          write_exp_elt_opcode (UNOP_MEMVAL); }
401
        ;
402
 
403
exp     :       type '(' exp ')' %prec UNARY
404
                        { write_exp_elt_opcode (UNOP_CAST);
405
                          write_exp_elt_type ($1);
406
                          write_exp_elt_opcode (UNOP_CAST); }
407
        ;
408
 
409
exp     :       '(' exp ')'
410
                        { }
411
        ;
412
 
413
/* Binary operators in order of decreasing precedence.  Note that some
414
   of these operators are overloaded!  (ie. sets) */
415
 
416
/* GDB construct */
417
exp     :       exp '@' exp
418
                        { write_exp_elt_opcode (BINOP_REPEAT); }
419
        ;
420
 
421
exp     :       exp '*' exp
422
                        { write_exp_elt_opcode (BINOP_MUL); }
423
        ;
424
 
425
exp     :       exp '/' exp
426
                        { write_exp_elt_opcode (BINOP_DIV); }
427
        ;
428
 
429
exp     :       exp DIV exp
430
                        { write_exp_elt_opcode (BINOP_INTDIV); }
431
        ;
432
 
433
exp     :       exp MOD exp
434
                        { write_exp_elt_opcode (BINOP_REM); }
435
        ;
436
 
437
exp     :       exp '+' exp
438
                        { write_exp_elt_opcode (BINOP_ADD); }
439
        ;
440
 
441
exp     :       exp '-' exp
442
                        { write_exp_elt_opcode (BINOP_SUB); }
443
        ;
444
 
445
exp     :       exp '=' exp
446
                        { write_exp_elt_opcode (BINOP_EQUAL); }
447
        ;
448
 
449
exp     :       exp NOTEQUAL exp
450
                        { write_exp_elt_opcode (BINOP_NOTEQUAL); }
451
        |       exp '#' exp
452
                        { write_exp_elt_opcode (BINOP_NOTEQUAL); }
453
        ;
454
 
455
exp     :       exp LEQ exp
456
                        { write_exp_elt_opcode (BINOP_LEQ); }
457
        ;
458
 
459
exp     :       exp GEQ exp
460
                        { write_exp_elt_opcode (BINOP_GEQ); }
461
        ;
462
 
463
exp     :       exp '<' exp
464
                        { write_exp_elt_opcode (BINOP_LESS); }
465
        ;
466
 
467
exp     :       exp '>' exp
468
                        { write_exp_elt_opcode (BINOP_GTR); }
469
        ;
470
 
471
exp     :       exp LOGICAL_AND exp
472
                        { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
473
        ;
474
 
475
exp     :       exp OROR exp
476
                        { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
477
        ;
478
 
479
exp     :       exp ASSIGN exp
480
                        { write_exp_elt_opcode (BINOP_ASSIGN); }
481
        ;
482
 
483
 
484
/* Constants */
485
 
486
exp     :       M2_TRUE
487
                        { write_exp_elt_opcode (OP_BOOL);
488
                          write_exp_elt_longcst ((LONGEST) $1);
489
                          write_exp_elt_opcode (OP_BOOL); }
490
        ;
491
 
492
exp     :       M2_FALSE
493
                        { write_exp_elt_opcode (OP_BOOL);
494
                          write_exp_elt_longcst ((LONGEST) $1);
495
                          write_exp_elt_opcode (OP_BOOL); }
496
        ;
497
 
498
exp     :       INT
499
                        { write_exp_elt_opcode (OP_LONG);
500
                          write_exp_elt_type (builtin_type_m2_int);
501
                          write_exp_elt_longcst ((LONGEST) $1);
502
                          write_exp_elt_opcode (OP_LONG); }
503
        ;
504
 
505
exp     :       UINT
506
                        {
507
                          write_exp_elt_opcode (OP_LONG);
508
                          write_exp_elt_type (builtin_type_m2_card);
509
                          write_exp_elt_longcst ((LONGEST) $1);
510
                          write_exp_elt_opcode (OP_LONG);
511
                        }
512
        ;
513
 
514
exp     :       CHAR
515
                        { write_exp_elt_opcode (OP_LONG);
516
                          write_exp_elt_type (builtin_type_m2_char);
517
                          write_exp_elt_longcst ((LONGEST) $1);
518
                          write_exp_elt_opcode (OP_LONG); }
519
        ;
520
 
521
 
522
exp     :       FLOAT
523
                        { write_exp_elt_opcode (OP_DOUBLE);
524
                          write_exp_elt_type (builtin_type_m2_real);
525
                          write_exp_elt_dblcst ($1);
526
                          write_exp_elt_opcode (OP_DOUBLE); }
527
        ;
528
 
529
exp     :       variable
530
        ;
531
 
532
exp     :       SIZE '(' type ')'       %prec UNARY
533
                        { write_exp_elt_opcode (OP_LONG);
534
                          write_exp_elt_type (builtin_type_int);
535
                          write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
536
                          write_exp_elt_opcode (OP_LONG); }
537
        ;
538
 
539
exp     :       STRING
540
                        { write_exp_elt_opcode (OP_M2_STRING);
541
                          write_exp_string ($1);
542
                          write_exp_elt_opcode (OP_M2_STRING); }
543
        ;
544
 
545
/* This will be used for extensions later.  Like adding modules. */
546
block   :       fblock
547
                        { $$ = SYMBOL_BLOCK_VALUE($1); }
548
        ;
549
 
550
fblock  :       BLOCKNAME
551
                        { struct symbol *sym
552
                            = lookup_symbol (copy_name ($1), expression_context_block,
553
                                             VAR_DOMAIN, 0, NULL);
554
                          $$ = sym;}
555
        ;
556
 
557
 
558
/* GDB scope operator */
559
fblock  :       block COLONCOLON BLOCKNAME
560
                        { struct symbol *tem
561
                            = lookup_symbol (copy_name ($3), $1,
562
                                             VAR_DOMAIN, 0, NULL);
563
                          if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
564
                            error ("No function \"%s\" in specified context.",
565
                                   copy_name ($3));
566
                          $$ = tem;
567
                        }
568
        ;
569
 
570
/* Useful for assigning to PROCEDURE variables */
571
variable:       fblock
572
                        { write_exp_elt_opcode(OP_VAR_VALUE);
573
                          write_exp_elt_block (NULL);
574
                          write_exp_elt_sym ($1);
575
                          write_exp_elt_opcode (OP_VAR_VALUE); }
576
        ;
577
 
578
/* GDB internal ($foo) variable */
579
variable:       INTERNAL_VAR
580
        ;
581
 
582
/* GDB scope operator */
583
variable:       block COLONCOLON NAME
584
                        { struct symbol *sym;
585
                          sym = lookup_symbol (copy_name ($3), $1,
586
                                               VAR_DOMAIN, 0, NULL);
587
                          if (sym == 0)
588
                            error ("No symbol \"%s\" in specified context.",
589
                                   copy_name ($3));
590
 
591
                          write_exp_elt_opcode (OP_VAR_VALUE);
592
                          /* block_found is set by lookup_symbol.  */
593
                          write_exp_elt_block (block_found);
594
                          write_exp_elt_sym (sym);
595
                          write_exp_elt_opcode (OP_VAR_VALUE); }
596
        ;
597
 
598
/* Base case for variables. */
599
variable:       NAME
600
                        { struct symbol *sym;
601
                          int is_a_field_of_this;
602
 
603
                          sym = lookup_symbol (copy_name ($1),
604
                                               expression_context_block,
605
                                               VAR_DOMAIN,
606
                                               &is_a_field_of_this,
607
                                               NULL);
608
                          if (sym)
609
                            {
610
                              if (symbol_read_needs_frame (sym))
611
                                {
612
                                  if (innermost_block == 0 ||
613
                                      contained_in (block_found,
614
                                                    innermost_block))
615
                                    innermost_block = block_found;
616
                                }
617
 
618
                              write_exp_elt_opcode (OP_VAR_VALUE);
619
                              /* We want to use the selected frame, not
620
                                 another more inner frame which happens to
621
                                 be in the same block.  */
622
                              write_exp_elt_block (NULL);
623
                              write_exp_elt_sym (sym);
624
                              write_exp_elt_opcode (OP_VAR_VALUE);
625
                            }
626
                          else
627
                            {
628
                              struct minimal_symbol *msymbol;
629
                              char *arg = copy_name ($1);
630
 
631
                              msymbol =
632
                                lookup_minimal_symbol (arg, NULL, NULL);
633
                              if (msymbol != NULL)
634
                                {
635
                                  write_exp_msymbol
636
                                    (msymbol,
637
                                     lookup_function_type (builtin_type_int),
638
                                     builtin_type_int);
639
                                }
640
                              else if (!have_full_symbols () && !have_partial_symbols ())
641
                                error ("No symbol table is loaded.  Use the \"symbol-file\" command.");
642
                              else
643
                                error ("No symbol \"%s\" in current context.",
644
                                       copy_name ($1));
645
                            }
646
                        }
647
        ;
648
 
649
type
650
        :       TYPENAME
651
                        { $$ = lookup_typename (copy_name ($1),
652
                                                expression_context_block, 0); }
653
 
654
        ;
655
 
656
%%
657
 
658
#if 0  /* FIXME! */
659
int
660
overflow(a,b)
661
   long a,b;
662
{
663
   return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
664
}
665
 
666
int
667
uoverflow(a,b)
668
   unsigned long a,b;
669
{
670
   return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
671
}
672
#endif /* FIXME */
673
 
674
/* Take care of parsing a number (anything that starts with a digit).
675
   Set yylval and return the token type; update lexptr.
676
   LEN is the number of characters in it.  */
677
 
678
/*** Needs some error checking for the float case ***/
679
 
680
static int
681
parse_number (olen)
682
     int olen;
683
{
684
  char *p = lexptr;
685
  LONGEST n = 0;
686
  LONGEST prevn = 0;
687
  int c,i,ischar=0;
688
  int base = input_radix;
689
  int len = olen;
690
  int unsigned_p = number_sign == 1 ? 1 : 0;
691
 
692
  if(p[len-1] == 'H')
693
  {
694
     base = 16;
695
     len--;
696
  }
697
  else if(p[len-1] == 'C' || p[len-1] == 'B')
698
  {
699
     base = 8;
700
     ischar = p[len-1] == 'C';
701
     len--;
702
  }
703
 
704
  /* Scan the number */
705
  for (c = 0; c < len; c++)
706
  {
707
    if (p[c] == '.' && base == 10)
708
      {
709
        /* It's a float since it contains a point.  */
710
        yylval.dval = atof (p);
711
        lexptr += len;
712
        return FLOAT;
713
      }
714
    if (p[c] == '.' && base != 10)
715
       error("Floating point numbers must be base 10.");
716
    if (base == 10 && (p[c] < '0' || p[c] > '9'))
717
       error("Invalid digit \'%c\' in number.",p[c]);
718
 }
719
 
720
  while (len-- > 0)
721
    {
722
      c = *p++;
723
      n *= base;
724
      if( base == 8 && (c == '8' || c == '9'))
725
         error("Invalid digit \'%c\' in octal number.",c);
726
      if (c >= '0' && c <= '9')
727
        i = c - '0';
728
      else
729
        {
730
          if (base == 16 && c >= 'A' && c <= 'F')
731
            i = c - 'A' + 10;
732
          else
733
             return ERROR;
734
        }
735
      n+=i;
736
      if(i >= base)
737
         return ERROR;
738
      if(!unsigned_p && number_sign == 1 && (prevn >= n))
739
         unsigned_p=1;          /* Try something unsigned */
740
      /* Don't do the range check if n==i and i==0, since that special
741
         case will give an overflow error. */
742
      if(RANGE_CHECK && n!=i && i)
743
      {
744
         if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
745
            ((!unsigned_p && number_sign==-1) && -prevn <= -n))
746
            range_error("Overflow on numeric constant.");
747
      }
748
         prevn=n;
749
    }
750
 
751
  lexptr = p;
752
  if(*p == 'B' || *p == 'C' || *p == 'H')
753
     lexptr++;                  /* Advance past B,C or H */
754
 
755
  if (ischar)
756
  {
757
     yylval.ulval = n;
758
     return CHAR;
759
  }
760
  else if ( unsigned_p && number_sign == 1)
761
  {
762
     yylval.ulval = n;
763
     return UINT;
764
  }
765
  else if((unsigned_p && (n<0))) {
766
     range_error("Overflow on numeric constant -- number too large.");
767
     /* But, this can return if range_check == range_warn.  */
768
  }
769
  yylval.lval = n;
770
  return INT;
771
}
772
 
773
 
774
/* Some tokens */
775
 
776
static struct
777
{
778
   char name[2];
779
   int token;
780
} tokentab2[] =
781
{
782
    { {'<', '>'},    NOTEQUAL         },
783
    { {':', '='},    ASSIGN     },
784
    { {'<', '='},    LEQ        },
785
    { {'>', '='},    GEQ        },
786
    { {':', ':'},    COLONCOLON },
787
 
788
};
789
 
790
/* Some specific keywords */
791
 
792
struct keyword {
793
   char keyw[10];
794
   int token;
795
};
796
 
797
static struct keyword keytab[] =
798
{
799
    {"OR" ,   OROR       },
800
    {"IN",    IN         },/* Note space after IN */
801
    {"AND",   LOGICAL_AND},
802
    {"ABS",   ABS        },
803
    {"CHR",   CHR        },
804
    {"DEC",   DEC        },
805
    {"NOT",   NOT        },
806
    {"DIV",   DIV        },
807
    {"INC",   INC        },
808
    {"MAX",   MAX_FUNC   },
809
    {"MIN",   MIN_FUNC   },
810
    {"MOD",   MOD        },
811
    {"ODD",   ODD        },
812
    {"CAP",   CAP        },
813
    {"ORD",   ORD        },
814
    {"VAL",   VAL        },
815
    {"EXCL",  EXCL       },
816
    {"HIGH",  HIGH       },
817
    {"INCL",  INCL       },
818
    {"SIZE",  SIZE       },
819
    {"FLOAT", FLOAT_FUNC },
820
    {"TRUNC", TRUNC      },
821
    {"TSIZE", SIZE       },
822
};
823
 
824
 
825
/* Read one token, getting characters through lexptr.  */
826
 
827
/* This is where we will check to make sure that the language and the operators used are
828
   compatible  */
829
 
830
static int
831
yylex ()
832
{
833
  int c;
834
  int namelen;
835
  int i;
836
  char *tokstart;
837
  char quote;
838
 
839
 retry:
840
 
841
  prev_lexptr = lexptr;
842
 
843
  tokstart = lexptr;
844
 
845
 
846
  /* See if it is a special token of length 2 */
847
  for( i = 0 ; i < (int) (sizeof tokentab2 / sizeof tokentab2[0]) ; i++)
848
     if (strncmp (tokentab2[i].name, tokstart, 2) == 0)
849
     {
850
        lexptr += 2;
851
        return tokentab2[i].token;
852
     }
853
 
854
  switch (c = *tokstart)
855
    {
856
    case 0:
857
      return 0;
858
 
859
    case ' ':
860
    case '\t':
861
    case '\n':
862
      lexptr++;
863
      goto retry;
864
 
865
    case '(':
866
      paren_depth++;
867
      lexptr++;
868
      return c;
869
 
870
    case ')':
871
      if (paren_depth == 0)
872
        return 0;
873
      paren_depth--;
874
      lexptr++;
875
      return c;
876
 
877
    case ',':
878
      if (comma_terminates && paren_depth == 0)
879
        return 0;
880
      lexptr++;
881
      return c;
882
 
883
    case '.':
884
      /* Might be a floating point number.  */
885
      if (lexptr[1] >= '0' && lexptr[1] <= '9')
886
        break;                  /* Falls into number code.  */
887
      else
888
      {
889
         lexptr++;
890
         return DOT;
891
      }
892
 
893
/* These are character tokens that appear as-is in the YACC grammar */
894
    case '+':
895
    case '-':
896
    case '*':
897
    case '/':
898
    case '^':
899
    case '<':
900
    case '>':
901
    case '[':
902
    case ']':
903
    case '=':
904
    case '{':
905
    case '}':
906
    case '#':
907
    case '@':
908
    case '~':
909
    case '&':
910
      lexptr++;
911
      return c;
912
 
913
    case '\'' :
914
    case '"':
915
      quote = c;
916
      for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
917
        if (c == '\\')
918
          {
919
            c = tokstart[++namelen];
920
            if (c >= '0' && c <= '9')
921
              {
922
                c = tokstart[++namelen];
923
                if (c >= '0' && c <= '9')
924
                  c = tokstart[++namelen];
925
              }
926
          }
927
      if(c != quote)
928
         error("Unterminated string or character constant.");
929
      yylval.sval.ptr = tokstart + 1;
930
      yylval.sval.length = namelen - 1;
931
      lexptr += namelen + 1;
932
 
933
      if(namelen == 2)          /* Single character */
934
      {
935
           yylval.ulval = tokstart[1];
936
           return CHAR;
937
      }
938
      else
939
         return STRING;
940
    }
941
 
942
  /* Is it a number?  */
943
  /* Note:  We have already dealt with the case of the token '.'.
944
     See case '.' above.  */
945
  if ((c >= '0' && c <= '9'))
946
    {
947
      /* It's a number.  */
948
      int got_dot = 0, got_e = 0;
949
      char *p = tokstart;
950
      int toktype;
951
 
952
      for (++p ;; ++p)
953
        {
954
          if (!got_e && (*p == 'e' || *p == 'E'))
955
            got_dot = got_e = 1;
956
          else if (!got_dot && *p == '.')
957
            got_dot = 1;
958
          else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
959
                   && (*p == '-' || *p == '+'))
960
            /* This is the sign of the exponent, not the end of the
961
               number.  */
962
            continue;
963
          else if ((*p < '0' || *p > '9') &&
964
                   (*p < 'A' || *p > 'F') &&
965
                   (*p != 'H'))  /* Modula-2 hexadecimal number */
966
            break;
967
        }
968
        toktype = parse_number (p - tokstart);
969
        if (toktype == ERROR)
970
          {
971
            char *err_copy = (char *) alloca (p - tokstart + 1);
972
 
973
            memcpy (err_copy, tokstart, p - tokstart);
974
            err_copy[p - tokstart] = 0;
975
            error ("Invalid number \"%s\".", err_copy);
976
          }
977
        lexptr = p;
978
        return toktype;
979
    }
980
 
981
  if (!(c == '_' || c == '$'
982
        || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
983
    /* We must have come across a bad character (e.g. ';').  */
984
    error ("Invalid character '%c' in expression.", c);
985
 
986
  /* It's a name.  See how long it is.  */
987
  namelen = 0;
988
  for (c = tokstart[namelen];
989
       (c == '_' || c == '$' || (c >= '0' && c <= '9')
990
        || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
991
       c = tokstart[++namelen])
992
    ;
993
 
994
  /* The token "if" terminates the expression and is NOT
995
     removed from the input stream.  */
996
  if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
997
    {
998
      return 0;
999
    }
1000
 
1001
  lexptr += namelen;
1002
 
1003
  /*  Lookup special keywords */
1004
  for(i = 0 ; i < (int) (sizeof(keytab) / sizeof(keytab[0])) ; i++)
1005
     if (namelen == strlen (keytab[i].keyw)
1006
         && strncmp (tokstart, keytab[i].keyw, namelen) == 0)
1007
           return keytab[i].token;
1008
 
1009
  yylval.sval.ptr = tokstart;
1010
  yylval.sval.length = namelen;
1011
 
1012
  if (*tokstart == '$')
1013
    {
1014
      write_dollar_variable (yylval.sval);
1015
      return INTERNAL_VAR;
1016
    }
1017
 
1018
  /* Use token-type BLOCKNAME for symbols that happen to be defined as
1019
     functions.  If this is not so, then ...
1020
     Use token-type TYPENAME for symbols that happen to be defined
1021
     currently as names of types; NAME for other symbols.
1022
     The caller is not constrained to care about the distinction.  */
1023
 {
1024
 
1025
 
1026
    char *tmp = copy_name (yylval.sval);
1027
    struct symbol *sym;
1028
 
1029
    if (lookup_partial_symtab (tmp))
1030
      return BLOCKNAME;
1031
    sym = lookup_symbol (tmp, expression_context_block,
1032
                         VAR_DOMAIN, 0, NULL);
1033
    if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1034
      return BLOCKNAME;
1035
    if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1036
      return TYPENAME;
1037
 
1038
    if(sym)
1039
    {
1040
       switch(sym->aclass)
1041
       {
1042
       case LOC_STATIC:
1043
       case LOC_REGISTER:
1044
       case LOC_ARG:
1045
       case LOC_REF_ARG:
1046
       case LOC_REGPARM:
1047
       case LOC_REGPARM_ADDR:
1048
       case LOC_LOCAL:
1049
       case LOC_LOCAL_ARG:
1050
       case LOC_BASEREG:
1051
       case LOC_BASEREG_ARG:
1052
       case LOC_CONST:
1053
       case LOC_CONST_BYTES:
1054
       case LOC_OPTIMIZED_OUT:
1055
       case LOC_COMPUTED:
1056
       case LOC_COMPUTED_ARG:
1057
          return NAME;
1058
 
1059
       case LOC_TYPEDEF:
1060
          return TYPENAME;
1061
 
1062
       case LOC_BLOCK:
1063
          return BLOCKNAME;
1064
 
1065
       case LOC_UNDEF:
1066
          error("internal:  Undefined class in m2lex()");
1067
 
1068
       case LOC_LABEL:
1069
       case LOC_UNRESOLVED:
1070
          error("internal:  Unforseen case in m2lex()");
1071
 
1072
       default:
1073
          error ("unhandled token in m2lex()");
1074
          break;
1075
       }
1076
    }
1077
    else
1078
    {
1079
       /* Built-in BOOLEAN type.  This is sort of a hack. */
1080
       if (strncmp (tokstart, "TRUE", 4) == 0)
1081
       {
1082
          yylval.ulval = 1;
1083
          return M2_TRUE;
1084
       }
1085
       else if (strncmp (tokstart, "FALSE", 5) == 0)
1086
       {
1087
          yylval.ulval = 0;
1088
          return M2_FALSE;
1089
       }
1090
    }
1091
 
1092
    /* Must be another type of name... */
1093
    return NAME;
1094
 }
1095
}
1096
 
1097
#if 0           /* Unused */
1098
static char *
1099
make_qualname(mod,ident)
1100
   char *mod, *ident;
1101
{
1102
   char *new = malloc(strlen(mod)+strlen(ident)+2);
1103
 
1104
   strcpy(new,mod);
1105
   strcat(new,".");
1106
   strcat(new,ident);
1107
   return new;
1108
}
1109
#endif  /* 0 */
1110
 
1111
void
1112
yyerror (msg)
1113
     char *msg;
1114
{
1115
  if (prev_lexptr)
1116
    lexptr = prev_lexptr;
1117
 
1118
  error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
1119
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.