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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [m2-exp.y] - Blame information for rev 1765

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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