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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [gdb-5.0/] [gdb/] [ch-exp.c] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 104 markom
/* Parser for GNU CHILL (CCITT High-Level Language)  -*- C -*-
2
   Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc.
3
 
4
   This file is part of GDB.
5
 
6
   This program is free software; you can redistribute it and/or modify
7
   it under the terms of the GNU General Public License as published by
8
   the Free Software Foundation; either version 2 of the License, or
9
   (at your option) any later version.
10
 
11
   This program is distributed in the hope that it will be useful,
12
   but WITHOUT ANY WARRANTY; without even the implied warranty of
13
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14
   GNU General Public License for more details.
15
 
16
   You should have received a copy of the GNU General Public License
17
   along with this program; if not, write to the Free Software
18
   Foundation, Inc., 59 Temple Place - Suite 330,
19
   Boston, MA 02111-1307, USA.  */
20
 
21
/* Parse a Chill expression from text in a string,
22
   and return the result as a  struct expression  pointer.
23
   That structure contains arithmetic operations in reverse polish,
24
   with constants represented by operations that are followed by special data.
25
   See expression.h for the details of the format.
26
   What is important here is that it can be built up sequentially
27
   during the process of parsing; the lower levels of the tree always
28
   come first in the result.
29
 
30
   Note that the language accepted by this parser is more liberal
31
   than the one accepted by an actual Chill compiler.  For example, the
32
   language rule that a simple name string can not be one of the reserved
33
   simple name strings is not enforced (e.g "case" is not treated as a
34
   reserved name).  Another example is that Chill is a strongly typed
35
   language, and certain expressions that violate the type constraints
36
   may still be evaluated if gdb can do so in a meaningful manner, while
37
   such expressions would be rejected by the compiler.  The reason for
38
   this more liberal behavior is the philosophy that the debugger
39
   is intended to be a tool that is used by the programmer when things
40
   go wrong, and as such, it should provide as few artificial barriers
41
   to it's use as possible.  If it can do something meaningful, even
42
   something that violates language contraints that are enforced by the
43
   compiler, it should do so without complaint.
44
 
45
 */
46
 
47
#include "defs.h"
48
#include "gdb_string.h"
49
#include <ctype.h>
50
#include "expression.h"
51
#include "language.h"
52
#include "value.h"
53
#include "parser-defs.h"
54
#include "ch-lang.h"
55
#include "bfd.h"                /* Required by objfiles.h.  */
56
#include "symfile.h"            /* Required by objfiles.h.  */
57
#include "objfiles.h"           /* For have_full_symbols and have_partial_symbols */
58
 
59
#ifdef __GNUC__
60
#define INLINE __inline__
61
#endif
62
 
63
typedef union
64
 
65
  {
66
    LONGEST lval;
67
    ULONGEST ulval;
68
    struct
69
      {
70
        LONGEST val;
71
        struct type *type;
72
      }
73
    typed_val;
74
    double dval;
75
    struct symbol *sym;
76
    struct type *tval;
77
    struct stoken sval;
78
    struct ttype tsym;
79
    struct symtoken ssym;
80
  }
81
YYSTYPE;
82
 
83
enum ch_terminal
84
  {
85
    END_TOKEN = 0,
86
    /* '\001' ... '\xff' come first. */
87
    OPEN_PAREN = '(',
88
    TOKEN_NOT_READ = 999,
89
    INTEGER_LITERAL,
90
    BOOLEAN_LITERAL,
91
    CHARACTER_LITERAL,
92
    FLOAT_LITERAL,
93
    GENERAL_PROCEDURE_NAME,
94
    LOCATION_NAME,
95
    EMPTINESS_LITERAL,
96
    CHARACTER_STRING_LITERAL,
97
    BIT_STRING_LITERAL,
98
    TYPENAME,
99
    DOT_FIELD_NAME,             /* '.' followed by <field name> */
100
    CASE,
101
    OF,
102
    ESAC,
103
    LOGIOR,
104
    ORIF,
105
    LOGXOR,
106
    LOGAND,
107
    ANDIF,
108
    NOTEQUAL,
109
    GEQ,
110
    LEQ,
111
    IN,
112
    SLASH_SLASH,
113
    MOD,
114
    REM,
115
    NOT,
116
    POINTER,
117
    RECEIVE,
118
    UP,
119
    IF,
120
    THEN,
121
    ELSE,
122
    FI,
123
    ELSIF,
124
    ILLEGAL_TOKEN,
125
    NUM,
126
    PRED,
127
    SUCC,
128
    ABS,
129
    CARD,
130
    MAX_TOKEN,
131
    MIN_TOKEN,
132
    ADDR_TOKEN,
133
    SIZE,
134
    UPPER,
135
    LOWER,
136
    LENGTH,
137
    ARRAY,
138
    GDB_VARIABLE,
139
    GDB_ASSIGNMENT
140
  };
141
 
142
/* Forward declarations. */
143
 
144
static void write_lower_upper_value PARAMS ((enum exp_opcode, struct type *));
145
static enum ch_terminal match_bitstring_literal PARAMS ((void));
146
static enum ch_terminal match_integer_literal PARAMS ((void));
147
static enum ch_terminal match_character_literal PARAMS ((void));
148
static enum ch_terminal match_string_literal PARAMS ((void));
149
static enum ch_terminal match_float_literal PARAMS ((void));
150
static enum ch_terminal match_float_literal PARAMS ((void));
151
static int decode_integer_literal PARAMS ((LONGEST *, char **));
152
static int decode_integer_value PARAMS ((int, char **, LONGEST *));
153
static char *match_simple_name_string PARAMS ((void));
154
static void growbuf_by_size PARAMS ((int));
155
static void parse_untyped_expr PARAMS ((void));
156
static void parse_if_expression PARAMS ((void));
157
static void parse_else_alternative PARAMS ((void));
158
static void parse_then_alternative PARAMS ((void));
159
static void parse_expr PARAMS ((void));
160
static void parse_operand0 PARAMS ((void));
161
static void parse_operand1 PARAMS ((void));
162
static void parse_operand2 PARAMS ((void));
163
static void parse_operand3 PARAMS ((void));
164
static void parse_operand4 PARAMS ((void));
165
static void parse_operand5 PARAMS ((void));
166
static void parse_operand6 PARAMS ((void));
167
static void parse_primval PARAMS ((void));
168
static void parse_tuple PARAMS ((struct type *));
169
static void parse_opt_element_list PARAMS ((struct type *));
170
static void parse_tuple_element PARAMS ((struct type *));
171
static void parse_named_record_element PARAMS ((void));
172
static void parse_call PARAMS ((void));
173
static struct type *parse_mode_or_normal_call PARAMS ((void));
174
#if 0
175
static struct type *parse_mode_call PARAMS ((void));
176
#endif
177
static void parse_unary_call PARAMS ((void));
178
static int parse_opt_untyped_expr PARAMS ((void));
179
static void parse_case_label PARAMS ((void));
180
static int expect PARAMS ((enum ch_terminal, char *));
181
static void parse_expr PARAMS ((void));
182
static void parse_primval PARAMS ((void));
183
static void parse_untyped_expr PARAMS ((void));
184
static int parse_opt_untyped_expr PARAMS ((void));
185
static void parse_if_expression_body PARAMS ((void));
186
static enum ch_terminal ch_lex PARAMS ((void));
187
INLINE static enum ch_terminal PEEK_TOKEN PARAMS ((void));
188
static enum ch_terminal peek_token_ PARAMS ((int));
189
static void forward_token_ PARAMS ((void));
190
static void require PARAMS ((enum ch_terminal));
191
static int check_token PARAMS ((enum ch_terminal));
192
 
193
#define MAX_LOOK_AHEAD 2
194
static enum ch_terminal terminal_buffer[MAX_LOOK_AHEAD + 1] =
195
{
196
  TOKEN_NOT_READ, TOKEN_NOT_READ, TOKEN_NOT_READ};
197
static YYSTYPE yylval;
198
static YYSTYPE val_buffer[MAX_LOOK_AHEAD + 1];
199
 
200
/*int current_token, lookahead_token; */
201
 
202
INLINE static enum ch_terminal
203
PEEK_TOKEN ()
204
{
205
  if (terminal_buffer[0] == TOKEN_NOT_READ)
206
    {
207
      terminal_buffer[0] = ch_lex ();
208
      val_buffer[0] = yylval;
209
    }
210
  return terminal_buffer[0];
211
}
212
#define PEEK_LVAL() val_buffer[0]
213
#define PEEK_TOKEN1() peek_token_(1)
214
#define PEEK_TOKEN2() peek_token_(2)
215
static enum ch_terminal
216
peek_token_ (i)
217
     int i;
218
{
219
  if (i > MAX_LOOK_AHEAD)
220
    internal_error ("ch-exp.c - too much lookahead");
221
  if (terminal_buffer[i] == TOKEN_NOT_READ)
222
    {
223
      terminal_buffer[i] = ch_lex ();
224
      val_buffer[i] = yylval;
225
    }
226
  return terminal_buffer[i];
227
}
228
 
229
#if 0
230
 
231
static void
232
pushback_token (code, node)
233
     enum ch_terminal code;
234
     YYSTYPE node;
