From 9b4f78290edb5f5bedeb12e683546fa00082f108 Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Sun, 13 Aug 2017 13:41:33 +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=D0=BF=D1=80=D0=BE=D1=86=D0=B5=D0=B4=D1=83=D1=80=D1=8B?= =?utf8?q?=20INC=20DEC=20INCL=20EXCL?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- Test.obn | 19 ++++-- Test16.obn | 19 ++++++ notes | 1 - obn-run-tests.sh | 1 + src/oberon.c | 150 +++++++++++++++++++++++++++++++++++++++++++++-- 5 files changed, 179 insertions(+), 11 deletions(-) create mode 100644 Test16.obn diff --git a/Test.obn b/Test.obn index 03df037..da1f545 100644 --- a/Test.obn +++ b/Test.obn @@ -1,12 +1,19 @@ MODULE Test; VAR - x : ARRAY 10 OF INTEGER; - p : POINTER TO ARRAY OF ARRAY OF INTEGER; + i : INTEGER; + s : SET; BEGIN - NEW(p, 20, 30); - ASSERT(LEN(x, 0) = 10); - ASSERT(LEN(p^, 0) = 20); - ASSERT(LEN(p^, 1) = 30); + INC(i); + ASSERT(i = 1); + DEC(i); + ASSERT(i = 0); + + INCL(s, 3); + ASSERT(3 IN s); + EXCL(s, 3); + ASSERT(~(3 IN s)); END Test. + +Проверка встроенных процедур. diff --git a/Test16.obn b/Test16.obn new file mode 100644 index 0000000..dbe58ee --- /dev/null +++ b/Test16.obn @@ -0,0 +1,19 @@ +MODULE Test16; + +VAR + i : INTEGER; + s : SET; + +BEGIN + INC(i); + ASSERT(i = 1); + DEC(i); + ASSERT(i = 0); + + INCL(s, 3); + ASSERT(3 IN s); + EXCL(s, 3); + ASSERT(~(3 IN s)); +END Test16. + +Проверка встроенных процедур. diff --git a/notes b/notes index 09e3bd0..21447a4 100644 --- a/notes +++ b/notes @@ -2,7 +2,6 @@ - Сделать нормальную проверку наличия RETURN. - Нет функций LONG SHORT -- Нет процедур DEC EXCL INC INCL - Нет счёта строк / столбцов - Нет процедур привязанных к типм diff --git a/obn-run-tests.sh b/obn-run-tests.sh index f36da1f..28971d1 100755 --- a/obn-run-tests.sh +++ b/obn-run-tests.sh @@ -44,3 +44,4 @@ maketest Test12 maketest Test13 maketest Test14 maketest Test15 +maketest Test16 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; } -- 2.29.2