X-Git-Url: https://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=src%2Foberon.c;h=f50f4d300246b4beed4fd6e58afaf21cb307cf3a;hp=e8cbf428c12a7261b90dd057c8dc96381f465a3b;hb=99fa357db44a4c30957bd0810e14a20456c58347;hpb=a4fb30372d14e8415e2f9b8e647c20daeab59d7d diff --git a/src/oberon.c b/src/oberon.c index e8cbf42..f50f4d3 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -69,7 +69,9 @@ enum { WHILE, DO, REPEAT, - UNTIL + UNTIL, + FOR, + BY }; // ======================================================================= @@ -207,6 +209,22 @@ oberon_find_object(oberon_scope_t * scope, char * name, bool check_it) return result; } +static oberon_object_t * +oberon_create_object(oberon_scope_t * scope, char * name, int class, bool export, bool read_only) +{ + oberon_object_t * newvar = malloc(sizeof *newvar); + memset(newvar, 0, sizeof *newvar); + newvar -> name = name; + newvar -> class = class; + newvar -> export = export; + newvar -> read_only = read_only; + newvar -> local = scope -> local; + newvar -> parent = scope -> parent; + newvar -> parent_type = scope -> parent_type; + newvar -> module = scope -> ctx -> mod; + return newvar; +} + static oberon_object_t * oberon_define_object(oberon_scope_t * scope, char * name, int class, bool export, bool read_only, bool check_upscope) { @@ -229,17 +247,8 @@ oberon_define_object(oberon_scope_t * scope, char * name, int class, bool export oberon_error(scope -> ctx, "already defined"); } - oberon_object_t * newvar = malloc(sizeof *newvar); - memset(newvar, 0, sizeof *newvar); - newvar -> name = name; - newvar -> class = class; - newvar -> export = export; - newvar -> read_only = read_only; - newvar -> local = scope -> local; - newvar -> parent = scope -> parent; - newvar -> parent_type = scope -> parent_type; - newvar -> module = scope -> ctx -> mod; - + oberon_object_t * newvar; + newvar = oberon_create_object(scope, name, class, export, read_only); x -> next = newvar; return newvar; @@ -420,6 +429,14 @@ oberon_read_ident(oberon_context_t * ctx) { ctx -> token = UNTIL; } + else if(strcmp(ident, "FOR") == 0) + { + ctx -> token = FOR; + } + else if(strcmp(ident, "BY") == 0) + { + ctx -> token = BY; + } } static void @@ -1417,6 +1434,26 @@ oberon_qualident(oberon_context_t * ctx, char ** xname, int check) return x; } +static oberon_expr_t * +oberon_ident_item(oberon_context_t * ctx, char * name) +{ + bool read_only; + oberon_object_t * x; + oberon_expr_t * expr; + + x = oberon_find_object(ctx -> decl, name, true); + + read_only = false; + if(x -> class == OBERON_CLASS_CONST || x -> class == OBERON_CLASS_PROC) + { + read_only = true; + } + + expr = oberon_new_item(MODE_VAR, x -> type, read_only); + expr -> item.var = x; + return expr; +} + static oberon_expr_t * oberon_designator(oberon_context_t * ctx) { @@ -1447,7 +1484,7 @@ oberon_designator(oberon_context_t * ctx) expr = oberon_new_item(MODE_VAR, var -> type, read_only); break; case OBERON_CLASS_PROC: - expr = oberon_new_item(MODE_VAR, var -> type, 1); + expr = oberon_new_item(MODE_VAR, var -> type, true); break; default: oberon_error(ctx, "invalid designator"); @@ -1570,6 +1607,17 @@ oberon_get_type_of_int_value(oberon_context_t * ctx, int64_t i) } } +static oberon_expr_t * +oberon_integer_item(oberon_context_t * ctx, int64_t i) +{ + oberon_expr_t * expr; + oberon_type_t * result; + result = oberon_get_type_of_int_value(ctx, i); + expr = oberon_new_item(MODE_INTEGER, result, true); + expr -> item.integer = i; + return expr; +} + static oberon_expr_t * oberon_factor(oberon_context_t * ctx) { @@ -1583,9 +1631,7 @@ oberon_factor(oberon_context_t * ctx) expr = oberon_opt_func_parens(ctx, expr); break; case INTEGER: - result = oberon_get_type_of_int_value(ctx, ctx -> integer); - expr = oberon_new_item(MODE_INTEGER, result, true); - expr -> item.integer = ctx -> integer; + expr = oberon_integer_item(ctx, ctx -> integer); oberon_assert_token(ctx, INTEGER); break; case CHAR: @@ -1877,6 +1923,21 @@ oberon_const_expr(oberon_context_t * ctx) oberon_error(ctx, "const expression are required"); } + switch(expr -> item.mode) + { + case MODE_INTEGER: + case MODE_BOOLEAN: + case MODE_NIL: + case MODE_REAL: + case MODE_CHAR: + case MODE_STRING: + /* accept */ + break; + default: + oberon_error(ctx, "const expression are required"); + break; + } + return (oberon_item_t *) expr; } @@ -2889,6 +2950,22 @@ oberon_decl_seq(oberon_context_t * ctx) oberon_prevent_undeclarated_procedures(ctx); } +static oberon_expr_t * +oberon_make_temp_var_item(oberon_context_t * ctx, oberon_type_t * type) +{ + oberon_object_t * x; + oberon_expr_t * expr; + + x = oberon_create_object(ctx -> decl, "TEMP", OBERON_CLASS_VAR, false, false); + x -> local = true; + x -> type = type; + oberon_generator_init_temp_var(ctx, x); + + expr = oberon_new_item(MODE_VAR, type, false); + expr -> item.var = x; + return expr; +} + static void oberon_statement_seq(oberon_context_t * ctx); @@ -3017,6 +3094,72 @@ oberon_statement(oberon_context_t * ctx) oberon_generate_branch(ctx, cond, true, begin); } + else if(ctx -> token == FOR) + { + oberon_expr_t * from; + oberon_expr_t * index; + oberon_expr_t * to; + oberon_expr_t * bound; + oberon_expr_t * by; + oberon_expr_t * cond; + oberon_expr_t * count; + gen_label_t * begin; + gen_label_t * end; + char * iname; + int op; + + begin = oberon_generator_reserve_label(ctx); + end = oberon_generator_reserve_label(ctx); + + oberon_assert_token(ctx, FOR); + iname = oberon_assert_ident(ctx); + index = oberon_ident_item(ctx, iname); + oberon_assert_token(ctx, ASSIGN); + from = oberon_expr(ctx); + oberon_assign(ctx, from, index); + oberon_assert_token(ctx, TO); + bound = oberon_make_temp_var_item(ctx, index -> result); + to = oberon_expr(ctx); + oberon_assign(ctx, to, bound); + if(ctx -> token == BY) + { + oberon_assert_token(ctx, BY); + by = (oberon_expr_t *) oberon_const_expr(ctx); + } + else + { + by = oberon_integer_item(ctx, 1); + } + + if(by -> result -> class != OBERON_TYPE_INTEGER) + { + oberon_error(ctx, "must be integer"); + } + + if(by -> item.integer > 0) + { + op = LEQ; + } + else if(by -> item.integer < 0) + { + op = GEQ; + } + else + { + oberon_error(ctx, "zero step not allowed"); + } + + oberon_assert_token(ctx, DO); + oberon_generate_label(ctx, begin); + cond = oberon_make_bin_op(ctx, op, index, bound); + oberon_generate_branch(ctx, cond, false, end); + oberon_statement_seq(ctx); + count = oberon_make_bin_op(ctx, PLUS, index, by); + oberon_assign(ctx, count, index); + oberon_generate_goto(ctx, begin); + oberon_generate_label(ctx, end); + oberon_assert_token(ctx, END); + } else if(ctx -> token == RETURN) { oberon_assert_token(ctx, RETURN);