235
{
236
  int i;
237
  if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ)
238
    internal_error ("ch-exp.c - cannot pushback token");
239
  for (i = MAX_LOOK_AHEAD; i > 0; i--)
240
    {
241
      terminal_buffer[i] = terminal_buffer[i - 1];
242
      val_buffer[i] = val_buffer[i - 1];
243
    }
244
  terminal_buffer[0] = code;
245
  val_buffer[0] = node;
246
}
247
 
248
#endif
249
 
250
static void
251
forward_token_ ()
252
{
253
  int i;
254
  for (i = 0; i < MAX_LOOK_AHEAD; i++)
255
    {
256
      terminal_buffer[i] = terminal_buffer[i + 1];
257
      val_buffer[i] = val_buffer[i + 1];
258
    }
259
  terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ;
260
}
261
#define FORWARD_TOKEN() forward_token_()
262
 
263
/* Skip the next token.
264
   if it isn't TOKEN, the parser is broken. */
265
 
266
static void
267
require (token)
268
     enum ch_terminal token;
269
{
270
  if (PEEK_TOKEN () != token)
271
    {
272
      internal_error ("ch-exp.c - expected token %d", (int) token);
273
    }
274
  FORWARD_TOKEN ();
275
}
276
 
277
static int
278
check_token (token)
279
     enum ch_terminal token;
280
{
281
  if (PEEK_TOKEN () != token)
282
    return 0;
283
  FORWARD_TOKEN ();
284
  return 1;
285
}
286
 
287
/* return 0 if expected token was not found,
288
   else return 1.
289
 */
290
static int
291
expect (token, message)
292
     enum ch_terminal token;
293
     char *message;
294
{
295
  if (PEEK_TOKEN () != token)
296
    {
297
      if (message)
298
        error (message);
299
      else if (token < 256)
300
        error ("syntax error - expected a '%c' here \"%s\"", token, lexptr);
301
      else
302
        error ("syntax error");
303
      return 0;
304
    }
305
  else
306
    FORWARD_TOKEN ();
307
  return 1;
308
}
309
 
310
#if 0
311
static tree
312
parse_opt_name_string (allow_all)
313
     int allow_all;             /* 1 if ALL is allowed as a postfix */
314
{
315
  int token = PEEK_TOKEN ();
316
  tree name;
317
  if (token != NAME)
318
    {
319
      if (token == ALL && allow_all)
320
        {
321
          FORWARD_TOKEN ();
322
          return ALL_POSTFIX;
323
        }
324
      return NULL_TREE;
325
    }
326
  name = PEEK_LVAL ();
327
  for (;;)
328
    {
329
      FORWARD_TOKEN ();
330
      token = PEEK_TOKEN ();
331
      if (token != '!')
332
        return name;
333
      FORWARD_TOKEN ();
334
      token = PEEK_TOKEN ();
335
      if (token == ALL && allow_all)
336
        return get_identifier3 (IDENTIFIER_POINTER (name), "!", "*");
337
      if (token != NAME)
338
        {
339
          if (pass == 1)
340
            error ("'%s!' is not followed by an identifier",
341
                   IDENTIFIER_POINTER (name));
342
          return name;
343
        }
344
      name = get_identifier3 (IDENTIFIER_POINTER (name),
345
                              "!", IDENTIFIER_POINTER (PEEK_LVAL ()));
346
    }
347
}
348
 
349
static tree
350
parse_simple_name_string ()
351
{
352
  int token = PEEK_TOKEN ();
353
  tree name;
354
  if (token != NAME)
355
    {
356
      error ("expected a name here");
357
      return error_mark_node;
358
    }
359
  name = PEEK_LVAL ();
360
  FORWARD_TOKEN ();
361
  return name;
362
}
363
 
364
static tree
365
parse_name_string ()
366
{
367
  tree name = parse_opt_name_string (0);
368
  if (name)
369
    return name;
370
  if (pass == 1)
371
    error ("expected a name string here");
372
  return error_mark_node;
373
}
374
 
375
/* Matches: <name_string>
376
   Returns if pass 1: the identifier.
377
   Returns if pass 2: a decl or value for identifier. */
378
 
379
static tree
380
parse_name ()
381
{
382
  tree name = parse_name_string ();
383
  if (pass == 1 || ignoring)
384
    return name;
385
  else
386
    {
387
      tree decl = lookup_name (name);
388
      if (decl == NULL_TREE)
389
        {
390
          error ("`%s' undeclared", IDENTIFIER_POINTER (name));
391
          return error_mark_node;
392
        }
393
      else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK)
394
        return error_mark_node;
395
      else if (TREE_CODE (decl) == CONST_DECL)
396
        return DECL_INITIAL (decl);
397
      else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE)
398
        return convert_from_reference (decl);
399
      else
400
        return decl;
401
    }
402
}
403
#endif
404
 
405
#if 0
406
static void
407
pushback_paren_expr (expr)
408
     tree expr;
409
{
410
  if (pass == 1 && !ignoring)
411
    expr = build1 (PAREN_EXPR, NULL_TREE, expr);
412
  pushback_token (EXPR, expr);
413
}
414
#endif
415
 
416
/* Matches: <case label> */
417
 
418
static void
419
parse_case_label ()
420
{
421
  if (check_token (ELSE))
422
    error ("ELSE in tuples labels not implemented");
423
  /* Does not handle the case of a mode name.  FIXME */
424
  parse_expr ();
425
  if (check_token (':'))
426
    {
427
      parse_expr ();
428
      write_exp_elt_opcode (BINOP_RANGE);
429
    }
430
}
431
 
432
static int
433
parse_opt_untyped_expr ()
434
{
435
  switch (PEEK_TOKEN ())
436
    {
437
    case ',':
438
    case ':':
439
    case ')':
440
      return 0;
441
    default:
442
      parse_untyped_expr ();
443
      return 1;
444
    }
445
}
446
 
447
static void
448
parse_unary_call ()
449
{
450
  FORWARD_TOKEN ();
451
  expect ('(', NULL);
452
  parse_expr ();
453
  expect (')', NULL);
454
}
455
 
456
/* Parse NAME '(' MODENAME ')'. */
457
 
458
#if 0
459
 
460
static struct type *
461
parse_mode_call ()
462
{
463
  struct type *type;
464
  FORWARD_TOKEN ();
465
  expect ('(', NULL);
466
  if (PEEK_TOKEN () != TYPENAME)
467
    error ("expect MODENAME here `%s'", lexptr);
468
  type = PEEK_LVAL ().tsym.type;
469
  FORWARD_TOKEN ();
470
  expect (')', NULL);
471
  return type;
472
}
473
 
474
#endif
475
 
476
static struct type *
477
parse_mode_or_normal_call ()
478
{
479
  struct type *type;
480
  FORWARD_TOKEN ();
481
  expect ('(', NULL);
482
  if (PEEK_TOKEN () == TYPENAME)
483
    {
484
      type = PEEK_LVAL ().tsym.type;
485
      FORWARD_TOKEN ();
486
    }
487
  else
488
    {
489
      parse_expr ();
490
      type = NULL;
491
    }
492
  expect (')', NULL);
493
  return type;
494
}
495
 
496
/* Parse something that looks like a function call.
497
   Assume we have parsed the function, and are at the '('. */
498
 
499
static void
500
parse_call ()
501
{
502
  int arg_count;
503
  require ('(');
504
  /* This is to save the value of arglist_len
505
     being accumulated for each dimension. */
506
  start_arglist ();
507
  if (parse_opt_untyped_expr ())
508
    {
509
      int tok = PEEK_TOKEN ();
510
      arglist_len = 1;
511
      if (tok == UP || tok == ':')
512
        {
513
          FORWARD_TOKEN ();
514
          parse_expr ();
515
          expect (')', "expected ')' to terminate slice");
516
          end_arglist ();
517
          write_exp_elt_opcode (tok == UP ? TERNOP_SLICE_COUNT
518
                                : TERNOP_SLICE);
519
          return;
520
        }
521
      while (check_token (','))
522
        {
523
          parse_untyped_expr ();
524
          arglist_len++;
525
        }
526
    }
527
  else
528
    arglist_len = 0;
529
  expect (')', NULL);
530
  arg_count = end_arglist ();
531
  write_exp_elt_opcode (MULTI_SUBSCRIPT);
532
  write_exp_elt_longcst (arg_count);
533
  write_exp_elt_opcode (MULTI_SUBSCRIPT);
534
}
535
 
536
static void
537
parse_named_record_element ()
538
{
539
  struct stoken label;
540
  char buf[256];
541
 
542
  label = PEEK_LVAL ().sval;
543
  sprintf (buf, "expected a field name here `%s'", lexptr);
544
  expect (DOT_FIELD_NAME, buf);
545
  if (check_token (','))
546
    parse_named_record_element ();
547
  else if (check_token (':'))
548
    parse_expr ();
549
  else
550
    error ("syntax error near `%s' in named record tuple element", lexptr);
551
  write_exp_elt_opcode (OP_LABELED);
552
  write_exp_string (label);
553
  write_exp_elt_opcode (OP_LABELED);
554
}
555
 
556
/* Returns one or more TREE_LIST nodes, in reverse order. */
557
 
