119370Spst/* YACC grammar for Modula-2 expressions, for GDB. 298944Sobrien Copyright 1986, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1999, 398944Sobrien 2000 419370Spst Free Software Foundation, Inc. 519370Spst Generated from expread.y (now c-exp.y) and contributed by the Department 619370Spst of Computer Science at the State University of New York at Buffalo, 1991. 719370Spst 819370SpstThis file is part of GDB. 919370Spst 1019370SpstThis program is free software; you can redistribute it and/or modify 1119370Spstit under the terms of the GNU General Public License as published by 1219370Spstthe Free Software Foundation; either version 2 of the License, or 1319370Spst(at your option) any later version. 1419370Spst 1519370SpstThis program is distributed in the hope that it will be useful, 1619370Spstbut WITHOUT ANY WARRANTY; without even the implied warranty of 1719370SpstMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 1819370SpstGNU General Public License for more details. 1919370Spst 2019370SpstYou should have received a copy of the GNU General Public License 2119370Spstalong with this program; if not, write to the Free Software 2219370SpstFoundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ 2319370Spst 2419370Spst/* Parse a Modula-2 expression from text in a string, 2519370Spst and return the result as a struct expression pointer. 2619370Spst That structure contains arithmetic operations in reverse polish, 2719370Spst with constants represented by operations that are followed by special data. 2819370Spst See expression.h for the details of the format. 2919370Spst What is important here is that it can be built up sequentially 3019370Spst during the process of parsing; the lower levels of the tree always 3119370Spst come first in the result. 3219370Spst 3319370Spst Note that malloc's and realloc's in this file are transformed to 3419370Spst xmalloc and xrealloc respectively by the same sed command in the 3519370Spst makefile that remaps any other malloc/realloc inserted by the parser 3619370Spst generator. Doing this with #defines and trying to control the interaction 3719370Spst with include files (<malloc.h> and <stdlib.h> for example) just became 3819370Spst too messy, particularly when such includes can be inserted at random 3919370Spst times by the parser generator. */ 4019370Spst 4119370Spst%{ 4219370Spst 4319370Spst#include "defs.h" 4419370Spst#include "gdb_string.h" 4519370Spst#include "expression.h" 4619370Spst#include "language.h" 4719370Spst#include "value.h" 4819370Spst#include "parser-defs.h" 4919370Spst#include "m2-lang.h" 5019370Spst#include "bfd.h" /* Required by objfiles.h. */ 5119370Spst#include "symfile.h" /* Required by objfiles.h. */ 5219370Spst#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */ 53130803Smarcel#include "block.h" 5419370Spst 5519370Spst/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc), 5619370Spst as well as gratuitiously global symbol names, so we can have multiple 5719370Spst yacc generated parsers in gdb. Note that these are only the variables 5819370Spst produced by yacc. If other parser generators (bison, byacc, etc) produce 5919370Spst additional global names that conflict at link time, then those parser 6019370Spst generators need to be fixed instead of adding those names to this list. */ 6119370Spst 6219370Spst#define yymaxdepth m2_maxdepth 6319370Spst#define yyparse m2_parse 6419370Spst#define yylex m2_lex 6519370Spst#define yyerror m2_error 6619370Spst#define yylval m2_lval 6719370Spst#define yychar m2_char 6819370Spst#define yydebug m2_debug 6919370Spst#define yypact m2_pact 7019370Spst#define yyr1 m2_r1 7119370Spst#define yyr2 m2_r2 7219370Spst#define yydef m2_def 7319370Spst#define yychk m2_chk 7419370Spst#define yypgo m2_pgo 7519370Spst#define yyact m2_act 7619370Spst#define yyexca m2_exca 7719370Spst#define yyerrflag m2_errflag 7819370Spst#define yynerrs m2_nerrs 7919370Spst#define yyps m2_ps 8019370Spst#define yypv m2_pv 8119370Spst#define yys m2_s 8219370Spst#define yy_yys m2_yys 8319370Spst#define yystate m2_state 8419370Spst#define yytmp m2_tmp 8519370Spst#define yyv m2_v 8619370Spst#define yy_yyv m2_yyv 8719370Spst#define yyval m2_val 8819370Spst#define yylloc m2_lloc 8919370Spst#define yyreds m2_reds /* With YYDEBUG defined */ 9019370Spst#define yytoks m2_toks /* With YYDEBUG defined */ 91130803Smarcel#define yyname m2_name /* With YYDEBUG defined */ 92130803Smarcel#define yyrule m2_rule /* With YYDEBUG defined */ 9319370Spst#define yylhs m2_yylhs 9419370Spst#define yylen m2_yylen 9519370Spst#define yydefred m2_yydefred 9619370Spst#define yydgoto m2_yydgoto 9719370Spst#define yysindex m2_yysindex 9819370Spst#define yyrindex m2_yyrindex 9919370Spst#define yygindex m2_yygindex 10019370Spst#define yytable m2_yytable 10119370Spst#define yycheck m2_yycheck 10219370Spst 10319370Spst#ifndef YYDEBUG 104130803Smarcel#define YYDEBUG 1 /* Default to yydebug support */ 10519370Spst#endif 10619370Spst 107130803Smarcel#define YYFPRINTF parser_fprintf 108130803Smarcel 10998944Sobrienint yyparse (void); 11019370Spst 11198944Sobrienstatic int yylex (void); 11219370Spst 11398944Sobrienvoid yyerror (char *); 11419370Spst 11519370Spst#if 0 11698944Sobrienstatic char *make_qualname (char *, char *); 11719370Spst#endif 11819370Spst 11998944Sobrienstatic int parse_number (int); 12019370Spst 12119370Spst/* The sign of the number being parsed. */ 12219370Spststatic int number_sign = 1; 12319370Spst 12419370Spst/* The block that the module specified by the qualifer on an identifer is 12519370Spst contained in, */ 12619370Spst#if 0 12719370Spststatic struct block *modblock=0; 12819370Spst#endif 12919370Spst 13019370Spst%} 13119370Spst 13219370Spst/* Although the yacc "value" of an expression is not used, 13319370Spst since the result is stored in the structure being created, 13419370Spst other node types do have values. */ 13519370Spst 13619370Spst%union 13719370Spst { 13819370Spst LONGEST lval; 13946283Sdfr ULONGEST ulval; 14019370Spst DOUBLEST dval; 14119370Spst struct symbol *sym; 14219370Spst struct type *tval; 14319370Spst struct stoken sval; 14419370Spst int voidval; 14519370Spst struct block *bval; 14619370Spst enum exp_opcode opcode; 14719370Spst struct internalvar *ivar; 14819370Spst 14919370Spst struct type **tvec; 15019370Spst int *ivec; 15119370Spst } 15219370Spst 15319370Spst%type <voidval> exp type_exp start set 15419370Spst%type <voidval> variable 15519370Spst%type <tval> type 15619370Spst%type <bval> block 15719370Spst%type <sym> fblock 15819370Spst 15919370Spst%token <lval> INT HEX ERROR 16019370Spst%token <ulval> UINT M2_TRUE M2_FALSE CHAR 16119370Spst%token <dval> FLOAT 16219370Spst 16319370Spst/* Both NAME and TYPENAME tokens represent symbols in the input, 16419370Spst and both convey their data as strings. 16519370Spst But a TYPENAME is a string that happens to be defined as a typedef 16619370Spst or builtin type name (such as int or char) 16719370Spst and a NAME is any other symbol. 16819370Spst 16919370Spst Contexts where this distinction is not important can use the 17019370Spst nonterminal "name", which matches either NAME or TYPENAME. */ 17119370Spst 17219370Spst%token <sval> STRING 17319370Spst%token <sval> NAME BLOCKNAME IDENT VARNAME 17419370Spst%token <sval> TYPENAME 17519370Spst 17619370Spst%token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC 17719370Spst%token INC DEC INCL EXCL 17819370Spst 17919370Spst/* The GDB scope operator */ 18019370Spst%token COLONCOLON 18119370Spst 18219370Spst%token <voidval> INTERNAL_VAR 18319370Spst 18419370Spst/* M2 tokens */ 18519370Spst%left ',' 18619370Spst%left ABOVE_COMMA 18719370Spst%nonassoc ASSIGN 18819370Spst%left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN 18919370Spst%left OROR 19019370Spst%left LOGICAL_AND '&' 19119370Spst%left '@' 19219370Spst%left '+' '-' 19319370Spst%left '*' '/' DIV MOD 19419370Spst%right UNARY 19519370Spst%right '^' DOT '[' '(' 19619370Spst%right NOT '~' 19719370Spst%left COLONCOLON QID 19819370Spst/* This is not an actual token ; it is used for precedence. 19919370Spst%right QID 20019370Spst*/ 20119370Spst 20219370Spst 20319370Spst%% 20419370Spst 20519370Spststart : exp 20619370Spst | type_exp 20719370Spst ; 20819370Spst 20919370Spsttype_exp: type 21019370Spst { write_exp_elt_opcode(OP_TYPE); 21119370Spst write_exp_elt_type($1); 21219370Spst write_exp_elt_opcode(OP_TYPE); 21319370Spst } 21419370Spst ; 21519370Spst 21619370Spst/* Expressions */ 21719370Spst 21819370Spstexp : exp '^' %prec UNARY 21919370Spst { write_exp_elt_opcode (UNOP_IND); } 220130803Smarcel ; 22119370Spst 22219370Spstexp : '-' 22319370Spst { number_sign = -1; } 22419370Spst exp %prec UNARY 22519370Spst { number_sign = 1; 22619370Spst write_exp_elt_opcode (UNOP_NEG); } 22719370Spst ; 22819370Spst 22919370Spstexp : '+' exp %prec UNARY 23019370Spst { write_exp_elt_opcode(UNOP_PLUS); } 23119370Spst ; 23219370Spst 23319370Spstexp : not_exp exp %prec UNARY 23419370Spst { write_exp_elt_opcode (UNOP_LOGICAL_NOT); } 23519370Spst ; 23619370Spst 23719370Spstnot_exp : NOT 23819370Spst | '~' 23919370Spst ; 24019370Spst 24119370Spstexp : CAP '(' exp ')' 24219370Spst { write_exp_elt_opcode (UNOP_CAP); } 24319370Spst ; 24419370Spst 24519370Spstexp : ORD '(' exp ')' 24619370Spst { write_exp_elt_opcode (UNOP_ORD); } 24719370Spst ; 24819370Spst 24919370Spstexp : ABS '(' exp ')' 25019370Spst { write_exp_elt_opcode (UNOP_ABS); } 25119370Spst ; 25219370Spst 25319370Spstexp : HIGH '(' exp ')' 25419370Spst { write_exp_elt_opcode (UNOP_HIGH); } 25519370Spst ; 25619370Spst 25719370Spstexp : MIN_FUNC '(' type ')' 25819370Spst { write_exp_elt_opcode (UNOP_MIN); 25919370Spst write_exp_elt_type ($3); 26019370Spst write_exp_elt_opcode (UNOP_MIN); } 26119370Spst ; 26219370Spst 26319370Spstexp : MAX_FUNC '(' type ')' 26419370Spst { write_exp_elt_opcode (UNOP_MAX); 26519370Spst write_exp_elt_type ($3); 26619370Spst write_exp_elt_opcode (UNOP_MIN); } 26719370Spst ; 26819370Spst 26919370Spstexp : FLOAT_FUNC '(' exp ')' 27019370Spst { write_exp_elt_opcode (UNOP_FLOAT); } 27119370Spst ; 27219370Spst 27319370Spstexp : VAL '(' type ',' exp ')' 27419370Spst { write_exp_elt_opcode (BINOP_VAL); 27519370Spst write_exp_elt_type ($3); 27619370Spst write_exp_elt_opcode (BINOP_VAL); } 27719370Spst ; 27819370Spst 27919370Spstexp : CHR '(' exp ')' 28019370Spst { write_exp_elt_opcode (UNOP_CHR); } 28119370Spst ; 28219370Spst 28319370Spstexp : ODD '(' exp ')' 28419370Spst { write_exp_elt_opcode (UNOP_ODD); } 28519370Spst ; 28619370Spst 28719370Spstexp : TRUNC '(' exp ')' 28819370Spst { write_exp_elt_opcode (UNOP_TRUNC); } 28919370Spst ; 29019370Spst 29119370Spstexp : SIZE exp %prec UNARY 29219370Spst { write_exp_elt_opcode (UNOP_SIZEOF); } 29319370Spst ; 29419370Spst 29519370Spst 29619370Spstexp : INC '(' exp ')' 29719370Spst { write_exp_elt_opcode(UNOP_PREINCREMENT); } 29819370Spst ; 29919370Spst 30019370Spstexp : INC '(' exp ',' exp ')' 30119370Spst { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); 30219370Spst write_exp_elt_opcode(BINOP_ADD); 30319370Spst write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); } 30419370Spst ; 30519370Spst 30619370Spstexp : DEC '(' exp ')' 30719370Spst { write_exp_elt_opcode(UNOP_PREDECREMENT);} 30819370Spst ; 30919370Spst 31019370Spstexp : DEC '(' exp ',' exp ')' 31119370Spst { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); 31219370Spst write_exp_elt_opcode(BINOP_SUB); 31319370Spst write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); } 31419370Spst ; 31519370Spst 31619370Spstexp : exp DOT NAME 31719370Spst { write_exp_elt_opcode (STRUCTOP_STRUCT); 31819370Spst write_exp_string ($3); 31919370Spst write_exp_elt_opcode (STRUCTOP_STRUCT); } 32019370Spst ; 32119370Spst 32219370Spstexp : set 32319370Spst ; 32419370Spst 32519370Spstexp : exp IN set 32619370Spst { error("Sets are not implemented.");} 32719370Spst ; 32819370Spst 32919370Spstexp : INCL '(' exp ',' exp ')' 33019370Spst { error("Sets are not implemented.");} 33119370Spst ; 33219370Spst 33319370Spstexp : EXCL '(' exp ',' exp ')' 33419370Spst { error("Sets are not implemented.");} 335130803Smarcel ; 33619370Spst 33719370Spstset : '{' arglist '}' 33819370Spst { error("Sets are not implemented.");} 33919370Spst | type '{' arglist '}' 34019370Spst { error("Sets are not implemented.");} 34119370Spst ; 34219370Spst 34319370Spst 34419370Spst/* Modula-2 array subscript notation [a,b,c...] */ 34519370Spstexp : exp '[' 34619370Spst /* This function just saves the number of arguments 34719370Spst that follow in the list. It is *not* specific to 34819370Spst function types */ 34919370Spst { start_arglist(); } 35019370Spst non_empty_arglist ']' %prec DOT 35119370Spst { write_exp_elt_opcode (MULTI_SUBSCRIPT); 35219370Spst write_exp_elt_longcst ((LONGEST) end_arglist()); 35319370Spst write_exp_elt_opcode (MULTI_SUBSCRIPT); } 35419370Spst ; 35519370Spst 35619370Spstexp : exp '(' 35719370Spst /* This is to save the value of arglist_len 35819370Spst being accumulated by an outer function call. */ 35919370Spst { start_arglist (); } 36019370Spst arglist ')' %prec DOT 36119370Spst { write_exp_elt_opcode (OP_FUNCALL); 36219370Spst write_exp_elt_longcst ((LONGEST) end_arglist ()); 36319370Spst write_exp_elt_opcode (OP_FUNCALL); } 36419370Spst ; 36519370Spst 36619370Spstarglist : 36719370Spst ; 36819370Spst 36919370Spstarglist : exp 37019370Spst { arglist_len = 1; } 37119370Spst ; 37219370Spst 37319370Spstarglist : arglist ',' exp %prec ABOVE_COMMA 37419370Spst { arglist_len++; } 37519370Spst ; 37619370Spst 37719370Spstnon_empty_arglist 37819370Spst : exp 37919370Spst { arglist_len = 1; } 38019370Spst ; 38119370Spst 38219370Spstnon_empty_arglist 38319370Spst : non_empty_arglist ',' exp %prec ABOVE_COMMA 38419370Spst { arglist_len++; } 38519370Spst ; 38619370Spst 38719370Spst/* GDB construct */ 38819370Spstexp : '{' type '}' exp %prec UNARY 38919370Spst { write_exp_elt_opcode (UNOP_MEMVAL); 39019370Spst write_exp_elt_type ($2); 39119370Spst write_exp_elt_opcode (UNOP_MEMVAL); } 39219370Spst ; 39319370Spst 39419370Spstexp : type '(' exp ')' %prec UNARY 39519370Spst { write_exp_elt_opcode (UNOP_CAST); 39619370Spst write_exp_elt_type ($1); 39719370Spst write_exp_elt_opcode (UNOP_CAST); } 39819370Spst ; 39919370Spst 40019370Spstexp : '(' exp ')' 40119370Spst { } 40219370Spst ; 40319370Spst 40419370Spst/* Binary operators in order of decreasing precedence. Note that some 40519370Spst of these operators are overloaded! (ie. sets) */ 40619370Spst 40719370Spst/* GDB construct */ 40819370Spstexp : exp '@' exp 40919370Spst { write_exp_elt_opcode (BINOP_REPEAT); } 41019370Spst ; 41119370Spst 41219370Spstexp : exp '*' exp 41319370Spst { write_exp_elt_opcode (BINOP_MUL); } 41419370Spst ; 41519370Spst 41619370Spstexp : exp '/' exp 41719370Spst { write_exp_elt_opcode (BINOP_DIV); } 41819370Spst ; 41919370Spst 42019370Spstexp : exp DIV exp 42119370Spst { write_exp_elt_opcode (BINOP_INTDIV); } 42219370Spst ; 42319370Spst 42419370Spstexp : exp MOD exp 42519370Spst { write_exp_elt_opcode (BINOP_REM); } 42619370Spst ; 42719370Spst 42819370Spstexp : exp '+' exp 42919370Spst { write_exp_elt_opcode (BINOP_ADD); } 43019370Spst ; 43119370Spst 43219370Spstexp : exp '-' exp 43319370Spst { write_exp_elt_opcode (BINOP_SUB); } 43419370Spst ; 43519370Spst 43619370Spstexp : exp '=' exp 43719370Spst { write_exp_elt_opcode (BINOP_EQUAL); } 43819370Spst ; 43919370Spst 44019370Spstexp : exp NOTEQUAL exp 44119370Spst { write_exp_elt_opcode (BINOP_NOTEQUAL); } 44219370Spst | exp '#' exp 44319370Spst { write_exp_elt_opcode (BINOP_NOTEQUAL); } 44419370Spst ; 44519370Spst 44619370Spstexp : exp LEQ exp 44719370Spst { write_exp_elt_opcode (BINOP_LEQ); } 44819370Spst ; 44919370Spst 45019370Spstexp : exp GEQ exp 45119370Spst { write_exp_elt_opcode (BINOP_GEQ); } 45219370Spst ; 45319370Spst 45419370Spstexp : exp '<' exp 45519370Spst { write_exp_elt_opcode (BINOP_LESS); } 45619370Spst ; 45719370Spst 45819370Spstexp : exp '>' exp 45919370Spst { write_exp_elt_opcode (BINOP_GTR); } 46019370Spst ; 46119370Spst 46219370Spstexp : exp LOGICAL_AND exp 46319370Spst { write_exp_elt_opcode (BINOP_LOGICAL_AND); } 46419370Spst ; 46519370Spst 46619370Spstexp : exp OROR exp 46719370Spst { write_exp_elt_opcode (BINOP_LOGICAL_OR); } 46819370Spst ; 46919370Spst 47019370Spstexp : exp ASSIGN exp 47119370Spst { write_exp_elt_opcode (BINOP_ASSIGN); } 47219370Spst ; 47319370Spst 47419370Spst 47519370Spst/* Constants */ 47619370Spst 47719370Spstexp : M2_TRUE 47819370Spst { write_exp_elt_opcode (OP_BOOL); 47919370Spst write_exp_elt_longcst ((LONGEST) $1); 48019370Spst write_exp_elt_opcode (OP_BOOL); } 48119370Spst ; 48219370Spst 48319370Spstexp : M2_FALSE 48419370Spst { write_exp_elt_opcode (OP_BOOL); 48519370Spst write_exp_elt_longcst ((LONGEST) $1); 48619370Spst write_exp_elt_opcode (OP_BOOL); } 48719370Spst ; 48819370Spst 48919370Spstexp : INT 49019370Spst { write_exp_elt_opcode (OP_LONG); 49119370Spst write_exp_elt_type (builtin_type_m2_int); 49219370Spst write_exp_elt_longcst ((LONGEST) $1); 49319370Spst write_exp_elt_opcode (OP_LONG); } 49419370Spst ; 49519370Spst 49619370Spstexp : UINT 49719370Spst { 49819370Spst write_exp_elt_opcode (OP_LONG); 49919370Spst write_exp_elt_type (builtin_type_m2_card); 50019370Spst write_exp_elt_longcst ((LONGEST) $1); 50119370Spst write_exp_elt_opcode (OP_LONG); 50219370Spst } 50319370Spst ; 50419370Spst 50519370Spstexp : CHAR 50619370Spst { write_exp_elt_opcode (OP_LONG); 50719370Spst write_exp_elt_type (builtin_type_m2_char); 50819370Spst write_exp_elt_longcst ((LONGEST) $1); 50919370Spst write_exp_elt_opcode (OP_LONG); } 51019370Spst ; 51119370Spst 51219370Spst 51319370Spstexp : FLOAT 51419370Spst { write_exp_elt_opcode (OP_DOUBLE); 51519370Spst write_exp_elt_type (builtin_type_m2_real); 51619370Spst write_exp_elt_dblcst ($1); 51719370Spst write_exp_elt_opcode (OP_DOUBLE); } 51819370Spst ; 51919370Spst 52019370Spstexp : variable 52119370Spst ; 52219370Spst 52319370Spstexp : SIZE '(' type ')' %prec UNARY 52419370Spst { write_exp_elt_opcode (OP_LONG); 52519370Spst write_exp_elt_type (builtin_type_int); 52619370Spst write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3)); 52719370Spst write_exp_elt_opcode (OP_LONG); } 52819370Spst ; 52919370Spst 53019370Spstexp : STRING 53119370Spst { write_exp_elt_opcode (OP_M2_STRING); 53219370Spst write_exp_string ($1); 53319370Spst write_exp_elt_opcode (OP_M2_STRING); } 53419370Spst ; 53519370Spst 53619370Spst/* This will be used for extensions later. Like adding modules. */ 53719370Spstblock : fblock 53819370Spst { $$ = SYMBOL_BLOCK_VALUE($1); } 53919370Spst ; 54019370Spst 54119370Spstfblock : BLOCKNAME 54219370Spst { struct symbol *sym 54319370Spst = lookup_symbol (copy_name ($1), expression_context_block, 544130803Smarcel VAR_DOMAIN, 0, NULL); 54519370Spst $$ = sym;} 54619370Spst ; 54719370Spst 54819370Spst 54919370Spst/* GDB scope operator */ 55019370Spstfblock : block COLONCOLON BLOCKNAME 55119370Spst { struct symbol *tem 55219370Spst = lookup_symbol (copy_name ($3), $1, 553130803Smarcel VAR_DOMAIN, 0, NULL); 55419370Spst if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK) 55519370Spst error ("No function \"%s\" in specified context.", 55619370Spst copy_name ($3)); 55719370Spst $$ = tem; 55819370Spst } 55919370Spst ; 56019370Spst 56119370Spst/* Useful for assigning to PROCEDURE variables */ 56219370Spstvariable: fblock 56319370Spst { write_exp_elt_opcode(OP_VAR_VALUE); 56419370Spst write_exp_elt_block (NULL); 56519370Spst write_exp_elt_sym ($1); 56619370Spst write_exp_elt_opcode (OP_VAR_VALUE); } 56719370Spst ; 56819370Spst 56919370Spst/* GDB internal ($foo) variable */ 57019370Spstvariable: INTERNAL_VAR 57119370Spst ; 57219370Spst 57319370Spst/* GDB scope operator */ 57419370Spstvariable: block COLONCOLON NAME 57519370Spst { struct symbol *sym; 57619370Spst sym = lookup_symbol (copy_name ($3), $1, 577130803Smarcel VAR_DOMAIN, 0, NULL); 57819370Spst if (sym == 0) 57919370Spst error ("No symbol \"%s\" in specified context.", 58019370Spst copy_name ($3)); 58119370Spst 58219370Spst write_exp_elt_opcode (OP_VAR_VALUE); 58319370Spst /* block_found is set by lookup_symbol. */ 58419370Spst write_exp_elt_block (block_found); 58519370Spst write_exp_elt_sym (sym); 58619370Spst write_exp_elt_opcode (OP_VAR_VALUE); } 58719370Spst ; 58819370Spst 58919370Spst/* Base case for variables. */ 59019370Spstvariable: NAME 59119370Spst { struct symbol *sym; 59219370Spst int is_a_field_of_this; 59319370Spst 59419370Spst sym = lookup_symbol (copy_name ($1), 59519370Spst expression_context_block, 596130803Smarcel VAR_DOMAIN, 59719370Spst &is_a_field_of_this, 59819370Spst NULL); 59919370Spst if (sym) 60019370Spst { 60119370Spst if (symbol_read_needs_frame (sym)) 60219370Spst { 60319370Spst if (innermost_block == 0 || 60419370Spst contained_in (block_found, 60519370Spst innermost_block)) 60619370Spst innermost_block = block_found; 60719370Spst } 60819370Spst 60919370Spst write_exp_elt_opcode (OP_VAR_VALUE); 61019370Spst /* We want to use the selected frame, not 61119370Spst another more inner frame which happens to 61219370Spst be in the same block. */ 61319370Spst write_exp_elt_block (NULL); 61419370Spst write_exp_elt_sym (sym); 61519370Spst write_exp_elt_opcode (OP_VAR_VALUE); 61619370Spst } 61719370Spst else 61819370Spst { 61919370Spst struct minimal_symbol *msymbol; 620130803Smarcel char *arg = copy_name ($1); 62119370Spst 62219370Spst msymbol = 62319370Spst lookup_minimal_symbol (arg, NULL, NULL); 62419370Spst if (msymbol != NULL) 62519370Spst { 62619370Spst write_exp_msymbol 62719370Spst (msymbol, 62819370Spst lookup_function_type (builtin_type_int), 62919370Spst builtin_type_int); 63019370Spst } 63119370Spst else if (!have_full_symbols () && !have_partial_symbols ()) 63219370Spst error ("No symbol table is loaded. Use the \"symbol-file\" command."); 63319370Spst else 63419370Spst error ("No symbol \"%s\" in current context.", 63519370Spst copy_name ($1)); 63619370Spst } 63719370Spst } 63819370Spst ; 63919370Spst 64019370Spsttype 64119370Spst : TYPENAME 64219370Spst { $$ = lookup_typename (copy_name ($1), 64319370Spst expression_context_block, 0); } 64419370Spst 64519370Spst ; 64619370Spst 64719370Spst%% 64819370Spst 64919370Spst#if 0 /* FIXME! */ 65019370Spstint 65119370Spstoverflow(a,b) 65219370Spst long a,b; 65319370Spst{ 65419370Spst return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a; 65519370Spst} 65619370Spst 65719370Spstint 65819370Spstuoverflow(a,b) 65919370Spst unsigned long a,b; 66019370Spst{ 66119370Spst return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a; 66219370Spst} 66319370Spst#endif /* FIXME */ 66419370Spst 66519370Spst/* Take care of parsing a number (anything that starts with a digit). 66619370Spst Set yylval and return the token type; update lexptr. 66719370Spst LEN is the number of characters in it. */ 66819370Spst 66919370Spst/*** Needs some error checking for the float case ***/ 67019370Spst 67119370Spststatic int 67219370Spstparse_number (olen) 67319370Spst int olen; 67419370Spst{ 675130803Smarcel char *p = lexptr; 676130803Smarcel LONGEST n = 0; 677130803Smarcel LONGEST prevn = 0; 678130803Smarcel int c,i,ischar=0; 679130803Smarcel int base = input_radix; 680130803Smarcel int len = olen; 68119370Spst int unsigned_p = number_sign == 1 ? 1 : 0; 68219370Spst 68319370Spst if(p[len-1] == 'H') 68419370Spst { 68519370Spst base = 16; 68619370Spst len--; 68719370Spst } 68819370Spst else if(p[len-1] == 'C' || p[len-1] == 'B') 68919370Spst { 69019370Spst base = 8; 69119370Spst ischar = p[len-1] == 'C'; 69219370Spst len--; 69319370Spst } 69419370Spst 69519370Spst /* Scan the number */ 69619370Spst for (c = 0; c < len; c++) 69719370Spst { 69819370Spst if (p[c] == '.' && base == 10) 69919370Spst { 70019370Spst /* It's a float since it contains a point. */ 70119370Spst yylval.dval = atof (p); 70219370Spst lexptr += len; 70319370Spst return FLOAT; 70419370Spst } 70519370Spst if (p[c] == '.' && base != 10) 70619370Spst error("Floating point numbers must be base 10."); 70719370Spst if (base == 10 && (p[c] < '0' || p[c] > '9')) 70819370Spst error("Invalid digit \'%c\' in number.",p[c]); 70919370Spst } 71019370Spst 71119370Spst while (len-- > 0) 71219370Spst { 71319370Spst c = *p++; 71419370Spst n *= base; 71519370Spst if( base == 8 && (c == '8' || c == '9')) 71619370Spst error("Invalid digit \'%c\' in octal number.",c); 71719370Spst if (c >= '0' && c <= '9') 71819370Spst i = c - '0'; 71919370Spst else 72019370Spst { 72119370Spst if (base == 16 && c >= 'A' && c <= 'F') 72219370Spst i = c - 'A' + 10; 72319370Spst else 72419370Spst return ERROR; 72519370Spst } 72619370Spst n+=i; 72719370Spst if(i >= base) 72819370Spst return ERROR; 72919370Spst if(!unsigned_p && number_sign == 1 && (prevn >= n)) 73019370Spst unsigned_p=1; /* Try something unsigned */ 73119370Spst /* Don't do the range check if n==i and i==0, since that special 73219370Spst case will give an overflow error. */ 73319370Spst if(RANGE_CHECK && n!=i && i) 73419370Spst { 73519370Spst if((unsigned_p && (unsigned)prevn >= (unsigned)n) || 73619370Spst ((!unsigned_p && number_sign==-1) && -prevn <= -n)) 73719370Spst range_error("Overflow on numeric constant."); 73819370Spst } 73919370Spst prevn=n; 74019370Spst } 74119370Spst 74219370Spst lexptr = p; 74319370Spst if(*p == 'B' || *p == 'C' || *p == 'H') 74419370Spst lexptr++; /* Advance past B,C or H */ 74519370Spst 74619370Spst if (ischar) 74719370Spst { 74819370Spst yylval.ulval = n; 74919370Spst return CHAR; 75019370Spst } 75119370Spst else if ( unsigned_p && number_sign == 1) 75219370Spst { 75319370Spst yylval.ulval = n; 75419370Spst return UINT; 75519370Spst } 75619370Spst else if((unsigned_p && (n<0))) { 75719370Spst range_error("Overflow on numeric constant -- number too large."); 75819370Spst /* But, this can return if range_check == range_warn. */ 75919370Spst } 76019370Spst yylval.lval = n; 76119370Spst return INT; 76219370Spst} 76319370Spst 76419370Spst 76519370Spst/* Some tokens */ 76619370Spst 76719370Spststatic struct 76819370Spst{ 76919370Spst char name[2]; 77019370Spst int token; 77119370Spst} tokentab2[] = 77219370Spst{ 77319370Spst { {'<', '>'}, NOTEQUAL }, 77419370Spst { {':', '='}, ASSIGN }, 77519370Spst { {'<', '='}, LEQ }, 77619370Spst { {'>', '='}, GEQ }, 77719370Spst { {':', ':'}, COLONCOLON }, 77819370Spst 77919370Spst}; 78019370Spst 78119370Spst/* Some specific keywords */ 78219370Spst 78319370Spststruct keyword { 78419370Spst char keyw[10]; 78519370Spst int token; 78619370Spst}; 78719370Spst 78819370Spststatic struct keyword keytab[] = 78919370Spst{ 79019370Spst {"OR" , OROR }, 79119370Spst {"IN", IN },/* Note space after IN */ 79219370Spst {"AND", LOGICAL_AND}, 79319370Spst {"ABS", ABS }, 79419370Spst {"CHR", CHR }, 79519370Spst {"DEC", DEC }, 79619370Spst {"NOT", NOT }, 79719370Spst {"DIV", DIV }, 79819370Spst {"INC", INC }, 79919370Spst {"MAX", MAX_FUNC }, 80019370Spst {"MIN", MIN_FUNC }, 80119370Spst {"MOD", MOD }, 80219370Spst {"ODD", ODD }, 80319370Spst {"CAP", CAP }, 80419370Spst {"ORD", ORD }, 80519370Spst {"VAL", VAL }, 80619370Spst {"EXCL", EXCL }, 80719370Spst {"HIGH", HIGH }, 80819370Spst {"INCL", INCL }, 80919370Spst {"SIZE", SIZE }, 81019370Spst {"FLOAT", FLOAT_FUNC }, 81119370Spst {"TRUNC", TRUNC }, 81219370Spst}; 81319370Spst 81419370Spst 81519370Spst/* Read one token, getting characters through lexptr. */ 81619370Spst 81719370Spst/* This is where we will check to make sure that the language and the operators used are 81819370Spst compatible */ 81919370Spst 82019370Spststatic int 82119370Spstyylex () 82219370Spst{ 823130803Smarcel int c; 824130803Smarcel int namelen; 825130803Smarcel int i; 826130803Smarcel char *tokstart; 827130803Smarcel char quote; 82819370Spst 82919370Spst retry: 83019370Spst 831130803Smarcel prev_lexptr = lexptr; 832130803Smarcel 83319370Spst tokstart = lexptr; 83419370Spst 83519370Spst 83619370Spst /* See if it is a special token of length 2 */ 83719370Spst for( i = 0 ; i < (int) (sizeof tokentab2 / sizeof tokentab2[0]) ; i++) 838130803Smarcel if(DEPRECATED_STREQN(tokentab2[i].name, tokstart, 2)) 83919370Spst { 84019370Spst lexptr += 2; 84119370Spst return tokentab2[i].token; 84219370Spst } 84319370Spst 84419370Spst switch (c = *tokstart) 84519370Spst { 84619370Spst case 0: 84719370Spst return 0; 84819370Spst 84919370Spst case ' ': 85019370Spst case '\t': 85119370Spst case '\n': 85219370Spst lexptr++; 85319370Spst goto retry; 85419370Spst 85519370Spst case '(': 85619370Spst paren_depth++; 85719370Spst lexptr++; 85819370Spst return c; 85919370Spst 86019370Spst case ')': 86119370Spst if (paren_depth == 0) 86219370Spst return 0; 86319370Spst paren_depth--; 86419370Spst lexptr++; 86519370Spst return c; 86619370Spst 86719370Spst case ',': 86819370Spst if (comma_terminates && paren_depth == 0) 86919370Spst return 0; 87019370Spst lexptr++; 87119370Spst return c; 87219370Spst 87319370Spst case '.': 87419370Spst /* Might be a floating point number. */ 87519370Spst if (lexptr[1] >= '0' && lexptr[1] <= '9') 87619370Spst break; /* Falls into number code. */ 87719370Spst else 87819370Spst { 87919370Spst lexptr++; 88019370Spst return DOT; 88119370Spst } 88219370Spst 88319370Spst/* These are character tokens that appear as-is in the YACC grammar */ 88419370Spst case '+': 88519370Spst case '-': 88619370Spst case '*': 88719370Spst case '/': 88819370Spst case '^': 88919370Spst case '<': 89019370Spst case '>': 89119370Spst case '[': 89219370Spst case ']': 89319370Spst case '=': 89419370Spst case '{': 89519370Spst case '}': 89619370Spst case '#': 89719370Spst case '@': 89819370Spst case '~': 89919370Spst case '&': 90019370Spst lexptr++; 90119370Spst return c; 90219370Spst 90319370Spst case '\'' : 90419370Spst case '"': 90519370Spst quote = c; 90619370Spst for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++) 90719370Spst if (c == '\\') 90819370Spst { 90919370Spst c = tokstart[++namelen]; 91019370Spst if (c >= '0' && c <= '9') 91119370Spst { 91219370Spst c = tokstart[++namelen]; 91319370Spst if (c >= '0' && c <= '9') 91419370Spst c = tokstart[++namelen]; 91519370Spst } 91619370Spst } 91719370Spst if(c != quote) 91819370Spst error("Unterminated string or character constant."); 91919370Spst yylval.sval.ptr = tokstart + 1; 92019370Spst yylval.sval.length = namelen - 1; 92119370Spst lexptr += namelen + 1; 92219370Spst 92319370Spst if(namelen == 2) /* Single character */ 92419370Spst { 92519370Spst yylval.ulval = tokstart[1]; 92619370Spst return CHAR; 92719370Spst } 92819370Spst else 92919370Spst return STRING; 93019370Spst } 93119370Spst 93219370Spst /* Is it a number? */ 93319370Spst /* Note: We have already dealt with the case of the token '.'. 93419370Spst See case '.' above. */ 93519370Spst if ((c >= '0' && c <= '9')) 93619370Spst { 93719370Spst /* It's a number. */ 93819370Spst int got_dot = 0, got_e = 0; 939130803Smarcel char *p = tokstart; 94019370Spst int toktype; 94119370Spst 94219370Spst for (++p ;; ++p) 94319370Spst { 94419370Spst if (!got_e && (*p == 'e' || *p == 'E')) 94519370Spst got_dot = got_e = 1; 94619370Spst else if (!got_dot && *p == '.') 94719370Spst got_dot = 1; 94819370Spst else if (got_e && (p[-1] == 'e' || p[-1] == 'E') 94919370Spst && (*p == '-' || *p == '+')) 95019370Spst /* This is the sign of the exponent, not the end of the 95119370Spst number. */ 95219370Spst continue; 95319370Spst else if ((*p < '0' || *p > '9') && 95419370Spst (*p < 'A' || *p > 'F') && 95519370Spst (*p != 'H')) /* Modula-2 hexadecimal number */ 95619370Spst break; 95719370Spst } 95819370Spst toktype = parse_number (p - tokstart); 95919370Spst if (toktype == ERROR) 96019370Spst { 96119370Spst char *err_copy = (char *) alloca (p - tokstart + 1); 96219370Spst 96319370Spst memcpy (err_copy, tokstart, p - tokstart); 96419370Spst err_copy[p - tokstart] = 0; 96519370Spst error ("Invalid number \"%s\".", err_copy); 96619370Spst } 96719370Spst lexptr = p; 96819370Spst return toktype; 96919370Spst } 97019370Spst 97119370Spst if (!(c == '_' || c == '$' 97219370Spst || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'))) 97319370Spst /* We must have come across a bad character (e.g. ';'). */ 97419370Spst error ("Invalid character '%c' in expression.", c); 97519370Spst 97619370Spst /* It's a name. See how long it is. */ 97719370Spst namelen = 0; 97819370Spst for (c = tokstart[namelen]; 97919370Spst (c == '_' || c == '$' || (c >= '0' && c <= '9') 98019370Spst || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')); 98119370Spst c = tokstart[++namelen]) 98219370Spst ; 98319370Spst 98419370Spst /* The token "if" terminates the expression and is NOT 98519370Spst removed from the input stream. */ 98619370Spst if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f') 98719370Spst { 98819370Spst return 0; 98919370Spst } 99019370Spst 99119370Spst lexptr += namelen; 99219370Spst 99319370Spst /* Lookup special keywords */ 99419370Spst for(i = 0 ; i < (int) (sizeof(keytab) / sizeof(keytab[0])) ; i++) 995130803Smarcel if(namelen == strlen(keytab[i].keyw) && DEPRECATED_STREQN(tokstart,keytab[i].keyw,namelen)) 99619370Spst return keytab[i].token; 99719370Spst 99819370Spst yylval.sval.ptr = tokstart; 99919370Spst yylval.sval.length = namelen; 100019370Spst 100119370Spst if (*tokstart == '$') 100219370Spst { 100319370Spst write_dollar_variable (yylval.sval); 100419370Spst return INTERNAL_VAR; 100519370Spst } 100619370Spst 100719370Spst /* Use token-type BLOCKNAME for symbols that happen to be defined as 100819370Spst functions. If this is not so, then ... 100919370Spst Use token-type TYPENAME for symbols that happen to be defined 101019370Spst currently as names of types; NAME for other symbols. 101119370Spst The caller is not constrained to care about the distinction. */ 101219370Spst { 101319370Spst 101419370Spst 101519370Spst char *tmp = copy_name (yylval.sval); 101619370Spst struct symbol *sym; 101719370Spst 101819370Spst if (lookup_partial_symtab (tmp)) 101919370Spst return BLOCKNAME; 102019370Spst sym = lookup_symbol (tmp, expression_context_block, 1021130803Smarcel VAR_DOMAIN, 0, NULL); 102219370Spst if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK) 102319370Spst return BLOCKNAME; 102419370Spst if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1)) 102519370Spst return TYPENAME; 102619370Spst 102719370Spst if(sym) 102819370Spst { 102919370Spst switch(sym->aclass) 103019370Spst { 103119370Spst case LOC_STATIC: 103219370Spst case LOC_REGISTER: 103319370Spst case LOC_ARG: 103419370Spst case LOC_REF_ARG: 103519370Spst case LOC_REGPARM: 103619370Spst case LOC_REGPARM_ADDR: 103719370Spst case LOC_LOCAL: 103819370Spst case LOC_LOCAL_ARG: 103919370Spst case LOC_BASEREG: 104019370Spst case LOC_BASEREG_ARG: 104119370Spst case LOC_CONST: 104219370Spst case LOC_CONST_BYTES: 104319370Spst case LOC_OPTIMIZED_OUT: 1044130803Smarcel case LOC_COMPUTED: 1045130803Smarcel case LOC_COMPUTED_ARG: 104619370Spst return NAME; 104719370Spst 104819370Spst case LOC_TYPEDEF: 104919370Spst return TYPENAME; 105019370Spst 105119370Spst case LOC_BLOCK: 105219370Spst return BLOCKNAME; 105319370Spst 105419370Spst case LOC_UNDEF: 105519370Spst error("internal: Undefined class in m2lex()"); 105619370Spst 105719370Spst case LOC_LABEL: 105819370Spst case LOC_UNRESOLVED: 105919370Spst error("internal: Unforseen case in m2lex()"); 106098944Sobrien 106198944Sobrien default: 106298944Sobrien error ("unhandled token in m2lex()"); 106398944Sobrien break; 106419370Spst } 106519370Spst } 106619370Spst else 106719370Spst { 106819370Spst /* Built-in BOOLEAN type. This is sort of a hack. */ 1069130803Smarcel if(DEPRECATED_STREQN(tokstart,"TRUE",4)) 107019370Spst { 107119370Spst yylval.ulval = 1; 107219370Spst return M2_TRUE; 107319370Spst } 1074130803Smarcel else if(DEPRECATED_STREQN(tokstart,"FALSE",5)) 107519370Spst { 107619370Spst yylval.ulval = 0; 107719370Spst return M2_FALSE; 107819370Spst } 107919370Spst } 108019370Spst 108119370Spst /* Must be another type of name... */ 108219370Spst return NAME; 108319370Spst } 108419370Spst} 108519370Spst 108619370Spst#if 0 /* Unused */ 108719370Spststatic char * 108819370Spstmake_qualname(mod,ident) 108919370Spst char *mod, *ident; 109019370Spst{ 109119370Spst char *new = malloc(strlen(mod)+strlen(ident)+2); 109219370Spst 109319370Spst strcpy(new,mod); 109419370Spst strcat(new,"."); 109519370Spst strcat(new,ident); 109619370Spst return new; 109719370Spst} 109819370Spst#endif /* 0 */ 109919370Spst 110019370Spstvoid 110119370Spstyyerror (msg) 110219370Spst char *msg; 110319370Spst{ 1104130803Smarcel if (prev_lexptr) 1105130803Smarcel lexptr = prev_lexptr; 1106130803Smarcel 110719370Spst error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr); 110819370Spst} 1109