Добавлена конструкция FOR

diff --git a/notes b/notes
index 7279e3fcdb420b31f3efda7f9bccf2d185766c5c..693f32a80a90486705b57524ae58393bd068e60d 100644 (file)
--- a/notes
+++ b/notes
@@ -4,7 +4,6 @@
 - Нет типа SET
 - Нет оператора IS
 - Нет конструкции CASE
-- Нет конструкции FOR
 - Нет конструкции LOOP/EXIT
 - Нет конструкции WITH
 - Нет модуля SYSTEM
@@ -13,6 +12,9 @@
 - Не реализована свёртка констант
 - Не счёта строк / столбцов
 
+- JVM: Не реализованы VAR-параметры.
+- JVM: Не реализованы локальные процедуры.
+
 - Нужно пробежаться по стандарту и всё перепроверить.
 
 - Нужны средства создания биндингов. На данный момент реализуемо как заглушки для модулей.

diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c
index 0295e47c145d4081113e9271d78c12af4da5e2a8..ca0f88565536d1ae11ce2022c4713099fb9bcf0c 100644 (file)
--- a/src/backends/jvm/generator-jvm.c
+++ b/src/backends/jvm/generator-jvm.c
@@ -1036,6 +1036,26 @@ oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
        }
 }
 
+void
+oberon_generator_init_temp_var(oberon_context_t * ctx, oberon_object_t * var)
+{
+       assert(var -> class == OBERON_CLASS_VAR);
+
+       gen_var_t * v = oberon_generator_new_var();
+       var -> gen_var = v;
+
+       gen_module_t * m;
+       m = ctx -> mod -> gen_mod;
+
+       gen_proc_t * p;
+       p = m -> class -> p;
+
+       bool wide;
+       wide = jvm_is_wide_type(var -> type);
+
+       jvm_generate_and_init_local_var(v, p, wide);
+}
+
 void
 oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc)
 {

diff --git a/src/generator.h b/src/generator.h
index 23901dd41c83e027409eace3445ae5d11d276d09..436a0f8f01b3a3470a5681f436eb7a505f8ed074 100644 (file)
--- a/src/generator.h
+++ b/src/generator.h
@@ -6,6 +6,7 @@ void oberon_generator_init_context(oberon_context_t * ctx);
 void oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type);
 void oberon_generator_init_record(oberon_context_t * ctx, oberon_type_t * type);
 void oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var);
+void oberon_generator_init_temp_var(oberon_context_t * ctx, oberon_object_t * var);
 void oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc);
 void oberon_generator_destroy_context(oberon_context_t * ctx);
 

diff --git a/src/oberon.c b/src/oberon.c
index e8cbf428c12a7261b90dd057c8dc96381f465a3b..f50f4d300246b4beed4fd6e58afaf21cb307cf3a 100644 (file)
--- 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);

diff --git a/src/test.c b/src/test.c
index 059af717a19c98da40c7ebade7168065ce8a2f9c..42fc4ff3030a00a18b2b673141cc0f7137f2a1fc 100644 (file)
--- a/src/test.c
+++ b/src/test.c
@@ -10,15 +10,15 @@ static char source_test[] =
        "IMPORT Out;"
        ""
        "VAR"
-       "  i : INTEGER;"
+       "  i, len : INTEGER;"
        ""
        "BEGIN"
-       "  i := 0;"
        "  Out.Open();"
-       "  REPEAT"
+       "  len := 2 * 8;"
+       "  FOR i := 0 TO len BY 2 DO"
        "    Out.String('Count '); Out.Int(i, 0); Out.Ln;"
-       "    i := i + 1;"
-       "  UNTIL i < 4;"
+       "    len := len + 2;"
+       "  END;"
        "  Out.String('end'); Out.Ln;"
        "END Test."
 ;