558
static void
559
parse_tuple_element (type)
560
     struct type *type;
561
{
562
  if (PEEK_TOKEN () == DOT_FIELD_NAME)
563
    {
564
      /* Parse a labelled structure tuple. */
565
      parse_named_record_element ();
566
      return;
567
    }
568
 
569
  if (check_token ('('))
570
    {
571
      if (check_token ('*'))
572
        {
573
          expect (')', "missing ')' after '*' case label list");
574
          if (type)
575
            {
576
              if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
577
                {
578
                  /* do this as a range from low to high */
579
                  struct type *range_type = TYPE_FIELD_TYPE (type, 0);
580
                  LONGEST low_bound, high_bound;
581
                  if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
582
                    error ("cannot determine bounds for (*)");
583
                  /* lower bound */
584
                  write_exp_elt_opcode (OP_LONG);
585
                  write_exp_elt_type (range_type);
586
                  write_exp_elt_longcst (low_bound);
587
                  write_exp_elt_opcode (OP_LONG);
588
                  /* upper bound */
589
                  write_exp_elt_opcode (OP_LONG);
590
                  write_exp_elt_type (range_type);
591
                  write_exp_elt_longcst (high_bound);
592
                  write_exp_elt_opcode (OP_LONG);
593
                  write_exp_elt_opcode (BINOP_RANGE);
594
                }
595
              else
596
                error ("(*) in invalid context");
597
            }
598
          else
599
            error ("(*) only possible with modename in front of tuple (mode[..])");
600
        }
601
      else
602
        {
603
          parse_case_label ();
604
          while (check_token (','))
605
            {
606
              parse_case_label ();
607
              write_exp_elt_opcode (BINOP_COMMA);
608
            }
609
          expect (')', NULL);
610
        }
611
    }
612
  else
613
    parse_untyped_expr ();
614
  if (check_token (':'))
615
    {
616
      /* A powerset range or a labeled Array. */
617
      parse_untyped_expr ();
618
      write_exp_elt_opcode (BINOP_RANGE);
619
    }
620
}
621
 
622
/* Matches:  a COMMA-separated list of tuple elements.
623
   Returns a list (of TREE_LIST nodes). */
624
static void
625
parse_opt_element_list (type)
626
     struct type *type;
627
{
628
  arglist_len = 0;
629
  if (PEEK_TOKEN () == ']')
630
    return;
631
  for (;;)
632
    {
633
      parse_tuple_element (type);
634
      arglist_len++;
635
      if (PEEK_TOKEN () == ']')
636
        break;
637
      if (!check_token (','))
638
        error ("bad syntax in tuple");
639
    }
640
}
641
 
642
/* Parses: '[' elements ']'
643
   If modename is non-NULL it prefixed the tuple.  */
644
 
645
static void
646
parse_tuple (mode)
647
     struct type *mode;
648
{
649
  struct type *type;
650
  if (mode)
651
    type = check_typedef (mode);
652
  else
653
    type = 0;
654
  require ('[');
655
  start_arglist ();
656
  parse_opt_element_list (type);
657
  expect (']', "missing ']' after tuple");
658
  write_exp_elt_opcode (OP_ARRAY);
659
  write_exp_elt_longcst ((LONGEST) 0);
660
  write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
661
  write_exp_elt_opcode (OP_ARRAY);
662
  if (type)
663
    {
664
      if (TYPE_CODE (type) != TYPE_CODE_ARRAY
665
          && TYPE_CODE (type) != TYPE_CODE_STRUCT
666
          && TYPE_CODE (type) != TYPE_CODE_SET)
667
        error ("invalid tuple mode");
668
      write_exp_elt_opcode (UNOP_CAST);
669
      write_exp_elt_type (mode);
670
      write_exp_elt_opcode (UNOP_CAST);
671
    }
672
}
673
 
674
static void
675
parse_primval ()
676
{
677
  struct type *type;
678
  enum exp_opcode op;
679
  char *op_name;
680
  switch (PEEK_TOKEN ())
681
    {
682
    case INTEGER_LITERAL:
683
    case CHARACTER_LITERAL:
684
      write_exp_elt_opcode (OP_LONG);
685
      write_exp_elt_type (PEEK_LVAL ().typed_val.type);
686
      write_exp_elt_longcst (PEEK_LVAL ().typed_val.val);
687
      write_exp_elt_opcode (OP_LONG);
688
      FORWARD_TOKEN ();
689
      break;
690
    case BOOLEAN_LITERAL:
691
      write_exp_elt_opcode (OP_BOOL);
692
      write_exp_elt_longcst ((LONGEST) PEEK_LVAL ().ulval);
693
      write_exp_elt_opcode (OP_BOOL);
694
      FORWARD_TOKEN ();
695
      break;
696
    case FLOAT_LITERAL:
697
      write_exp_elt_opcode (OP_DOUBLE);
698
      write_exp_elt_type (builtin_type_double);
699
      write_exp_elt_dblcst (PEEK_LVAL ().dval);
700
      write_exp_elt_opcode (OP_DOUBLE);
701
      FORWARD_TOKEN ();
702
      break;
703
    case EMPTINESS_LITERAL:
704
      write_exp_elt_opcode (OP_LONG);
705
      write_exp_elt_type (lookup_pointer_type (builtin_type_void));
706
      write_exp_elt_longcst (0);
707
      write_exp_elt_opcode (OP_LONG);
708
      FORWARD_TOKEN ();
709
      break;
710
    case CHARACTER_STRING_LITERAL:
711
      write_exp_elt_opcode (OP_STRING);
712
      write_exp_string (PEEK_LVAL ().sval);
713
      write_exp_elt_opcode (OP_STRING);
714
      FORWARD_TOKEN ();
715
      break;
716
    case BIT_STRING_LITERAL:
717
      write_exp_elt_opcode (OP_BITSTRING);
718
      write_exp_bitstring (PEEK_LVAL ().sval);
719
      write_exp_elt_opcode (OP_BITSTRING);
720
      FORWARD_TOKEN ();
721
      break;
722
    case ARRAY:
723
      FORWARD_TOKEN ();
724
      /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
725
         which casts to an artificial array. */
726
      expect ('(', NULL);
727
      expect (')', NULL);
728
      if (PEEK_TOKEN () != TYPENAME)
729
        error ("missing MODENAME after ARRAY()");
730
      type = PEEK_LVAL ().tsym.type;
731
      FORWARD_TOKEN ();
732
      expect ('(', NULL);
733
      parse_expr ();
734
      expect (')', "missing right parenthesis");
735
      type = create_array_type ((struct type *) NULL, type,
736
                                create_range_type ((struct type *) NULL,
737
                                                   builtin_type_int, 0, 0));
738
      TYPE_ARRAY_UPPER_BOUND_TYPE (type) = BOUND_CANNOT_BE_DETERMINED;
739
      write_exp_elt_opcode (UNOP_CAST);
740
      write_exp_elt_type (type);
741
      write_exp_elt_opcode (UNOP_CAST);
742
      break;
743
#if 0
744
    case CONST:
745
    case EXPR:
746
      val = PEEK_LVAL ();
747
      FORWARD_TOKEN ();
748
      break;
749
#endif
750
    case '(':
751
      FORWARD_TOKEN ();
752
      parse_expr ();
753
      expect (')', "missing right parenthesis");
754
      break;
755
    case '[':
756
      parse_tuple (NULL);
757
      break;
758
    case GENERAL_PROCEDURE_NAME:
759
    case LOCATION_NAME:
760
      write_exp_elt_opcode (OP_VAR_VALUE);
761
      write_exp_elt_block (NULL);
762
      write_exp_elt_sym (PEEK_LVAL ().ssym.sym);
763
      write_exp_elt_opcode (OP_VAR_VALUE);
764
      FORWARD_TOKEN ();
765
      break;
766
    case GDB_VARIABLE:          /* gdb specific */
767
      FORWARD_TOKEN ();
768
      break;
769
    case NUM:
770
      parse_unary_call ();
771
      write_exp_elt_opcode (UNOP_CAST);
772
      write_exp_elt_type (builtin_type_int);
773
      write_exp_elt_opcode (UNOP_CAST);
774
      break;
775
    case CARD:
776
      parse_unary_call ();
777
      write_exp_elt_opcode (UNOP_CARD);
778
      break;
779
    case MAX_TOKEN:
780
      parse_unary_call ();
781
      write_exp_elt_opcode (UNOP_CHMAX);
782
      break;
783
    case MIN_TOKEN:
784
      parse_unary_call ();
785
      write_exp_elt_opcode (UNOP_CHMIN);
786
      break;
787
    case PRED:
788
      op_name = "PRED";
789
      goto unimplemented_unary_builtin;
790
    case SUCC:
791
      op_name = "SUCC";
792
      goto unimplemented_unary_builtin;
793
    case ABS:
794
      op_name = "ABS";
795
      goto unimplemented_unary_builtin;
796
    unimplemented_unary_builtin:
797
      parse_unary_call ();
798
      error ("not implemented:  %s builtin function", op_name);
799
      break;
800
    case ADDR_TOKEN:
801
      parse_unary_call ();
802
      write_exp_elt_opcode (UNOP_ADDR);
803
      break;
804
    case SIZE:
805
      type = parse_mode_or_normal_call ();
806
      if (type)
807
        {
808
          write_exp_elt_opcode (OP_LONG);
809
          write_exp_elt_type (builtin_type_int);
810
          CHECK_TYPEDEF (type);
811
          write_exp_elt_longcst ((LONGEST) TYPE_LENGTH (type));
812
          write_exp_elt_opcode (OP_LONG);
813
        }
814
      else
815
        write_exp_elt_opcode (UNOP_SIZEOF);
816
      break;
817
    case LOWER:
818
      op = UNOP_LOWER;
819
      goto lower_upper;
820
    case UPPER:
821
      op = UNOP_UPPER;
822
      goto lower_upper;
823
    lower_upper:
824
      type = parse_mode_or_normal_call ();
825
      write_lower_upper_value (op, type);
826
      break;
827
    case LENGTH:
828
      parse_unary_call ();
829
      write_exp_elt_opcode (UNOP_LENGTH);
830
      break;
831
    case TYPENAME:
832
      type = PEEK_LVAL ().tsym.type;
833
      FORWARD_TOKEN ();
834
      switch (PEEK_TOKEN ())
835
        {
836
        case '[':
837
          parse_tuple (type);
838
          break;
839
        case '(':
840
          FORWARD_TOKEN ();
841
          parse_expr ();
842
          expect (')', "missing right parenthesis");
843
          write_exp_elt_opcode (UNOP_CAST);
844
          write_exp_elt_type (type);
845
          write_exp_elt_opcode (UNOP_CAST);
846
          break;
847
        default:
848
          error ("typename in invalid context");
849
        }
850
      break;
851
 
852
    default:
853
      error ("invalid expression syntax at `%s'", lexptr);
854
    }
855
  for (;;)
856
    {
857
      switch (PEEK_TOKEN ())
858
        {
859
        case DOT_FIELD_NAME:
860
          write_exp_elt_opcode (STRUCTOP_STRUCT);
861
          write_exp_string (PEEK_LVAL ().sval);
862
          write_exp_elt_opcode (STRUCTOP_STRUCT);
863
          FORWARD_TOKEN ();
864
          continue;
865
        case POINTER:
866
          FORWARD_TOKEN ();
867
          if (PEEK_TOKEN () == TYPENAME)
868
            {
869
              type = PEEK_LVAL ().tsym.type;
870
              write_exp_elt_opcode (UNOP_CAST);
871
              write_exp_elt_type (lookup_pointer_type (type));
872
              write_exp_elt_opcode (UNOP_CAST);
873
              FORWARD_TOKEN ();
874
            }
875
          write_exp_elt_opcode (UNOP_IND);
876
          continue;
877
        case OPEN_PAREN:
878
          parse_call ();
879
          continue;
880
        case CHARACTER_STRING_LITERAL:
881
        case CHARACTER_LITERAL:
882
        case BIT_STRING_LITERAL:
883
          /* Handle string repetition. (See comment in parse_operand5.) */
884
          parse_primval ();
885
          write_exp_elt_opcode (MULTI_SUBSCRIPT);
886
          write_exp_elt_longcst (1);
887
          write_exp_elt_opcode (MULTI_SUBSCRIPT);
888
          continue;
889
        case END_TOKEN:
890
        case TOKEN_NOT_READ:
891
        case INTEGER_LITERAL:
892
        case BOOLEAN_LITERAL:
893
        case FLOAT_LITERAL:
894
        case GENERAL_PROCEDURE_NAME:
895
        case LOCATION_NAME:
896
        case EMPTINESS_LITERAL:
897
        case TYPENAME:
898
        case CASE:
899
        case OF:
900
        case ESAC:
901
        case LOGIOR:
902
        case ORIF:
903
        case LOGXOR:
904
        case LOGAND:
905
        case ANDIF:
906
        case NOTEQUAL:
907
        case GEQ:
908
        case LEQ:
909
        case IN:
910
        case SLASH_SLASH:
911
        case MOD:
912
        case REM:
913
        case NOT:
914
        case RECEIVE:
915
        case UP:
916
        case IF:
917
        case THEN:
918
        case ELSE:
919
        case FI:
920
        case ELSIF:
921
        case ILLEGAL_TOKEN:
922
        case NUM:
923
        case PRED:
924
        case SUCC:
925
        case ABS:
926
        case CARD:
927
        case MAX_TOKEN:
928
        case MIN_TOKEN:
929
        case ADDR_TOKEN:
930
        case SIZE:
931
        case UPPER:
932
        case LOWER:
933
        case LENGTH:
934
        case ARRAY:
935
        case GDB_VARIABLE:
936
        case GDB_ASSIGNMENT:
937
          break;
938
        }
939
      break;
940
    }
941
  return;
942
}
943
 
