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