From 9aa6ede8ebe1b901501ad3cb49d79d6811a79dc9 Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Fri, 18 Aug 2017 16:54:18 +0300 Subject: [PATCH] =?utf8?q?=D0=94=D0=BE=D0=B1=D0=B0=D0=B2=D0=BB=D0=B5=D0=BD?= =?utf8?q?=D1=8B=20=D1=84=D1=83=D0=BD=D0=BA=D1=86=D0=B8=D0=B8=20SYSTEM.CC?= =?utf8?q?=20=D0=B8=20SYSTEM.VAL?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- Test.obn | 17 +++----- notes | 1 - src/backends/jvm/generator-jvm.c | 28 +++++++++++++ src/oberon-internals.h | 1 + src/oberon.c | 69 ++++++++++++++++++++++++++++++++ 5 files changed, 104 insertions(+), 12 deletions(-) diff --git a/Test.obn b/Test.obn index 3c869ea..d232953 100644 --- a/Test.obn +++ b/Test.obn @@ -2,18 +2,13 @@ MODULE Test; IMPORT SYSTEM, Out; +TYPE + R = RECORD END; + VAR - i, j : INTEGER; + i : INTEGER; + l : LONGINT; BEGIN - 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)); + i := SYSTEM.VAL(INTEGER, l); END Test. diff --git a/notes b/notes index 5ac3bbd..ad35ef7 100644 --- a/notes +++ b/notes @@ -1,6 +1,5 @@ - Перепроверить конверсию строк единичного размера в символ. - Не полная реализация модуля SYSTEM - * Нет функций CC VAL * Процедуры GETREG PUTREG впринципе вписываются в jvm и могут быть полезны при реализции рефлекции - Нет процедур привязанных к типм (10.2) diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c index c063e2f..1281c19 100644 --- a/src/backends/jvm/generator-jvm.c +++ b/src/backends/jvm/generator-jvm.c @@ -1207,6 +1207,30 @@ jvm_generate_cast_type(gen_proc_t * p, oberon_type_t * from, oberon_type_t * to) } } +static void +jvm_generate_hard_cast_type(gen_proc_t * p, oberon_type_t * from, oberon_type_t * to) +{ + if(from -> class == OBERON_TYPE_REAL + && (to -> class == OBERON_TYPE_INTEGER || to -> class == OBERON_TYPE_SYSTEM_BYTE)) + { + char postfix = jvm_get_postfix(to); + if(from -> size <= 4) + { + jvm_generate(p, 1, 1, "invokestatic java/lang/Float/floatToIntBits(F)I"); + jvm_generate_cast_prefix(p, 'I', postfix); + } + else + { + jvm_generate(p, 2, 2, "invokestatic java/lang/Double/floatToIntBits(D)J"); + jvm_generate_cast_prefix(p, 'J', postfix); + } + } + else + { + jvm_generate_cast_type(p, from, to); + } +} + static void push_item(gen_proc_t * p, oberon_item_t * item) { @@ -1624,6 +1648,10 @@ push_operator(gen_proc_t * p, oberon_oper_t * oper) push_expr(p, oper -> left); jvm_generate_cast_type(p, oper -> left -> result, oper -> result); break; + case OP_HARDCAST: + push_expr(p, oper -> left); + jvm_generate_hard_cast_type(p, oper -> left -> result, oper -> result); + break; case OP_COMPLEMENTATION: case OP_UNARY_MINUS: case OP_LOGIC_NOT: diff --git a/src/oberon-internals.h b/src/oberon-internals.h index 528842b..ad2ecc6 100644 --- a/src/oberon-internals.h +++ b/src/oberon-internals.h @@ -218,6 +218,7 @@ enum oberon_operator_kind OP_GEQ, OP_CAST, + OP_HARDCAST, OP_IS, OP_RANGE, diff --git a/src/oberon.c b/src/oberon.c index 9080fb1..c1e86d2 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -1056,6 +1056,12 @@ oberon_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * p return cast; } +static oberon_expr_t * +oberon_hard_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref) +{ + return oberon_new_operator(OP_HARDCAST, pref, expr, NULL); +} + static void oberon_check_dst(oberon_context_t * ctx, oberon_expr_t * dst) { @@ -4471,6 +4477,38 @@ oberon_make_odd_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ return expr; } +static oberon_expr_t * +oberon_make_cc_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 * arg; + arg = list_args; + oberon_check_src(ctx, arg); + oberon_check_const(ctx, arg); + + if(!oberon_is_integer_type(arg -> result)) + { + oberon_error(ctx, "expected integer"); + } + + /* n >= 0 && n <= 15 */ + + oberon_expr_t * cond1; + oberon_expr_t * cond2; + cond1 = oberon_make_bin_op(ctx, GEQ, arg, oberon_make_integer(ctx, 0)); + cond2 = oberon_make_bin_op(ctx, LEQ, arg, oberon_make_integer(ctx, 15)); + return oberon_make_bin_op(ctx, AND, cond1, cond2); +} + static oberon_expr_t * oberon_make_short_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args) { @@ -4525,6 +4563,35 @@ oberon_make_long_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list return expr; } +static oberon_expr_t * +oberon_make_val_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 * typ; + typ = list_args; + if(!oberon_is_type_expr(typ)) + { + oberon_error(ctx, "requires type"); + } + + oberon_expr_t * arg; + arg = list_args -> next; + oberon_check_src(ctx, arg); + + oberon_expr_t * expr; + expr = oberon_hard_cast_expr(ctx, arg, typ -> result); + return expr; +} + static oberon_expr_t * oberon_make_len_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args) { @@ -4770,8 +4837,10 @@ oberon_create_context(ModuleImportCallback import_module) oberon_new_intrinsic_type(ctx, "PTR", ctx -> system_ptr_type); /* Functions */ + oberon_new_intrinsic(ctx, "CC", oberon_make_cc_call, NULL); oberon_new_intrinsic(ctx, "LSH", oberon_make_lsh_call, NULL); oberon_new_intrinsic(ctx, "ROT", oberon_make_rot_call, NULL); + oberon_new_intrinsic(ctx, "VAL", oberon_make_val_call, NULL); oberon_end_intrinsic_module(ctx, ctx -> system_module); -- 2.29.2