944
static void
945
parse_operand6 ()
946
{
947
  if (check_token (RECEIVE))
948
    {
949
      parse_primval ();
950
      error ("not implemented:  RECEIVE expression");
951
    }
952
  else if (check_token (POINTER))
953
    {
954
      parse_primval ();
955
      write_exp_elt_opcode (UNOP_ADDR);
956
    }
957
  else
958
    parse_primval ();
959
}
960
 
961
static void
962
parse_operand5 ()
963
{
964
  enum exp_opcode op;
965
  /* We are supposed to be looking for a <string repetition operator>,
966
     but in general we can't distinguish that from a parenthesized
967
     expression.  This is especially difficult if we allow the
968
     string operand to be a constant expression (as requested by
969
     some users), and not just a string literal.
970
     Consider:  LPRN expr RPRN LPRN expr RPRN
971
     Is that a function call or string repetition?
972
     Instead, we handle string repetition in parse_primval,
973
     and build_generalized_call. */
974
  switch (PEEK_TOKEN ())
975
    {
976
    case NOT:
977
      op = UNOP_LOGICAL_NOT;
978
      break;
979
    case '-':
980
      op = UNOP_NEG;
981
      break;
982
    default:
983
      op = OP_NULL;
984
    }
985
  if (op != OP_NULL)
986
    FORWARD_TOKEN ();
987
  parse_operand6 ();
988
  if (op != OP_NULL)
989
    write_exp_elt_opcode (op);
990
}
991
 
992
static void
993
parse_operand4 ()
994
{
995
  enum exp_opcode op;
996
  parse_operand5 ();
997
  for (;;)
998
    {
999
      switch (PEEK_TOKEN ())
1000
        {
1001
        case '*':
1002
          op = BINOP_MUL;
1003
          break;
1004
        case '/':
1005
          op = BINOP_DIV;
1006
          break;
1007
        case MOD:
1008
          op = BINOP_MOD;
1009
          break;
1010
        case REM:
1011
          op = BINOP_REM;
1012
          break;
1013
        default:
1014
          return;
1015
        }
1016
      FORWARD_TOKEN ();
1017
      parse_operand5 ();
1018
      write_exp_elt_opcode (op);
1019
    }
1020
}
1021
 
1022
static void
1023
parse_operand3 ()
1024
{
1025
  enum exp_opcode op;
1026
  parse_operand4 ();
1027
  for (;;)
1028
    {
1029
      switch (PEEK_TOKEN ())
1030
        {
1031
        case '+':
1032
          op = BINOP_ADD;
1033
          break;
1034
        case '-':
1035
          op = BINOP_SUB;
1036
          break;
1037
        case SLASH_SLASH:
1038
          op = BINOP_CONCAT;
1039
          break;
1040
        default:
1041
          return;
1042
        }
1043
      FORWARD_TOKEN ();
1044
      parse_operand4 ();
1045
      write_exp_elt_opcode (op);
1046
    }
1047
}
1048
 
1049
static void
1050
parse_operand2 ()
1051
{
1052
  enum exp_opcode op;
1053
  parse_operand3 ();
1054
  for (;;)
1055
    {
1056
      if (check_token (IN))
1057
        {
1058
          parse_operand3 ();
1059
          write_exp_elt_opcode (BINOP_IN);
1060
        }
1061
      else
1062
        {
1063
          switch (PEEK_TOKEN ())
1064
            {
1065
            case '>':
1066
              op = BINOP_GTR;
1067
              break;
1068
            case GEQ:
1069
              op = BINOP_GEQ;
1070
              break;
1071
            case '<':
1072
              op = BINOP_LESS;
1073
              break;
1074
            case LEQ:
1075
              op = BINOP_LEQ;
1076
              break;
1077
            case '=':
1078
              op = BINOP_EQUAL;
1079
              break;
1080
            case NOTEQUAL:
1081
              op = BINOP_NOTEQUAL;
1082
              break;
1083
            default:
1084
              return;
1085
            }
1086
          FORWARD_TOKEN ();
1087
          parse_operand3 ();
1088
          write_exp_elt_opcode (op);
1089
        }
1090
    }
1091
}
1092
 
1093
static void
1094
parse_operand1 ()
1095
{
1096
  enum exp_opcode op;
1097
  parse_operand2 ();
1098
  for (;;)
1099
    {
1100
      switch (PEEK_TOKEN ())
1101
        {
1102
        case LOGAND:
1103
          op = BINOP_BITWISE_AND;
1104
          break;
1105
        case ANDIF:
1106
          op = BINOP_LOGICAL_AND;
1107
          break;
1108
        default:
1109
          return;
1110
        }
1111
      FORWARD_TOKEN ();
1112
      parse_operand2 ();
1113
      write_exp_elt_opcode (op);
1114
    }
1115
}
1116
 
