From: DeaDDooMER <deaddoomer@deadsoftware.ru>
Date: Thu, 3 Aug 2017 13:37:59 +0000 (+0300)
Subject: Добавлена конструкция FOR
X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=99fa357db44a4c30957bd0810e14a20456c58347;p=dsw-obn.git

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

diff --git a/notes b/notes
index 7279e3f..693f32a 100644
--- 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 0295e47..ca0f885 100644
--- 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 23901dd..436a0f8 100644
--- 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 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);
diff --git a/src/test.c b/src/test.c
index 059af71..42fc4ff 100644
--- 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."
 ;