%{ /* qc-parse.y parser for quakec Copyright (C) 2001 Bill Currie Author: Bill Currie Date: 2001/06/12 This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to: Free Software Foundation, Inc. 59 Temple Place - Suite 330 Boston, MA 02111-1307, USA */ #ifdef HAVE_CONFIG_H # include "config.h" #endif static __attribute__ ((used)) const char rcsid[] = "$Id$"; #ifdef HAVE_STRING_H # include #endif #ifdef HAVE_STRINGS_H # include #endif #include "codespace.h" #include "expr.h" #include "function.h" #include "qfcc.h" #include "reloc.h" #include "type.h" #define YYDEBUG 1 #define YYERROR_VERBOSE 1 #undef YYERROR_VERBOSE extern char *yytext; static void yyerror (const char *s) { #ifdef YYERROR_VERBOSE error (0, "%s %s\n", yytext, s); #else error (0, "%s before %s", s, yytext); #endif } static void parse_error (void) { error (0, "parse error before %s", yytext); } #define PARSE_ERROR do { parse_error (); YYERROR; } while (0) int yylex (void); %} %union { int op; struct def_s *def; struct hashtab_s *def_list; struct type_s *type; struct typedef_s *typename; struct expr_s *expr; int integer_val; unsigned uinteger_val; float float_val; const char *string_val; float vector_val[3]; float quaternion_val[4]; struct function_s *function; struct switch_block_s *switch_block; struct param_s *param; struct method_s *method; struct class_s *class; struct category_s *category; struct class_type_s *class_type; struct protocol_s *protocol; struct protocollist_s *protocol_list; struct keywordarg_s *keywordarg; struct methodlist_s *methodlist; struct struct_s *strct; } // these tokens are common with qc %nonassoc IFX %nonassoc ELSE %nonassoc BREAK_PRIMARY %nonassoc ';' %nonassoc CLASS_NOT_CATEGORY %nonassoc STORAGEX %right '=' ASX PAS /* pointer assign */ %right '?' ':' %left OR %left AND %left '|' %left '^' %left '&' %left EQ NE %left LE GE LT GT // end of tokens common with qc %left RELOP %left ADDOP %left MULOP %right UNARY %token TYPE %token ID %token INT_VAL %token STRING_VAL %token QUATERNION_VAL %token VECTOR_VAL %token FLOAT_VAL %token PROGRAM VAR ARRAY OF FUNCTION PROCEDURE PBEGIN END IF THEN ELSE %token WHILE DO RANGE ASSIGNOP NOT ELLIPSIS %type standard_type type %type const num identifier_list statement_list statement %type optional_statements compound_statement procedure_statement %type expression_list expression unary_expr primary variable %type parameter_list arguments %type subprogram_head program_head %type subprogram_declaration %type sign %type name %{ function_t *current_func; struct class_type_s *current_class; expr_t *local_expr; struct scope_s *current_scope; param_t *current_params; static int convert_relop (const char *relop); %} %% program : program_head declarations subprogram_declarations { $1 = get_function_def ($1->name, $1->type, current_scope, st_global, 0, 1); current_func = begin_function ($1, 0, 0); } compound_statement '.' { def_t *main_def; function_t *main_func; expr_t *main_expr; current_scope = current_scope->parent; //current_storage = st_global; build_code_function (current_func, 0, $5); current_func = 0; main_def = get_def (&type_function, ".main", pr.scope, st_static); current_func = main_func = new_function (main_def, 0); add_function (main_func); reloc_def_func (main_func, main_def->ofs); main_func->code = pr.code->size; build_scope (main_func, main_def, 0); build_function (main_func); main_expr = new_block_expr (); append_expr (main_expr, build_function_call (new_def_expr ($1), $1->type, 0)); emit_function (main_func, main_expr); finish_function (main_func); current_func = 0; } ; program_head : PROGRAM ID '(' identifier_list ')' ';' { type_t *type = parse_params (&type_void, 0); current_params = 0; $$ = get_function_def ($2, type, current_scope, st_extern, 0, 1); } ; identifier_list : ID { $$ = new_block_expr (); append_expr ($$, new_name_expr ($1)); } | identifier_list ',' ID { append_expr ($1, new_name_expr ($3)); } ; declarations : declarations VAR identifier_list ':' type ';' { type_t *type = $5; expr_t *id_list = $3; expr_t *e; for (e = id_list->e.block.head; e; e = e->next) get_def (type, e->e.string_val, current_scope, st_global); } | /* empty */ ; type : standard_type { $$ = $1; } | ARRAY '[' num RANGE num ']' OF standard_type { if ($3->type != ex_integer || $5->type != ex_integer) error (0, "array bounds must be integers"); $$ = based_array_type ($8, $3->e.integer_val, $5->e.integer_val); } ; standard_type : TYPE { $$ = $1; } ; subprogram_declarations : subprogram_declarations subprogram_declaration | /* emtpy */ ; subprogram_declaration : subprogram_head ';' { current_func = begin_function ($1, 0, current_params); current_scope = current_func->scope; //current_storage = st_local; } declarations compound_statement ';' { current_scope = current_scope->parent; //current_storage = st_global; // functions in pascal are always effectively void // but their type is needed for checking func := retval // so bypass the checks append_expr ($5, new_unary_expr ('r', 0)); build_code_function (current_func, 0, $5); current_func = 0; } | subprogram_head ASSIGNOP '#' const ';' { $$ = build_builtin_function ($1, $4); if ($$) { build_scope ($$, $$->def, current_params); flush_scope ($$->scope, 1); } } ; subprogram_head : FUNCTION ID arguments ':' standard_type { type_t *type = parse_params ($5, $3); current_params = $3; $$ = get_function_def ($2, type, current_scope, st_global, 0, 1); } | PROCEDURE ID arguments { type_t *type = parse_params (&type_void, $3); $$ = get_function_def ($2, type, current_scope, st_global, 0, 1); } ; arguments : '(' parameter_list ')' { $$ = $2; } | '(' parameter_list ';' ELLIPSIS ')' { param_t **p; $$ = $2; p = &$$; for ( ; *p; p = &(*p)->next) ; *p = new_param (0, 0, 0); } | '(' ELLIPSIS ')' { $$ = new_param (0, 0, 0); } | /* emtpy */ { $$ = 0; } ; parameter_list : identifier_list ':' type { type_t *type = $3; expr_t *id_list = $1; expr_t *e; param_t **p; $$ = 0; p = &$$; for (e = id_list->e.block.head; e; e = e->next) { *p = new_param (0, type, e->e.string_val); p = &(*p)->next; } } | parameter_list ';' identifier_list ':' type { type_t *type = $5; expr_t *id_list = $3; expr_t *e; param_t **p; $$ = $1; p = &$$; for ( ; *p; p = &(*p)->next) ; for (e = id_list->e.block.head; e; e = e->next) { *p = new_param (0, type, e->e.string_val); p = &(*p)->next; } } ; compound_statement : PBEGIN optional_statements END { $$ = $2; } ; optional_statements : statement_list { $$ = $1; } | /* emtpy */ { $$ = 0; } ; statement_list : statement { $$ = new_block_expr (); append_expr ($$, $1); } | statement_list ';' statement { $$ = $1; append_expr ($$, $3); } ; statement : variable ASSIGNOP expression { convert_name ($1); if ($1->type == ex_def && extract_type ($1) == ev_func) $1 = new_ret_expr ($1->e.def->type->t.func.type); $$ = assign_expr ($1, $3); } | procedure_statement { $$ = $1; } | compound_statement { $$ = $1; } | IF expression THEN statement ELSE statement { int line = pr.source_line; string_t file = pr.source_file; expr_t *tl = new_label_expr (); expr_t *fl = new_label_expr (); expr_t *nl = new_label_expr (); pr.source_line = $2->line; pr.source_file = $2->file; $$ = new_block_expr (); $2 = convert_bool ($2, 1); if ($2->type != ex_error) { backpatch ($2->e.bool.true_list, tl); backpatch ($2->e.bool.false_list, fl); append_expr ($2->e.bool.e, tl); append_expr ($$, $2); } append_expr ($$, $4); append_expr ($$, new_unary_expr ('g', nl)); append_expr ($$, fl); append_expr ($$, $6); append_expr ($$, nl); pr.source_line = line; pr.source_file = file; } | IF expression THEN statement %prec IFX { int line = pr.source_line; string_t file = pr.source_file; expr_t *tl = new_label_expr (); expr_t *fl = new_label_expr (); pr.source_line = $2->line; pr.source_file = $2->file; $$ = new_block_expr (); $2 = convert_bool ($2, 1); if ($2->type != ex_error) { backpatch ($2->e.bool.true_list, tl); backpatch ($2->e.bool.false_list, fl); append_expr ($2->e.bool.e, tl); append_expr ($$, $2); } append_expr ($$, $4); append_expr ($$, fl); pr.source_line = line; pr.source_file = file; } | WHILE expression DO statement { int line = pr.source_line; string_t file = pr.source_file; expr_t *l1 = new_label_expr (); expr_t *l2 = new_label_expr (); expr_t *cont = new_label_expr (); pr.source_line = $2->line; pr.source_file = $2->file; $$ = new_block_expr (); append_expr ($$, new_unary_expr ('g', cont)); append_expr ($$, l1); append_expr ($$, $4); append_expr ($$, cont); $2 = convert_bool ($2, 1); if ($2->type != ex_error) { backpatch ($2->e.bool.true_list, l1); backpatch ($2->e.bool.false_list, l2); append_expr ($2->e.bool.e, l2); append_expr ($$, $2); } pr.source_line = line; pr.source_file = file; } ; variable : name { $$ = $1; } | name '[' expression ']' { $$ = array_expr ($1, $3); } ; procedure_statement : name { $$ = function_expr ($1, 0); } | name '(' expression_list ')' { $$ = function_expr ($1, $3); } ; expression_list : expression | expression_list ',' expression { $3->next = $1; $$ = $3; } ; unary_expr : primary | sign unary_expr %prec UNARY { if ($1 == '-') $$ = unary_expr ('-', $2); else $$ = $2; } | NOT expression %prec UNARY { $$ = unary_expr ('!', $2); } ; primary : variable { convert_name ($1); if ($1->type == ex_def && extract_type ($1) == ev_func) $1 = function_expr ($1, 0); $$ = $1; } | const { $$ = $1; } | name '(' expression_list ')' { $$ = function_expr ($1, $3); } | '(' expression ')' { $$ = $2; } ; expression : unary_expr | expression RELOP expression { int op = convert_relop ($2); $$ = binary_expr (op, $1, $3); } | expression ADDOP expression { if ($2 == 'o') $$ = bool_expr (OR, new_label_expr (), $1, $3); else $$ = binary_expr ($2, $1, $3); } | expression MULOP expression { if ($2 == 'd') $2 = '/'; else if ($2 == 'm') $2 = '%'; if ($2 == 'a') $$ = bool_expr (AND, new_label_expr (), $1, $3); else $$ = binary_expr ($2, $1, $3); } ; sign : ADDOP { if ($1 == 'o') PARSE_ERROR; } ; name : ID { $$ = new_name_expr ($1); } ; const : num { $$ = $1; } | STRING_VAL { $$ = new_string_expr ($1); } ; num : INT_VAL { $$ = new_integer_expr ($1); } | FLOAT_VAL { $$ = new_float_expr ($1); } | VECTOR_VAL { $$ = new_vector_expr ($1); } | QUATERNION_VAL { $$ = new_quaternion_expr ($1); } ; %% static int convert_relop (const char *relop) { switch (relop[0]) { case '=': return EQ; case '<': switch (relop[1]) { case 0: return LT; case '>': return NE; case '=': return LE; } break; case '>': switch (relop[1]) { case 0: return GT; case '=': return GE; } break; } error (0, "internal: bad relop %s", relop); return EQ; }