1117
static void
1118
parse_operand0 ()
1119
{
1120
  enum exp_opcode op;
1121
  parse_operand1 ();
1122
  for (;;)
1123
    {
1124
      switch (PEEK_TOKEN ())
1125
        {
1126
        case LOGIOR:
1127
          op = BINOP_BITWISE_IOR;
1128
          break;
1129
        case LOGXOR:
1130
          op = BINOP_BITWISE_XOR;
1131
          break;
1132
        case ORIF:
1133
          op = BINOP_LOGICAL_OR;
1134
          break;
1135
        default:
1136
          return;
1137
        }
1138
      FORWARD_TOKEN ();
1139
      parse_operand1 ();
1140
      write_exp_elt_opcode (op);
1141
    }
1142
}
1143
 
1144
static void
1145
parse_expr ()
1146
{
1147
  parse_operand0 ();
1148
  if (check_token (GDB_ASSIGNMENT))
1149
    {
1150
      parse_expr ();
1151
      write_exp_elt_opcode (BINOP_ASSIGN);
1152
    }
1153
}
1154
 
1155
static void
1156
parse_then_alternative ()
1157
{
1158
  expect (THEN, "missing 'THEN' in 'IF' expression");
1159
  parse_expr ();
1160
}
1161
 
1162
static void
1163
parse_else_alternative ()
1164
{
1165
  if (check_token (ELSIF))
1166
    parse_if_expression_body ();
1167
  else if (check_token (ELSE))
1168
    parse_expr ();
1169
  else
1170
    error ("missing ELSE/ELSIF in IF expression");
1171
}
1172
 
1173
/* Matches: <boolean expression> <then alternative> <else alternative> */
1174
 
1175
static void
1176
parse_if_expression_body ()
1177
{
1178
  parse_expr ();
1179
  parse_then_alternative ();
1180
  parse_else_alternative ();
1181
  write_exp_elt_opcode (TERNOP_COND);
1182
}
1183
 
1184
static void
1185
parse_if_expression ()
1186
{
1187
  require (IF);
1188
  parse_if_expression_body ();
1189
  expect (FI, "missing 'FI' at end of conditional expression");
1190
}
1191
 
1192
/* An <untyped_expr> is a superset of <expr>.  It also includes
1193
   <conditional expressions> and untyped <tuples>, whose types
1194
   are not given by their constituents.  Hence, these are only
1195
   allowed in certain contexts that expect a certain type.
1196
   You should call convert() to fix up the <untyped_expr>. */
1197
 
1198
static void
1199
parse_untyped_expr ()
1200
{
1201
  switch (PEEK_TOKEN ())
1202
    {
1203
    case IF:
1204
      parse_if_expression ();
1205
      return;
1206
    case CASE:
1207
      error ("not implemented:  CASE expression");
1208
    case '(':
1209
      switch (PEEK_TOKEN1 ())
1210
        {
1211
        case IF:
1212
        case CASE:
1213
          goto skip_lprn;
1214
        case '[':
1215
        skip_lprn:
1216
          FORWARD_TOKEN ();
1217
          parse_untyped_expr ();
1218
          expect (')', "missing ')'");
1219
          return;
1220
        default:;
1221
          /* fall through */
1222
        }
1223
    default:
1224
      parse_operand0 ();
1225
    }
1226
}
1227
 
1228
int
1229
chill_parse ()
1230
{
1231
  terminal_buffer[0] = TOKEN_NOT_READ;
1232
  if (PEEK_TOKEN () == TYPENAME && PEEK_TOKEN1 () == END_TOKEN)
1233
    {
1234
      write_exp_elt_opcode (OP_TYPE);
1235
      write_exp_elt_type (PEEK_LVAL ().tsym.type);
1236
      write_exp_elt_opcode (OP_TYPE);
1237
      FORWARD_TOKEN ();
1238
    }
1239
  else
1240
    parse_expr ();
1241
  if (terminal_buffer[0] != END_TOKEN)
1242
    {
1243
      if (comma_terminates && terminal_buffer[0] == ',')
1244
        lexptr--;               /* Put the comma back.  */
1245
      else
1246
        error ("Junk after end of expression.");
1247
    }
1248
  return 0;
1249
}
1250
 
1251
 
1252
/* Implementation of a dynamically expandable buffer for processing input
1253
   characters acquired through lexptr and building a value to return in
1254
   yylval. */
1255
 
1256
static char *tempbuf;           /* Current buffer contents */
1257
static int tempbufsize;         /* Size of allocated buffer */
1258
static int tempbufindex;        /* Current index into buffer */
1259
 
1260
#define GROWBY_MIN_SIZE 64      /* Minimum amount to grow buffer by */
1261
 
1262
#define CHECKBUF(size) \
1263
  do { \
1264
    if (tempbufindex + (size) >= tempbufsize) \
1265
      { \
1266
        growbuf_by_size (size); \
1267
      } \
1268
  } while (0);
1269
 
1270
/* Grow the static temp buffer if necessary, including allocating the first one
1271
   on demand. */
1272
 
1273
static void
1274
growbuf_by_size (count)
1275
     int count;
1276
{
1277
  int growby;
1278
 
1279
  growby = max (count, GROWBY_MIN_SIZE);
1280
  tempbufsize += growby;
1281
  if (tempbuf == NULL)
1282
    {
1283
      tempbuf = (char *) xmalloc (tempbufsize);
1284
    }
1285
  else
1286
    {
1287
      tempbuf = (char *) xrealloc (tempbuf, tempbufsize);
1288
    }
1289
}
1290
 
1291
/* Try to consume a simple name string token.  If successful, returns
1292
   a pointer to a nullbyte terminated copy of the name that can be used
1293
   in symbol table lookups.  If not successful, returns NULL. */
1294
 
1295
static char *
1296
match_simple_name_string ()
1297
{
1298
  char *tokptr = lexptr;
1299
 
1300
  if (isalpha (*tokptr) || *tokptr == '_')
1301
    {
1302
      char *result;
1303
      do
1304
        {
1305
          tokptr++;
1306
        }
1307
      while (isalnum (*tokptr) || (*tokptr == '_'));
1308
      yylval.sval.ptr = lexptr;
1309
      yylval.sval.length = tokptr - lexptr;
1310
      lexptr = tokptr;
1311
      result = copy_name (yylval.sval);
1312
      return result;
1313
    }
1314
  return (NULL);
1315
}
1316
 
1317
/* Start looking for a value composed of valid digits as set by the base
1318
   in use.  Note that '_' characters are valid anywhere, in any quantity,
1319
   and are simply ignored.  Since we must find at least one valid digit,
1320
   or reject this token as an integer literal, we keep track of how many
1321
   digits we have encountered. */
1322
 
1323
static int
1324
decode_integer_value (base, tokptrptr, ivalptr)
1325
     int base;
1326
     char **tokptrptr;
1327
     LONGEST *ivalptr;
1328
{
1329
  char *tokptr = *tokptrptr;
1330
  int temp;
1331
  int digits = 0;
1332
 
1333
  while (*tokptr != '\0')
1334
    {
1335
      temp = *tokptr;
1336
      if (isupper (temp))
1337
        temp = tolower (temp);
1338
      tokptr++;
1339
      switch (temp)
1340
        {
1341
        case '_':
1342
          continue;
1343
        case '0':
1344
        case '1':
1345
        case '2':
1346
        case '3':
1347
        case '4':
1348
        case '5':
1349
        case '6':
1350
        case '7':
1351
        case '8':
1352
        case '9':
1353
          temp -= '0';
1354
          break;
1355
        case 'a':
1356
        case 'b':
1357
        case 'c':
1358
        case 'd':
1359
        case 'e':
1360
        case 'f':
1361
          temp -= 'a';
1362
          temp += 10;
1363
          break;
1364
        default:
1365
          temp = base;
1366
          break;
1367
        }
1368
      if (temp < base)
1369
        {
1370
          digits++;
1371
          *ivalptr *= base;
1372
          *ivalptr += temp;
1373
        }
1374
      else
1375
        {
1376
          /* Found something not in domain for current base. */
1377
          tokptr--;             /* Unconsume what gave us indigestion. */
1378
          break;
1379
        }
1380
    }
1381
 
1382
  /* If we didn't find any digits, then we don't have a valid integer
1383
     value, so reject the entire token.  Otherwise, update the lexical
1384
     scan pointer, and return non-zero for success. */
1385
 
1386
  if (digits == 0)
1387
    {
1388
      return (0);
1389
    }
1390
  else
1391
    {
1392
      *tokptrptr = tokptr;
1393
      return (1);
1394
    }
1395
}
1396
 
1397
static int
1398
decode_integer_literal (valptr, tokptrptr)
1399
     LONGEST *valptr;
1400
     char **tokptrptr;
