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