From b09b4829b70cf34a470003286ea100663d7fe442 Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Sun, 13 Aug 2017 13:08:21 +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=20CHR=20ENTI?= =?utf8?q?ER=20LEN=20ORD?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- Test.obn | 9 +- Test14.obn | 21 ++++ Test15.obn | 14 +++ notes | 2 +- obn-run-tests.sh | 2 + src/backends/jvm/generator-jvm.c | 45 +++++++-- src/oberon-internals.h | 4 +- src/oberon.c | 166 +++++++++++++++++++++++++++++++ 8 files changed, 249 insertions(+), 14 deletions(-) create mode 100644 Test14.obn create mode 100644 Test15.obn diff --git a/Test.obn b/Test.obn index babecff..03df037 100644 --- a/Test.obn +++ b/Test.obn @@ -1,5 +1,12 @@ MODULE Test; +VAR + x : ARRAY 10 OF INTEGER; + p : POINTER TO ARRAY OF ARRAY OF INTEGER; + BEGIN - ASSERT(ODD(5)); + NEW(p, 20, 30); + ASSERT(LEN(x, 0) = 10); + ASSERT(LEN(p^, 0) = 20); + ASSERT(LEN(p^, 1) = 30); END Test. diff --git a/Test14.obn b/Test14.obn new file mode 100644 index 0000000..2baa8db --- /dev/null +++ b/Test14.obn @@ -0,0 +1,21 @@ +MODULE Test14; + +VAR + x : REAL; + +BEGIN + x := 3.6; + ASSERT(ENTIER(x) = 3); + ASSERT(ENTIER(3.6) = 3); + x := 3.5; + ASSERT(ENTIER(x) = 3); + ASSERT(ENTIER(3.5) = 3); + x := -3.6; + ASSERT(ENTIER(x) = -4); + ASSERT(ENTIER(-3.6) = -4); + x := -3.5; + ASSERT(ENTIER(x) = -4); + ASSERT(ENTIER(-3.5) = -4); +END Test14. + +Тест правильности ENTIER. diff --git a/Test15.obn b/Test15.obn new file mode 100644 index 0000000..59be01b --- /dev/null +++ b/Test15.obn @@ -0,0 +1,14 @@ +MODULE Test15; + +VAR + x : ARRAY 10 OF INTEGER; + p : POINTER TO ARRAY OF ARRAY OF INTEGER; + +BEGIN + NEW(p, 20, 30); + ASSERT(LEN(x, 0) = 10); + ASSERT(LEN(p^, 0) = 20); + ASSERT(LEN(p^, 1) = 30); +END Test15. + +Тест LEN. diff --git a/notes b/notes index a6270d0..09e3bd0 100644 --- a/notes +++ b/notes @@ -1,7 +1,7 @@ - Сделать проверку повторов в CASE. - Сделать нормальную проверку наличия RETURN. -- Нет функций CHR ENTIER LEN LONG ORD SHORT +- Нет функций LONG SHORT - Нет процедур DEC EXCL INC INCL - Нет счёта строк / столбцов - Нет процедур привязанных к типм diff --git a/obn-run-tests.sh b/obn-run-tests.sh index 0c0e092..f36da1f 100755 --- a/obn-run-tests.sh +++ b/obn-run-tests.sh @@ -42,3 +42,5 @@ maketest Test10 maketest Test11 maketest Test12 maketest Test13 +maketest Test14 +maketest Test15 diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c index c2fd9ab..5b45cc1 100644 --- a/src/backends/jvm/generator-jvm.c +++ b/src/backends/jvm/generator-jvm.c @@ -1136,6 +1136,19 @@ jvm_generate_expr_new_pointer(gen_proc_t * p, oberon_type_t * type, int num, obe jvm_generate_new(p, type -> base, num); } +static void +jvm_generate_cast_prefix(gen_proc_t * p, char prefix, char postfix) +{ + if(prefix == postfix) + { + return; + } + + int from_cell_size = jvm_cell_size_for_postfix(prefix); + int to_cell_size = jvm_cell_size_for_postfix(postfix); + jvm_generate(p, from_cell_size, to_cell_size, "%c2%c", prefix, postfix); +} + static void jvm_generate_cast_type(gen_proc_t * p, oberon_type_t * from, oberon_type_t * to) { @@ -1151,17 +1164,7 @@ jvm_generate_cast_type(gen_proc_t * p, oberon_type_t * from, oberon_type_t * to) { char prefix = jvm_get_prefix(from); char postfix = jvm_get_postfix(to); - int from_cell_size = jvm_cell_size_for_type(from); - int to_cell_size = jvm_cell_size_for_type(to); - - jvm_generate_comment(p, "cast type class from %i(%i) to %i(%i)", from -> class, from -> size, to -> class, to -> size); - - if(prefix == postfix) - { - return; - } - - jvm_generate(p, from_cell_size, to_cell_size, "%c2%c", prefix, postfix); + jvm_generate_cast_prefix(p, prefix, postfix); } } @@ -1217,6 +1220,11 @@ push_item(gen_proc_t * p, oberon_item_t * item) case MODE_STRING: jvm_generate_push_string(p, item -> string, item -> result -> size); break; + case MODE_LEN: + push_item(p, item -> parent); + jvm_generate_array_len(p, item -> integer); + jvm_generate_cast_prefix(p, 'i', jvm_get_postfix(item -> result)); + break; default: gen_error("push_item: unk mode %i", item -> mode); break; @@ -1555,6 +1563,18 @@ jvm_generate_ash(gen_proc_t * p, oberon_expr_t * a, oberon_expr_t * b) jvm_generate_label(p, label_end); } +static void +jvm_generate_entier(gen_proc_t * p, oberon_expr_t * x, oberon_type_t * res) +{ + char prefix = jvm_get_prefix(x -> result); + char postfix = jvm_get_postfix(res); + + push_expr(p, x); + jvm_generate_cast_prefix(p, prefix, 'd'); + jvm_generate(p, 2, 2, "invokestatic java/lang/Math/floor(D)D"); + jvm_generate_cast_prefix(p, 'd', postfix); +} + static void push_operator(gen_proc_t * p, oberon_oper_t * oper) { @@ -1574,6 +1594,9 @@ push_operator(gen_proc_t * p, oberon_oper_t * oper) push_expr(p, oper -> left); jvm_generate_operator(p, preq, op); break; + case OP_ENTIER: + jvm_generate_entier(p, oper -> left, oper -> result); + break; case OP_ADD: case OP_SUB: diff --git a/src/oberon-internals.h b/src/oberon-internals.h index 7536540..31c8054 100644 --- a/src/oberon-internals.h +++ b/src/oberon-internals.h @@ -180,7 +180,8 @@ enum oberon_mode_kind MODE_CHAR, MODE_STRING, MODE_TYPE, - MODE_SET + MODE_SET, + MODE_LEN }; enum oberon_operator_kind @@ -189,6 +190,7 @@ enum oberon_operator_kind OP_LOGIC_NOT, OP_ABS, OP_CAP, + OP_ENTIER, OP_ADD, OP_SUB, diff --git a/src/oberon.c b/src/oberon.c index 0854335..53dd33e 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -4111,6 +4111,108 @@ oberon_make_cap_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ return expr; } +static oberon_expr_t * +oberon_make_chr_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); + + if(!oberon_is_integer_type(arg -> result)) + { + oberon_error(ctx, "expected integer"); + } + + oberon_expr_t * expr; + if(oberon_is_const(arg)) + { + expr = oberon_make_char(ctx, arg -> item.integer); + } + else + { + expr = oberon_cast_expr(ctx, arg, ctx -> char_type); + } + return expr; +} + +static oberon_expr_t * +oberon_make_ord_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); + + if(!oberon_is_char_type(arg -> result)) + { + oberon_error(ctx, "expected char"); + } + + oberon_expr_t * expr; + if(oberon_is_const(arg)) + { + expr = oberon_make_integer(ctx, arg -> item.integer); + } + else + { + expr = oberon_cast_expr(ctx, arg, ctx -> int_type); + } + return expr; +} + +static oberon_expr_t * +oberon_make_entier_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); + + if(!oberon_is_real_type(arg -> result)) + { + oberon_error(ctx, "expected real"); + } + + oberon_expr_t * expr; + if(oberon_is_const(arg)) + { + expr = oberon_make_integer(ctx, floor(arg -> item.real)); + } + else + { + expr = oberon_new_operator(OP_ENTIER, ctx -> int_type, arg, NULL); + } + return expr; +} + static oberon_expr_t * oberon_make_odd_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args) { @@ -4139,6 +4241,66 @@ oberon_make_odd_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ return expr; } +static oberon_expr_t * +oberon_make_len_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 > 2) + { + oberon_error(ctx, "too mach arguments"); + } + + oberon_expr_t * v; + v = list_args; + oberon_check_src(ctx, v); + + if(!oberon_is_array_type(v -> result)) + { + oberon_error(ctx, "expected array"); + } + + int n = 0; + if(num_args == 2) + { + oberon_expr_t * num; + num = list_args -> next; + oberon_check_src(ctx, num); + + if(!oberon_is_integer_type(num -> result)) + { + oberon_error(ctx, "expected integer"); + } + oberon_check_const(ctx, num); + + n = num -> item.integer; + } + + int dim = 0; + oberon_type_t * arr = v -> result; + while(arr -> class == OBERON_TYPE_ARRAY) + { + dim += 1; + arr = arr -> base; + } + + if(n < 0 || n > dim) + { + oberon_error(ctx, "not in range 0..%i", dim - 1); + } + + assert(v -> is_item); + + oberon_expr_t * expr; + expr = oberon_new_item(MODE_LEN, ctx -> int_type, true); + expr -> item.parent = (oberon_item_t *) v; + expr -> item.integer = n; + return expr; +} + static void oberon_new_const(oberon_context_t * ctx, char * name, oberon_expr_t * expr) { @@ -4171,9 +4333,13 @@ oberon_create_context(ModuleImportCallback import_module) oberon_new_intrinsic(ctx, "ABS", oberon_make_abs_call, NULL); oberon_new_intrinsic(ctx, "ASH", oberon_make_ash_call, NULL); oberon_new_intrinsic(ctx, "CAP", oberon_make_cap_call, NULL); + 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, "MAX", oberon_make_max_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, "SIZE", oberon_make_size_call, NULL); /* Procedures */ -- 2.29.2