1401
{
1402
  char *tokptr = *tokptrptr;
1403
  int base = 0;
1404
  LONGEST ival = 0;
1405
  int explicit_base = 0;
1406
 
1407
  /* Look for an explicit base specifier, which is optional. */
1408
 
1409
  switch (*tokptr)
1410
    {
1411
    case 'd':
1412
    case 'D':
1413
      explicit_base++;
1414
      base = 10;
1415
      tokptr++;
1416
      break;
1417
    case 'b':
1418
    case 'B':
1419
      explicit_base++;
1420
      base = 2;
1421
      tokptr++;
1422
      break;
1423
    case 'h':
1424
    case 'H':
1425
      explicit_base++;
1426
      base = 16;
1427
      tokptr++;
1428
      break;
1429
    case 'o':
1430
    case 'O':
1431
      explicit_base++;
1432
      base = 8;
1433
      tokptr++;
1434
      break;
1435
    default:
1436
      base = 10;
1437
      break;
1438
    }
1439
 
1440
  /* If we found an explicit base ensure that the character after the
1441
     explicit base is a single quote. */
1442
 
1443
  if (explicit_base && (*tokptr++ != '\''))
1444
    {
1445
      return (0);
1446
    }
1447
 
1448
  /* Attempt to decode whatever follows as an integer value in the
1449
     indicated base, updating the token pointer in the process and
1450
     computing the value into ival.  Also, if we have an explicit
1451
     base, then the next character must not be a single quote, or we
1452
     have a bitstring literal, so reject the entire token in this case.
1453
     Otherwise, update the lexical scan pointer, and return non-zero
1454
     for success. */
1455
 
1456
  if (!decode_integer_value (base, &tokptr, &ival))
1457
    {
1458
      return (0);
1459
    }
1460
  else if (explicit_base && (*tokptr == '\''))
1461
    {
1462
      return (0);
1463
    }
1464
  else
1465
    {
1466
      *valptr = ival;
1467
      *tokptrptr = tokptr;
1468
      return (1);
1469
    }
1470
}
1471
 
1472
/*  If it wasn't for the fact that floating point values can contain '_'
1473
   characters, we could just let strtod do all the hard work by letting it
1474
   try to consume as much of the current token buffer as possible and
1475
   find a legal conversion.  Unfortunately we need to filter out the '_'
1476
   characters before calling strtod, which we do by copying the other
1477
   legal chars to a local buffer to be converted.  However since we also
1478
   need to keep track of where the last unconsumed character in the input
1479
   buffer is, we have transfer only as many characters as may compose a
1480
   legal floating point value. */
1481
 
1482
static enum ch_terminal
1483
match_float_literal ()
1484
{
1485
  char *tokptr = lexptr;
1486
  char *buf;
1487
  char *copy;
1488
  double dval;
1489
  extern double strtod ();
1490
 
1491
  /* Make local buffer in which to build the string to convert.  This is
1492
     required because underscores are valid in chill floating point numbers
1493
     but not in the string passed to strtod to convert.  The string will be
1494
     no longer than our input string. */
1495
 
1496
  copy = buf = (char *) alloca (strlen (tokptr) + 1);
1497
 
1498
  /* Transfer all leading digits to the conversion buffer, discarding any
1499
     underscores. */
1500
 
1501
  while (isdigit (*tokptr) || *tokptr == '_')
1502
    {
1503
      if (*tokptr != '_')
1504
        {
1505
          *copy++ = *tokptr;
1506
        }
1507
      tokptr++;
1508
    }
1509
 
1510
  /* Now accept either a '.', or one of [eEdD].  Dot is legal regardless
1511
     of whether we found any leading digits, and we simply accept it and
1512
     continue on to look for the fractional part and/or exponent.  One of
1513
     [eEdD] is legal only if we have seen digits, and means that there
1514
     is no fractional part.  If we find neither of these, then this is
1515
     not a floating point number, so return failure. */
1516
 
1517
  switch (*tokptr++)
1518
    {
1519
    case '.':
1520
      /* Accept and then look for fractional part and/or exponent. */
1521
      *copy++ = '.';
1522
      break;
1523
 
1524
    case 'e':
1525
    case 'E':
1526
    case 'd':
1527
    case 'D':
1528
      if (copy == buf)
1529
        {
1530
          return (0);
1531
        }
1532
      *copy++ = 'e';
1533
      goto collect_exponent;
1534
      break;
1535
 
1536
    default:
1537
      return (0);
1538
      break;
1539
    }
1540
 
1541
  /* We found a '.', copy any fractional digits to the conversion buffer, up
1542
     to the first nondigit, non-underscore character. */
1543
 
1544
  while (isdigit (*tokptr) || *tokptr == '_')
1545
    {
1546
      if (*tokptr != '_')
1547
        {
1548
          *copy++ = *tokptr;
1549
        }
1550
      tokptr++;
1551
    }
1552
 
1553
  /* Look for an exponent, which must start with one of [eEdD].  If none
1554
     is found, jump directly to trying to convert what we have collected
1555
     so far. */
1556
 
1557
  switch (*tokptr)
1558
    {
1559
    case 'e':
1560
    case 'E':
1561
    case 'd':
1562
    case 'D':
1563
      *copy++ = 'e';
1564
      tokptr++;
1565
      break;
1566
    default:
1567
      goto convert_float;
1568
      break;
1569
    }
1570
 
1571
  /* Accept an optional '-' or '+' following one of [eEdD]. */
1572
 
1573
collect_exponent:
1574
  if (*tokptr == '+' || *tokptr == '-')
1575
    {
1576
      *copy++ = *tokptr++;
1577
    }
1578
 
1579
  /* Now copy an exponent into the conversion buffer.  Note that at the
1580
     moment underscores are *not* allowed in exponents. */
1581
 
1582
  while (isdigit (*tokptr))
1583
    {
1584
      *copy++ = *tokptr++;
1585
    }
1586
 
1587
  /* If we transfered any chars to the conversion buffer, try to interpret its
1588
     contents as a floating point value.  If any characters remain, then we
1589
     must not have a valid floating point string. */
1590
 
1591
convert_float:
1592
  *copy = '\0';
1593
  if (copy != buf)
1594
    {
1595
      dval = strtod (buf, &copy);
1596
      if (*copy == '\0')
1597
        {
1598
          yylval.dval = dval;
1599
          lexptr = tokptr;
1600
          return (FLOAT_LITERAL);
1601
        }
1602
    }
1603
  return (0);
1604
}
1605
 
1606
/* Recognize a string literal.  A string literal is a sequence
1607
   of characters enclosed in matching single or double quotes, except that
1608
   a single character inside single quotes is a character literal, which
1609
   we reject as a string literal.  To embed the terminator character inside
1610
   a string, it is simply doubled (I.E. "this""is""one""string") */
1611
 
1612
static enum ch_terminal
1613
match_string_literal ()
1614
{
1615
  char *tokptr = lexptr;
1616
  int in_ctrlseq = 0;
1617
  LONGEST ival;
1618
 
1619
  for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1620
    {
1621
      CHECKBUF (1);
1622
    tryagain:;
1623
      if (in_ctrlseq)
1624
        {
1625
          /* skip possible whitespaces */
1626
          while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
1627
            tokptr++;
1628
          if (*tokptr == ')')
1629
            {
1630
              in_ctrlseq = 0;
1631
              tokptr++;
1632
              goto tryagain;
1633
            }
1634
          else if (*tokptr != ',')
1635
            error ("Invalid control sequence");
1636
          tokptr++;
1637
          /* skip possible whitespaces */
1638
          while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
1639
            tokptr++;
1640
          if (!decode_integer_literal (&ival, &tokptr))
1641
            error ("Invalid control sequence");
1642
          tokptr--;
1643
        }
1644
      else if (*tokptr == *lexptr)
1645
        {
1646
          if (*(tokptr + 1) == *lexptr)
1647
            {
1648
              ival = *tokptr++;
1649
            }
1650
          else
1651
            {
1652
              break;
1653
            }
1654
        }
1655
      else if (*tokptr == '^')
1656
        {
1657
          if (*(tokptr + 1) == '(')
1658
            {
1659
              in_ctrlseq = 1;
1660
              tokptr += 2;
1661
              if (!decode_integer_literal (&ival, &tokptr))
1662
                error ("Invalid control sequence");
1663
              tokptr--;
1664
            }
1665
          else if (*(tokptr + 1) == '^')
1666
            ival = *tokptr++;
1667
          else
1668
            error ("Invalid control sequence");
1669
        }
1670
      else
1671
        ival = *tokptr;
1672
      tempbuf[tempbufindex++] = ival;
1673
    }
1674
  if (in_ctrlseq)
1675
    error ("Invalid control sequence");
1676
 
1677
  if (*tokptr == '\0'           /* no terminator */
1678
      || (tempbufindex == 1 && *tokptr == '\''))        /* char literal */
1679
    {
1680
      return (0);
1681
    }
1682
  else
1683
    {
1684
      tempbuf[tempbufindex] = '\0';
1685
      yylval.sval.ptr = tempbuf;
1686
      yylval.sval.length = tempbufindex;
1687
      lexptr = ++tokptr;
1688
      return (CHARACTER_STRING_LITERAL);
1689
    }
1690
}
1691
 
