X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=src%2Foberon.c;h=1d00f22f5cf68f87e364a09fc60e984be5635d23;hp=53dd33eec2a711792adf5f3a0e9ed9b982fa5c74;hb=9b4f78290edb5f5bedeb12e683546fa00082f108;hpb=b09b4829b70cf34a470003286ea100663d7fe442

diff --git a/src/oberon.c b/src/oberon.c
index 53dd33e..1d00f22 100644
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -197,6 +197,16 @@ oberon_make_set(oberon_context_t * ctx, int64_t i)
 	return expr;
 }
 
+static oberon_expr_t *
+oberon_make_set_index(oberon_context_t * ctx, int64_t i)
+{
+	oberon_expr_t * expr;
+	expr = oberon_new_item(MODE_SET, ctx -> set_type, true);
+	expr -> item.integer = 1 << i;
+	expr -> item.real = 1 << i;
+	return expr;
+}
+
 static oberon_expr_t *
 oberon_make_set_range(oberon_context_t * ctx, int64_t x, int64_t y)
 {
@@ -1569,7 +1579,7 @@ oberon_element(oberon_context_t * ctx)
 	oberon_expr_t * set;
 	if(e2 == NULL && oberon_is_const(e1))
 	{
-		set = oberon_make_set(ctx, e1 -> item.integer);
+		set = oberon_make_set_index(ctx, e1 -> item.integer);
 	}
 	else if(e2 != NULL && oberon_is_const(e1) && oberon_is_const(e2))
 	{
@@ -3845,6 +3855,132 @@ oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
 	return expr;
 }
 
+static void
+oberon_make_inc_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
+{
+	if(num_args < 1)
+	{
+		oberon_error(ctx, "too few arguments");
+	}
+
+	if(num_args > 1)
+	{
+		oberon_error(ctx, "too mach arguments");
+	}
+
+	oberon_expr_t * dst;
+	dst = list_args;
+	oberon_check_dst(ctx, dst);
+
+	if(!oberon_is_integer_type(dst -> result))
+	{
+		oberon_error(ctx, "expect integer");
+	}
+
+	oberon_expr_t * expr;
+	expr = oberon_make_bin_op(ctx, PLUS, dst, oberon_make_integer(ctx, 1));
+	oberon_assign(ctx, expr, dst);
+}
+
+static void
+oberon_make_incl_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
+{
+	if(num_args < 2)
+	{
+		oberon_error(ctx, "too few arguments");
+	}
+
+	if(num_args > 2)
+	{
+		oberon_error(ctx, "too mach arguments");
+	}
+
+	oberon_expr_t * dst;
+	dst = list_args;
+	oberon_check_dst(ctx, dst);
+
+	if(!oberon_is_set_type(dst -> result))
+	{
+		oberon_error(ctx, "expect integer");
+	}
+
+	oberon_expr_t * x;
+	x = list_args -> next;
+	oberon_check_src(ctx, x);
+	
+	if(!oberon_is_integer_type(x -> result))
+	{
+		oberon_error(ctx, "expect integer");
+	}
+
+	oberon_expr_t * expr;
+	expr = oberon_make_bin_op(ctx, PLUS, dst, oberon_new_operator(OP_RANGE, dst -> result, x, NULL));
+	oberon_assign(ctx, expr, dst);
+}
+
+static void
+oberon_make_excl_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
+{
+	if(num_args < 2)
+	{
+		oberon_error(ctx, "too few arguments");
+	}
+
+	if(num_args > 2)
+	{
+		oberon_error(ctx, "too mach arguments");
+	}
+
+	oberon_expr_t * dst;
+	dst = list_args;
+	oberon_check_dst(ctx, dst);
+
+	if(!oberon_is_set_type(dst -> result))
+	{
+		oberon_error(ctx, "expect integer");
+	}
+
+	oberon_expr_t * x;
+	x = list_args -> next;
+	oberon_check_src(ctx, x);
+	
+	if(!oberon_is_integer_type(x -> result))
+	{
+		oberon_error(ctx, "expect integer");
+	}
+
+	oberon_expr_t * expr;
+	expr = oberon_make_bin_op(ctx, MINUS, dst, oberon_new_operator(OP_RANGE, dst -> result, x, NULL));
+	oberon_assign(ctx, expr, dst);
+}
+
+static void
+oberon_make_dec_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
+{
+	if(num_args < 1)
+	{
+		oberon_error(ctx, "too few arguments");
+	}
+
+	if(num_args > 1)
+	{
+		oberon_error(ctx, "too mach arguments");
+	}
+
+	oberon_expr_t * dst;
+	dst = list_args;
+	oberon_check_dst(ctx, dst);
+
+	if(!oberon_is_integer_type(dst -> result))
+	{
+		oberon_error(ctx, "expect integer");
+	}
+
+	oberon_expr_t * expr;
+	expr = oberon_make_bin_op(ctx, MINUS, dst, oberon_make_integer(ctx, 1));
+	oberon_assign(ctx, expr, dst);
+}
+
 static void
 oberon_make_new_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
 {
@@ -4336,17 +4472,23 @@ oberon_create_context(ModuleImportCallback import_module)
 	oberon_new_intrinsic(ctx, "CHR", oberon_make_chr_call, NULL);
 	oberon_new_intrinsic(ctx, "ENTIER", oberon_make_entier_call, NULL);
 	oberon_new_intrinsic(ctx, "LEN", oberon_make_len_call, NULL);
-	oberon_new_intrinsic(ctx, "MIN", oberon_make_min_call, NULL);
+	//oberon_new_intrinsic(ctx, "LONG", oberon_make_long_call, NULL);
 	oberon_new_intrinsic(ctx, "MAX", oberon_make_max_call, NULL);
+	oberon_new_intrinsic(ctx, "MIN", oberon_make_min_call, NULL);
 	oberon_new_intrinsic(ctx, "ODD", oberon_make_odd_call, NULL);
 	oberon_new_intrinsic(ctx, "ORD", oberon_make_ord_call, NULL);
+	//oberon_new_intrinsic(ctx, "SHORT", oberon_make_short_call, NULL);
 	oberon_new_intrinsic(ctx, "SIZE", oberon_make_size_call, NULL);
 
 	/* Procedures */
-	oberon_new_intrinsic(ctx, "NEW", NULL, oberon_make_new_call);
-	oberon_new_intrinsic(ctx, "COPY", NULL, oberon_make_copy_call);
 	oberon_new_intrinsic(ctx, "ASSERT", NULL, oberon_make_assert_call);
+	oberon_new_intrinsic(ctx, "COPY", NULL, oberon_make_copy_call);
+	oberon_new_intrinsic(ctx, "DEC", NULL, oberon_make_dec_call);
+	oberon_new_intrinsic(ctx, "EXCL", NULL, oberon_make_excl_call);
 	oberon_new_intrinsic(ctx, "HALT", NULL, oberon_make_halt_call);
+	oberon_new_intrinsic(ctx, "INC", NULL, oberon_make_inc_call);
+	oberon_new_intrinsic(ctx, "INCL", NULL, oberon_make_incl_call);
+	oberon_new_intrinsic(ctx, "NEW", NULL, oberon_make_new_call);
 
 	return ctx;
 }