From 789adb9354da345b13aa284f3f4f8f1046cadbc4 Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Fri, 18 Aug 2017 15:59:08 +0300 Subject: [PATCH] =?utf8?q?=D0=94=D0=BE=D0=B1=D0=B0=D0=B2=D0=BB=D0=B5=D0=BD?= =?utf8?q?=D0=B0=20=D1=84=D1=83=D0=BD=D0=BA=D1=86=D0=B8=D1=8F=20SYSTEM.ROT?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- Test.obn | 15 +++++-- Test12.obn | 49 +++++++++++--------- notes | 3 +- rtl/SYSTEM.java | 46 +++++++++++++++++++ src/backends/jvm/generator-jvm.c | 51 +++++++++------------ src/oberon-internals.h | 3 +- src/oberon.c | 76 +++++++++++++++++++++++++++++++- 7 files changed, 185 insertions(+), 58 deletions(-) diff --git a/Test.obn b/Test.obn index f5f0600..3c869ea 100644 --- a/Test.obn +++ b/Test.obn @@ -3,10 +3,17 @@ MODULE Test; IMPORT SYSTEM, Out; VAR - i : INTEGER; + i, j : INTEGER; BEGIN - i := -32; - Out.Int(SYSTEM.LSH(i, -5), 0); Out.Char(" "); Out.Int(SYSTEM.LSH(-32, -5), 0); Out.Ln; - ASSERT(SYSTEM.LSH(i, -5) = SYSTEM.LSH(-32, -5)); + i := 1; + j := -32; + Out.Int(SYSTEM.ROT(i, -1), 0); Out.String(" = "); Out.Int(SYSTEM.ROT(1, -1), 0); Out.Ln; + Out.Int(SYSTEM.ROT(i, 1), 0); Out.String(" = "); Out.Int(SYSTEM.ROT(1, 1), 0); Out.Ln; + Out.Int(SYSTEM.ROT(j, -1), 0); Out.String(" = "); Out.Int(SYSTEM.ROT(-32, -1), 0); Out.Ln; + Out.Int(SYSTEM.ROT(j, 1), 0); Out.String(" = "); Out.Int(SYSTEM.ROT(-32, 1), 0); Out.Ln; + + ASSERT(SYSTEM.ROT(i, -1) = SYSTEM.ROT(1, -1)); + + ASSERT(SYSTEM.ROT(i, 1) = SYSTEM.ROT(1, 1)); END Test. diff --git a/Test12.obn b/Test12.obn index 05273a2..74562f6 100644 --- a/Test12.obn +++ b/Test12.obn @@ -1,31 +1,40 @@ MODULE Test12; -IMPORT SYSTEM; +IMPORT SYSTEM, Out; CONST - con = -32; - comp = 32; + xConI = -33; + xConJ = 33; + nConK = -5; + nConL = 5; VAR - i, j : INTEGER; + i, j : HUGEINT; +PROCEDURE Chk(a, b : HUGEINT); BEGIN - i := con; - j := comp; - - ASSERT(ASH(i, -5) = ASH(con, -5)); - ASSERT(ASH(i, 5) = ASH(con, 5)); - ASSERT(ASH(j, -5) = ASH(comp, -5)); - ASSERT(ASH(j, 5) = ASH(comp, 5)); - -(* - (* Константы вычисляются с максимальной точностью, поэтому всегда провал *) - ASSERT(SYSTEM.LSH(i, -5) = SYSTEM.LSH(con, -5)); -*) - - ASSERT(SYSTEM.LSH(i, 5) = SYSTEM.LSH(con, 5)); - ASSERT(SYSTEM.LSH(j, -5) = SYSTEM.LSH(comp, -5)); - ASSERT(SYSTEM.LSH(j, 5) = SYSTEM.LSH(comp, 5)); + Out.Int(a, 0); Out.String(" = "); Out.Int(b, 0); Out.Ln; + ASSERT(a = b); +END Chk; + +BEGIN + i := xConI; + j := xConJ; + + Chk(ASH(i, nConK), ASH(xConI, nConK)); + Chk(ASH(i, nConL), ASH(xConI, nConL)); + Chk(ASH(j, nConK), ASH(xConJ, nConK)); + Chk(ASH(j, nConL), ASH(xConJ, nConL)); + + Chk(SYSTEM.LSH(i, nConK), SYSTEM.LSH(xConI, nConK)); + Chk(SYSTEM.LSH(i, nConL), SYSTEM.LSH(xConI, nConL)); + Chk(SYSTEM.LSH(j, nConK), SYSTEM.LSH(xConJ, nConK)); + Chk(SYSTEM.LSH(j, nConL), SYSTEM.LSH(xConJ, nConL)); + + Chk(SYSTEM.ROT(i, nConK), SYSTEM.ROT(xConI, nConK)); + Chk(SYSTEM.ROT(i, nConL), SYSTEM.ROT(xConI, nConL)); + Chk(SYSTEM.ROT(j, nConK), SYSTEM.ROT(xConJ, nConK)); + Chk(SYSTEM.ROT(j, nConL), SYSTEM.ROT(xConJ, nConL)); END Test12. Проверка сдвигов. diff --git a/notes b/notes index fa7705d..5ac3bbd 100644 --- a/notes +++ b/notes @@ -1,6 +1,6 @@ - Перепроверить конверсию строк единичного размера в символ. - Не полная реализация модуля SYSTEM - * Нет функций CC ROT VAL + * Нет функций CC VAL * Процедуры GETREG PUTREG впринципе вписываются в jvm и могут быть полезны при реализции рефлекции - Нет процедур привязанных к типм (10.2) @@ -17,7 +17,6 @@ - Надо что-то делать с ситуацией описанной в (okawood 2.4) - Нет модулей Math and MathL (oakwood 1.2.7) -- Не совсем корректное значение при логическом сдвиге отрицательного числа (см. Test12) - Запретить проверку типа и приведене типа если указатель имеет значение NIL (oakwood 2.3.3) - Запретить доступ к битам SET которые не входят в пределы 0..MAX(SET) (oakwood 2.3.5) - Запретить каст через SHORT если значение не в пределах результата (в рантайме чтоли?) (oakwood 2.3.6) diff --git a/rtl/SYSTEM.java b/rtl/SYSTEM.java index ce1b506..20cbe60 100644 --- a/rtl/SYSTEM.java +++ b/rtl/SYSTEM.java @@ -81,4 +81,50 @@ public class SYSTEM throw new RuntimeException("TRAP CODE " + n); } } + + public static int ASH(int x, int n) + { + return (n > 0) ? (x << n) : (x >> Math.abs(n)); + } + + public static long ASH(long x, long n) + { + return (n > 0) ? (x << n) : (x >> Math.abs(n)); + } + + public static int LSH(int x, int n) + { + return (n > 0) ? (x << n) : (x >>> Math.abs(n)); + } + + public static long LSH(long x, long n) + { + return (n > 0) ? (x << n) : (x >>> Math.abs(n)); + } + + public static int ROT(int x, int n) + { + if(n > 0) + { + return (x << n) | (x >>> (Integer.SIZE - n)); + } + else + { + n = Math.abs(n); + return (x >>> n) | (x << (Integer.SIZE - n)); + } + } + + public static long ROT(long x, long n) + { + if(n > 0) + { + return (x << n) | (x >>> (Long.SIZE - n)); + } + else + { + n = Math.abs(n); + return (x >>> n) | (x << (Long.SIZE - n)); + } + } } diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c index c131f7f..c063e2f 100644 --- a/src/backends/jvm/generator-jvm.c +++ b/src/backends/jvm/generator-jvm.c @@ -1570,43 +1570,35 @@ jvm_generate_in(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b) } static void -jvm_generate_ash(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b, bool logical) +jvm_generate_shift(gen_proc_t * p, int op, oberon_expr_t * a, oberon_expr_t * b) { oberon_type_t * t = a -> result; int cell_size = jvm_cell_size_for_type(t); char prefix = jvm_get_prefix(t); - int label_else = jvm_new_label_id(p); - int label_end = jvm_new_label_id(p); - - /* if b < 0 then a << b else a >> b end */ + char dt = jvm_get_type_of_prefix(prefix); push_expr(p, a); + jvm_generate_cast_type(p, a -> result, t); push_expr(p, b); - if(cell_size == 1) - { - jvm_generate(p, cell_size, 2 * cell_size, "dup"); - } - else - { - jvm_generate(p, cell_size, 2 * cell_size, "dup2"); - } - jvm_generate_push_int_size(p, 0, t -> size); - jvm_generate_compare_op(p, t, OP_LSS); + jvm_generate_cast_type(p, b -> result, t); - jvm_generate(p, cell_size, 0, "ifne L%i", label_else); - jvm_generate(p, 2 * cell_size, cell_size, "%cshl", prefix); - jvm_generate(p, 0, 0, "goto L%i", label_end); - jvm_generate_label(p, label_else); - jvm_generate_abs(p, prefix); - if(logical) - { - jvm_generate(p, 2 * cell_size, cell_size, "%cushr", prefix); - } - else + char * opname; + switch(op) { - jvm_generate(p, 2 * cell_size, cell_size, "%cshr", prefix); + case OP_ASH: + opname = "ASH"; + break; + case OP_LSH: + opname = "LSH"; + break; + case OP_ROT: + opname = "ROT"; + break; + default: + gen_error("jvm_generate_shift: invalid op %i", op); } - jvm_generate_label(p, label_end); + + jvm_generate(p, 2 * cell_size, cell_size, "invokestatic SYSTEM/%s(%c%c)%c", opname, dt, dt, dt); } static void @@ -1687,10 +1679,9 @@ push_operator(gen_proc_t * p, oberon_oper_t * oper) break; case OP_ASH: - jvm_generate_ash(p, oper -> left, oper -> right, false); - break; case OP_LSH: - jvm_generate_ash(p, oper -> left, oper -> right, true); + case OP_ROT: + jvm_generate_shift(p, op, oper -> left, oper -> right); break; default: gen_error("push_oper: unk op %i", op); diff --git a/src/oberon-internals.h b/src/oberon-internals.h index b81eb95..528842b 100644 --- a/src/oberon-internals.h +++ b/src/oberon-internals.h @@ -229,7 +229,8 @@ enum oberon_operator_kind OP_IN, OP_ASH, - OP_LSH + OP_LSH, + OP_ROT }; struct oberon_item_t 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); -- 2.29.2