1692
/* Recognize a character literal.  A character literal is single character
1693
   or a control sequence, enclosed in single quotes.  A control sequence
1694
   is a comma separated list of one or more integer literals, enclosed
1695
   in parenthesis and introduced with a circumflex character.
1696
 
1697
   EX:  'a'  '^(7)'  '^(7,8)'
1698
 
1699
   As a GNU chill extension, the syntax C'xx' is also recognized as a
1700
   character literal, where xx is a hex value for the character.
1701
 
1702
   Note that more than a single character, enclosed in single quotes, is
1703
   a string literal.
1704
 
1705
   Returns CHARACTER_LITERAL if a match is found.
1706
 */
1707
 
1708
static enum ch_terminal
1709
match_character_literal ()
1710
{
1711
  char *tokptr = lexptr;
1712
  LONGEST ival = 0;
1713
 
1714
  if ((*tokptr == 'c' || *tokptr == 'C') && (*(tokptr + 1) == '\''))
1715
    {
1716
      /* We have a GNU chill extension form, so skip the leading "C'",
1717
         decode the hex value, and then ensure that we have a trailing
1718
         single quote character. */
1719
      tokptr += 2;
1720
      if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
1721
        {
1722
          return (0);
1723
        }
1724
      tokptr++;
1725
    }
1726
  else if (*tokptr == '\'')
1727
    {
1728
      tokptr++;
1729
 
1730
      /* Determine which form we have, either a control sequence or the
1731
         single character form. */
1732
 
1733
      if (*tokptr == '^')
1734
        {
1735
          if (*(tokptr + 1) == '(')
1736
            {
1737
              /* Match and decode a control sequence.  Return zero if we don't
1738
                 find a valid integer literal, or if the next unconsumed character
1739
                 after the integer literal is not the trailing ')'. */
1740
              tokptr += 2;
1741
              if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
1742
                {
1743
                  return (0);
1744
                }
1745
            }
1746
          else if (*(tokptr + 1) == '^')
1747
            {
1748
              ival = *tokptr;
1749
              tokptr += 2;
1750
            }
1751
          else
1752
            /* fail */
1753
            error ("Invalid control sequence");
1754
        }
1755
      else if (*tokptr == '\'')
1756
        {
1757
          /* this must be duplicated */
1758
          ival = *tokptr;
1759
          tokptr += 2;
1760
        }
1761
      else
1762
        {
1763
          ival = *tokptr++;
1764
        }
1765
 
1766
      /* The trailing quote has not yet been consumed.  If we don't find
1767
         it, then we have no match. */
1768
 
1769
      if (*tokptr++ != '\'')
1770
        {
1771
          return (0);
1772
        }
1773
    }
1774
  else
1775
    {
1776
      /* Not a character literal. */
1777
      return (0);
1778
    }
1779
  yylval.typed_val.val = ival;
1780
  yylval.typed_val.type = builtin_type_chill_char;
1781
  lexptr = tokptr;
1782
  return (CHARACTER_LITERAL);
1783
}
1784
 
1785
/* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1786
   Note that according to 5.2.4.2, a single "_" is also a valid integer
1787
   literal, however GNU-chill requires there to be at least one "digit"
1788
   in any integer literal. */
1789
 
1790
static enum ch_terminal
1791
match_integer_literal ()
1792
{
1793
  char *tokptr = lexptr;
1794
  LONGEST ival;
1795
 
1796
  if (!decode_integer_literal (&ival, &tokptr))
1797
    {
1798
      return (0);
1799
    }
1800
  else
1801
    {
1802
      yylval.typed_val.val = ival;
1803
#if defined(CC_HAS_LONG_LONG) && defined(__STDC__)
1804
      if (ival > (LONGEST) 2147483647U || ival < -(LONGEST) 2147483648U)
1805
        yylval.typed_val.type = builtin_type_long_long;
1806
      else
1807
#endif
1808
        yylval.typed_val.type = builtin_type_int;
1809
      lexptr = tokptr;
1810
      return (INTEGER_LITERAL);
1811
    }
1812
}
1813
 
1814
/* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
1815
   Note that according to 5.2.4.8, a single "_" is also a valid bit-string
1816
   literal, however GNU-chill requires there to be at least one "digit"
1817
   in any bit-string literal. */
1818
 
1819
static enum ch_terminal
1820
match_bitstring_literal ()
1821
{
1822
  register char *tokptr = lexptr;
1823
  int bitoffset = 0;
1824
  int bitcount = 0;
1825
  int bits_per_char;
1826
  int digit;
1827
 
1828
  tempbufindex = 0;
1829
  CHECKBUF (1);
1830
  tempbuf[0] = 0;
1831
 
1832
  /* Look for the required explicit base specifier. */
1833
 
1834
  switch (*tokptr++)
1835
    {
1836
    case 'b':
1837
    case 'B':
1838
      bits_per_char = 1;
1839
      break;
1840
    case 'o':
1841
    case 'O':
1842
      bits_per_char = 3;
1843
      break;
1844
    case 'h':
1845
    case 'H':
1846
      bits_per_char = 4;
1847
      break;
1848
    default:
1849
      return (0);
1850
      break;
1851
    }
1852
 
1853
  /* Ensure that the character after the explicit base is a single quote. */
1854
 
1855
  if (*tokptr++ != '\'')
1856
    {
1857
      return (0);
1858
    }
1859
 
1860
  while (*tokptr != '\0' && *tokptr != '\'')
1861
    {
1862
      digit = *tokptr;
1863
      if (isupper (digit))
1864
        digit = tolower (digit);
1865
      tokptr++;
1866
      switch (digit)
1867
        {
1868
        case '_':
1869
          continue;
1870
        case '0':
1871
        case '1':
1872
        case '2':
1873
        case '3':
1874
        case '4':
1875
        case '5':
1876
        case '6':
1877
        case '7':
1878
        case '8':
1879
        case '9':
1880
          digit -= '0';
1881
          break;
1882
        case 'a':
1883
        case 'b':
1884
        case 'c':
1885
        case 'd':
1886
        case 'e':
1887
        case 'f':
1888
          digit -= 'a';
1889
          digit += 10;
1890
          break;
1891
        default:
1892
          /* this is not a bitstring literal, probably an integer */
1893
          return 0;
1894
        }
1895
      if (digit >= 1 << bits_per_char)
1896
        {
1897
          /* Found something not in domain for current base. */
1898
          error ("Too-large digit in bitstring or integer.");
1899
        }
1900
      else
1901
        {
1902
          /* Extract bits from digit, packing them into the bitstring byte. */
1903
          int k = TARGET_BYTE_ORDER == BIG_ENDIAN ? bits_per_char - 1 : 0;
1904
          for (; TARGET_BYTE_ORDER == BIG_ENDIAN ? k >= 0 : k < bits_per_char;
1905
               TARGET_BYTE_ORDER == BIG_ENDIAN ? k-- : k++)
1906
            {
1907
              bitcount++;
1908
              if (digit & (1 << k))
1909
                {
1910
                  tempbuf[tempbufindex] |=
1911
                    (TARGET_BYTE_ORDER == BIG_ENDIAN)
1912
                    ? (1 << (HOST_CHAR_BIT - 1 - bitoffset))
1913
                    : (1 << bitoffset);
1914
                }
1915
              bitoffset++;
1916
              if (bitoffset == HOST_CHAR_BIT)
1917
                {
1918
                  bitoffset = 0;
1919
                  tempbufindex++;
1920
                  CHECKBUF (1);
1921
                  tempbuf[tempbufindex] = 0;
1922
                }
1923
            }
1924
        }
1925
    }
1926
 
1927
  /* Verify that we consumed everything up to the trailing single quote,
1928
     and that we found some bits (IE not just underbars). */
1929
 
1930
  if (*tokptr++ != '\'')
1931
    {
1932
      return (0);
1933
    }
1934
  else
1935
    {
1936
      yylval.sval.ptr = tempbuf;
1937
      yylval.sval.length = bitcount;
1938
      lexptr = tokptr;
1939
      return (BIT_STRING_LITERAL);
1940
    }
1941
}
1942
 
1943
struct token
1944
{
1945
  char *operator;
1946
  int token;
1947
};
1948
 
1949
static const struct token idtokentab[] =
1950
{
1951
  {"array", ARRAY},
1952
  {"length", LENGTH},
1953
  {"lower", LOWER},
1954
  {"upper", UPPER},
1955
  {"andif", ANDIF},
1956
  {"pred", PRED},
1957
  {"succ", SUCC},
1958
  {"card", CARD},
1959
  {"size", SIZE},
1960
  {"orif", ORIF},
1961
  {"num", NUM},
1962
  {"abs", ABS},
1963
  {"max", MAX_TOKEN},
1964
  {"min", MIN_TOKEN},
1965
  {"mod", MOD},
1966
  {"rem", REM},
1967
  {"not", NOT},
1968
  {"xor", LOGXOR},
1969
  {"and", LOGAND},
1970
  {"in", IN},
1971
  {"or", LOGIOR},
1972
  {"up", UP},
1973
  {"addr", ADDR_TOKEN},
1974
  {"null", EMPTINESS_LITERAL}
1975
};
1976
 
