X-Git-Url: https://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=src%2Foberon.c;h=9080fb144eadec7fad4d923d0c328491bb5f7334;hp=2b114eee9cfd9aa01cf08e2e1d05691c2aa036dd;hb=789adb9354da345b13aa284f3f4f8f1046cadbc4;hpb=2e868cbd80ac5144b08154aaf2cf7bf7be455b61

diff --git a/src/oberon.c b/src/oberon.c
index 2b114ee..9080fb1 100644
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -4161,7 +4161,7 @@ oberon_make_ash_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
 	{
 		int64_t x = arg1 -> item.integer;
 		int64_t y = arg2 -> item.integer;
-		int64_t v = x * powl(2, y);
+		int64_t v = (y > 0) ? (x << y) : (x >> labs(y));
 		expr = oberon_make_integer(ctx, v);
 	}
 	else
@@ -4211,6 +4211,7 @@ oberon_make_lsh_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
 		uint64_t x = arg1 -> item.integer;
 		int64_t y = arg2 -> item.integer;
 		uint64_t v = (y > 0) ? (x << y) : (x >> labs(y));
+
 		if(oberon_is_integer_type(t))
 		{
 			expr = oberon_make_integer(ctx, v);
@@ -4233,6 +4234,78 @@ oberon_make_lsh_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
 	return expr;
 }
 
+static oberon_expr_t *
+oberon_make_rot_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 * arg1;
+	arg1 = list_args;
+	oberon_check_src(ctx, arg1);
+
+	oberon_type_t * t = arg1 -> result;
+	if(!oberon_is_integer_type(t)
+		&& !oberon_is_char_type(t) 
+		&& !oberon_is_system_byte_type(t))
+	{
+		oberon_error(ctx, "expected integer, char, or SYSTEM.BYTE");
+	}
+
+	oberon_expr_t * arg2;
+	arg2 = list_args -> next;
+	oberon_check_src(ctx, arg2);
+	if(arg2 -> result -> class != OBERON_TYPE_INTEGER)
+	{
+		oberon_error(ctx, "expected integer");
+	}
+
+	oberon_expr_t * expr;
+	if(oberon_is_const(arg1) && oberon_is_const(arg2))
+	{
+		uint64_t x = arg1 -> item.integer;
+		int64_t y = arg2 -> item.integer;
+
+		uint64_t v = 0;
+		if(y > 0)
+		{
+			v = (x << y) | (x >> (64 - y));
+		}
+		else
+		{
+			y = labs(y);
+			v = (x >> y) | (x << (64 - y));
+		}
+
+		if(oberon_is_integer_type(t))
+		{
+			expr = oberon_make_integer(ctx, v);
+		}
+		else if(oberon_is_char_type(t))
+		{
+			expr = oberon_make_char(ctx, v);
+		}
+		else
+		{
+			expr = oberon_make_system_byte(ctx, v);
+		}
+	}
+	else
+	{
+		expr = oberon_new_operator(OP_ROT, arg1 -> result, arg1, arg2);
+		expr = oberon_cast_expr(ctx, expr, t);
+	}
+
+	return expr;
+}
+
 static oberon_expr_t *
 oberon_make_cap_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
 {
@@ -4698,6 +4771,7 @@ oberon_create_context(ModuleImportCallback import_module)
 
 		/* Functions */
 		oberon_new_intrinsic(ctx, "LSH", oberon_make_lsh_call, NULL);
+		oberon_new_intrinsic(ctx, "ROT", oberon_make_rot_call, NULL);
 
 	oberon_end_intrinsic_module(ctx, ctx -> system_module);