1977
static const struct token tokentab2[] =
1978
{
1979
  {":=", GDB_ASSIGNMENT},
1980
  {"//", SLASH_SLASH},
1981
  {"->", POINTER},
1982
  {"/=", NOTEQUAL},
1983
  {"<=", LEQ},
1984
  {">=", GEQ}
1985
};
1986
 
1987
/* Read one token, getting characters through lexptr.  */
1988
/* This is where we will check to make sure that the language and the
1989
   operators used are compatible.  */
1990
 
1991
static enum ch_terminal
1992
ch_lex ()
1993
{
1994
  unsigned int i;
1995
  enum ch_terminal token;
1996
  char *inputname;
1997
  struct symbol *sym;
1998
 
1999
  /* Skip over any leading whitespace. */
2000
  while (isspace (*lexptr))
2001
    {
2002
      lexptr++;
2003
    }
2004
  /* Look for special single character cases which can't be the first
2005
     character of some other multicharacter token. */
2006
  switch (*lexptr)
2007
    {
2008
    case '\0':
2009
      return END_TOKEN;
2010
    case ',':
2011
    case '=':
2012
    case ';':
2013
    case '!':
2014
    case '+':
2015
    case '*':
2016
    case '(':
2017
    case ')':
2018
    case '[':
2019
    case ']':
2020
      return (*lexptr++);
2021
    }
2022
  /* Look for characters which start a particular kind of multicharacter
2023
     token, such as a character literal, register name, convenience
2024
     variable name, string literal, etc. */
2025
  switch (*lexptr)
2026
    {
2027
    case '\'':
2028
    case '\"':
2029
      /* First try to match a string literal, which is any
2030
         sequence of characters enclosed in matching single or double
2031
         quotes, except that a single character inside single quotes
2032
         is a character literal, so we have to catch that case also. */
2033
      token = match_string_literal ();
2034
      if (token != 0)
2035
        {
2036
          return (token);
2037
        }
2038
      if (*lexptr == '\'')
2039
        {
2040
          token = match_character_literal ();
2041
          if (token != 0)
2042
            {
2043
              return (token);
2044
            }
2045
        }
2046
      break;
2047
    case 'C':
2048
    case 'c':
2049
      token = match_character_literal ();
2050
      if (token != 0)
2051
        {
2052
          return (token);
2053
        }
2054
      break;
2055
    case '$':
2056
      yylval.sval.ptr = lexptr;
2057
      do
2058
        {
2059
          lexptr++;
2060
        }
2061
      while (isalnum (*lexptr) || *lexptr == '_' || *lexptr == '$');
2062
      yylval.sval.length = lexptr - yylval.sval.ptr;
2063
      write_dollar_variable (yylval.sval);
2064
      return GDB_VARIABLE;
2065
      break;
2066
    }
2067
  /* See if it is a special token of length 2.  */
2068
  for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
2069
    {
2070
      if (STREQN (lexptr, tokentab2[i].operator, 2))
2071
        {
2072
          lexptr += 2;
2073
          return (tokentab2[i].token);
2074
        }
2075
    }
2076
  /* Look for single character cases which which could be the first
2077
     character of some other multicharacter token, but aren't, or we
2078
     would already have found it. */
2079
  switch (*lexptr)
2080
    {
2081
    case '-':
2082
    case ':':
2083
    case '/':
2084
    case '<':
2085
    case '>':
2086
      return (*lexptr++);
2087
    }
2088
  /* Look for a float literal before looking for an integer literal, so
2089
     we match as much of the input stream as possible. */
2090
  token = match_float_literal ();
2091
  if (token != 0)
2092
    {
2093
      return (token);
2094
    }
2095
  token = match_bitstring_literal ();
2096
  if (token != 0)
2097
    {
2098
      return (token);
2099
    }
2100
  token = match_integer_literal ();
2101
  if (token != 0)
2102
    {
2103
      return (token);
2104
    }
2105
 
2106
  /* Try to match a simple name string, and if a match is found, then
2107
     further classify what sort of name it is and return an appropriate
2108
     token.  Note that attempting to match a simple name string consumes
2109
     the token from lexptr, so we can't back out if we later find that
2110
     we can't classify what sort of name it is. */
2111
 
2112
  inputname = match_simple_name_string ();
2113
 
2114
  if (inputname != NULL)
2115
    {
2116
      char *simplename = (char *) alloca (strlen (inputname) + 1);
2117
 
2118
      char *dptr = simplename, *sptr = inputname;
2119
      for (; *sptr; sptr++)
2120
        *dptr++ = isupper (*sptr) ? tolower (*sptr) : *sptr;
2121
      *dptr = '\0';
2122
 
2123
      /* See if it is a reserved identifier. */
2124
      for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
2125
        {
2126
          if (STREQ (simplename, idtokentab[i].operator))
2127
            {
2128
              return (idtokentab[i].token);
2129
            }
2130
        }
2131
 
2132
      /* Look for other special tokens. */
2133
      if (STREQ (simplename, "true"))
2134
        {
2135
          yylval.ulval = 1;
2136
          return (BOOLEAN_LITERAL);
2137
        }
2138
      if (STREQ (simplename, "false"))
2139
        {
2140
          yylval.ulval = 0;
2141
          return (BOOLEAN_LITERAL);
2142
        }
2143
 
2144
      sym = lookup_symbol (inputname, expression_context_block,
2145
                           VAR_NAMESPACE, (int *) NULL,
2146
                           (struct symtab **) NULL);
2147
      if (sym == NULL && strcmp (inputname, simplename) != 0)
2148
        {
2149
          sym = lookup_symbol (simplename, expression_context_block,
2150
                               VAR_NAMESPACE, (int *) NULL,
2151
                               (struct symtab **) NULL);
2152
        }
2153
      if (sym != NULL)
2154
        {
2155
          yylval.ssym.stoken.ptr = NULL;
2156
          yylval.ssym.stoken.length = 0;
2157
          yylval.ssym.sym = sym;
2158
          yylval.ssym.is_a_field_of_this = 0;    /* FIXME, C++'ism */
2159
          switch (SYMBOL_CLASS (sym))
2160
            {
2161
            case LOC_BLOCK:
2162
              /* Found a procedure name. */
2163
              return (GENERAL_PROCEDURE_NAME);
2164
            case LOC_STATIC:
2165
              /* Found a global or local static variable. */
2166
              return (LOCATION_NAME);
2167
            case LOC_REGISTER:
2168
            case LOC_ARG:
2169
            case LOC_REF_ARG:
2170
            case LOC_REGPARM:
2171
            case LOC_REGPARM_ADDR:
2172
            case LOC_LOCAL:
2173
            case LOC_LOCAL_ARG:
2174
            case LOC_BASEREG:
2175
            case LOC_BASEREG_ARG:
2176
              if (innermost_block == NULL
2177
                  || contained_in (block_found, innermost_block))
2178
                {
2179
                  innermost_block = block_found;
2180
                }
2181
              return (LOCATION_NAME);
2182
              break;
2183
            case LOC_CONST:
2184
            case LOC_LABEL:
2185
              return (LOCATION_NAME);
2186
              break;
2187
            case LOC_TYPEDEF:
2188
              yylval.tsym.type = SYMBOL_TYPE (sym);
2189
              return TYPENAME;
2190
            case LOC_UNDEF:
2191
            case LOC_CONST_BYTES:
2192
            case LOC_OPTIMIZED_OUT:
2193
              error ("Symbol \"%s\" names no location.", inputname);
2194
              break;
2195
            default:
2196
              internal_error ("unhandled SYMBOL_CLASS in ch_lex()");
2197
              break;
2198
            }
2199
        }
2200
      else if (!have_full_symbols () && !have_partial_symbols ())
2201
        {
2202
          error ("No symbol table is loaded.  Use the \"file\" command.");
2203
        }
2204
      else
2205
        {
2206
          error ("No symbol \"%s\" in current context.", inputname);
2207
        }
2208
    }
2209
 
2210
  /* Catch single character tokens which are not part of some
2211
     longer token. */
2212
 
2213
  switch (*lexptr)
2214
    {
2215
    case '.':                   /* Not float for example. */
2216
      lexptr++;
2217
      while (isspace (*lexptr))
2218
        lexptr++;
2219
      inputname = match_simple_name_string ();
2220
      if (!inputname)
2221
        return '.';
2222
      return DOT_FIELD_NAME;
2223
    }
2224
 
2225
  return (ILLEGAL_TOKEN);
2226
}
2227
 
2228
static void
2229
write_lower_upper_value (opcode, type)
2230
     enum exp_opcode opcode;    /* Either UNOP_LOWER or UNOP_UPPER */
2231
     struct type *type;
2232
{
2233
  if (type == NULL)
2234
    write_exp_elt_opcode (opcode);
2235
  else
2236
    {
2237
      struct type *result_type;
2238
      LONGEST val = type_lower_upper (opcode, type, &result_type);
2239
      write_exp_elt_opcode (OP_LONG);
2240
      write_exp_elt_type (result_type);
2241
      write_exp_elt_longcst (val);
2242
      write_exp_elt_opcode (OP_LONG);
2243
    }
2244
}
2245
 
2246
void
2247
chill_error (msg)
2248
     char *msg;
2249
{
2250
  /* Never used. */
2251
}

powered by: WebSVN 2.1.0

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