From 9f8036eb00032fa7f756113365cb42e05ab262df Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Fri, 11 Aug 2017 14:27:56 +0300 Subject: [PATCH] =?utf8?q?=D0=9F=D0=B5=D1=80=D0=B5=D0=B4=D0=B5=D0=BB=D0=B0?= =?utf8?q?=D0=BD=D0=BE=20=D0=BF=D1=80=D0=B8=D1=81=D0=B2=D0=B0=D0=B8=D0=B2?= =?utf8?q?=D0=B0=D0=BD=D0=B8=D0=B5=20=D1=81=D1=82=D1=80=D0=BE=D0=BA=20?= =?utf8?q?=D0=B8=20=D0=B4=D0=BE=D0=B1=D0=B0=D0=B2=D0=BB=D0=B5=D0=BD=D1=8B?= =?utf8?q?=20=D0=BF=D1=80=D0=BE=D1=86=D0=B5=D0=B4=D1=83=D1=80=D1=8B=20COPY?= =?utf8?q?,=20ASSERT=20=D0=B8=20HALT?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- System.obn | 6 -- Test.obn | 16 +-- Test6.obn | 20 ++++ notes | 4 +- obn-run-tests.sh | 1 + obn-run.sh | 2 +- rtl/SYSTEM.java | 47 +++++++++ rtl/System.java | 7 -- src/backends/jvm/generator-jvm-abi.c | 5 +- src/backends/jvm/generator-jvm.c | 59 +++++++++++ src/generator.h | 4 + src/oberon.c | 144 +++++++++++++++++++++++++-- 12 files changed, 285 insertions(+), 30 deletions(-) delete mode 100644 System.obn create mode 100644 Test6.obn create mode 100644 rtl/SYSTEM.java delete mode 100644 rtl/System.java diff --git a/System.obn b/System.obn deleted file mode 100644 index 54db52e..0000000 --- a/System.obn +++ /dev/null @@ -1,6 +0,0 @@ -MODULE System; - -PROCEDURE Halt*(n : INTEGER); -END Halt; - -END System. diff --git a/Test.obn b/Test.obn index 4f53910..8c3a8d1 100644 --- a/Test.obn +++ b/Test.obn @@ -3,12 +3,16 @@ MODULE Test; IMPORT Out; VAR - f : BOOLEAN; - r, e : POINTER TO RECORD END; + msg : ARRAY 20 OF CHAR; BEGIN - f := r = e; - IF f THEN - Out.String('Yes'); Out.Ln; - END; + Out.Open; + COPY("Hello World!", msg); + Out.String(msg); Out.Ln; + COPY("Hell!", msg); + Out.String(msg); Out.Ln; + COPY("The quick brown fox jumps over the lazy dog", msg); + Out.String(msg); Out.Ln; + msg := "Hello World!"; + Out.String(msg); Out.Ln; END Test. diff --git a/Test6.obn b/Test6.obn new file mode 100644 index 0000000..db6cede --- /dev/null +++ b/Test6.obn @@ -0,0 +1,20 @@ +MODULE Test6; + +IMPORT Out; + +VAR + msg : ARRAY 20 OF CHAR; + +BEGIN + Out.Open; + COPY("Hello World!", msg); + Out.String(msg); Out.Ln; + COPY("Hell!", msg); + Out.String(msg); Out.Ln; + COPY("The quick brown fox jumps over the lazy dog", msg); + Out.String(msg); Out.Ln; + msg := "Hello World!"; + Out.String(msg); Out.Ln; +END Test6. + +Проверка строк. COPY должен обрезать строки если не лезет. diff --git a/notes b/notes index 072a37d..ce31365 100644 --- a/notes +++ b/notes @@ -1,4 +1,3 @@ -- Переделать присваивание строк. - Сделать проверку повторов в CASE и выполнять прирывание при отсутствии ELSE. - В FOR сначала должна вычисляться переменная temp. - Сделать выполнение прерывания при отсутствии ELSE в операторе WITH. @@ -9,7 +8,7 @@ - Нет модуля SYSTEM - Нет функций ASH CAP CHR ENTIER LEN LONG ODD ORD SHORT -- Нет процедур ASSERT COPY DEC EXCL HALT INC INCL +- Нет процедур DEC EXCL INC INCL - Нет счёта строк / столбцов - Нет процедур привязанных к типм - Не реализована свёртка констант @@ -24,6 +23,7 @@ - Уточнить как должна работать проверка импорта на чтение. (8.1) - Уточнить результат оператора "/" (8.2.2) - Примеры -5 DIV 3 и -5 MOD 3 работают не так как в (8.2.2) + Нужен другой тип округления? - Нужны средства создания биндингов. На данный момент реализуемо как заглушки для модулей. - Любая ошибка фатальна diff --git a/obn-run-tests.sh b/obn-run-tests.sh index 2c7dbec..d809c75 100755 --- a/obn-run-tests.sh +++ b/obn-run-tests.sh @@ -32,3 +32,4 @@ maketest Test2 maketest Test3 maketest Test4 maketest Test5 +maketest Test6 diff --git a/obn-run.sh b/obn-run.sh index ef0185c..9514a22 100755 --- a/obn-run.sh +++ b/obn-run.sh @@ -2,4 +2,4 @@ set -e -java -cp classes Launcher $1 +java -ea -cp classes Launcher $1 diff --git a/rtl/SYSTEM.java b/rtl/SYSTEM.java new file mode 100644 index 0000000..f98236b --- /dev/null +++ b/rtl/SYSTEM.java @@ -0,0 +1,47 @@ +public class SYSTEM +{ + /* Каркас для фреймов процедур */ + public static abstract class FRAME + { + public FRAME up; + } + + /* Длинна строки LEN(s$) */ + public static int LEN(byte[] x) + { + int i = 0; + while(x[i] != 0) + { + i += 1; + } + return i; + } + + /* Встроенная процедура COPY(x, v) */ + public static void COPY(byte[] x, byte[] v) + { + int len_x = LEN(x); + int len_v = v.length - 1; + int len = (len_x < len_v) ? (len_x) : (len_v); + for(int i = 0; i < len; i++) + { + v[i] = x[i]; + } + v[len] = 0; + } + + public static void HALT(long n) + { + System.exit((int) n); + } + + public static void ASSERT(boolean x) + { + assert x; + } + + public static void ASSERT(boolean x, long n) + { + assert x : n; + } +} diff --git a/rtl/System.java b/rtl/System.java deleted file mode 100644 index d2ccf9b..0000000 --- a/rtl/System.java +++ /dev/null @@ -1,7 +0,0 @@ -public class System -{ - public static void Halt(short n) - { - java.lang.System.exit(n); - } -} diff --git a/src/backends/jvm/generator-jvm-abi.c b/src/backends/jvm/generator-jvm-abi.c index d0dabd2..b404fca 100644 --- a/src/backends/jvm/generator-jvm-abi.c +++ b/src/backends/jvm/generator-jvm-abi.c @@ -358,6 +358,7 @@ jvm_generate_var_initialization(gen_proc_t * p, gen_var_t * v) } } +/* static void jvm_generate_abstract_frame_class() { @@ -383,6 +384,7 @@ jvm_generate_abstract_frame_class() jvm_destroy_class(class); } +*/ static struct gen_class * jvm_generate_frame_class(oberon_object_t * proc) @@ -478,7 +480,8 @@ jvm_generate_procedure_frame(oberon_object_t * proc) p = proc -> gen_proc; - jvm_generate_abstract_frame_class(); +// jvm_generate_abstract_frame_class(); + class = jvm_generate_frame_class(proc); t = GC_MALLOC(sizeof *t); diff --git a/src/backends/jvm/generator-jvm.c b/src/backends/jvm/generator-jvm.c index 5e74d18..4011965 100644 --- a/src/backends/jvm/generator-jvm.c +++ b/src/backends/jvm/generator-jvm.c @@ -1641,3 +1641,62 @@ oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_ store_expr(p, dst, src); } + +void +oberon_generate_copy(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst) +{ + gen_module_t * m; + gen_proc_t * p; + char * desc; + + m = ctx -> mod -> gen_mod; + p = m -> class -> p; + + push_expr(p, src); + push_expr(p, dst); + + desc = jvm_get_descriptor(dst -> result); + + jvm_generate(p, 2, 0, "invokestatic SYSTEM/COPY(%s%s)V", desc, desc); +} + +void +oberon_generate_assert(oberon_context_t * ctx, oberon_expr_t * cond) +{ + gen_module_t * m; + gen_proc_t * p; + + m = ctx -> mod -> gen_mod; + p = m -> class -> p; + + push_expr(p, cond); + jvm_generate(p, 1, 0, "invokestatic SYSTEM/ASSERT(Z)V"); +} + +void +oberon_generate_assert_n(oberon_context_t * ctx, oberon_expr_t * cond, int64_t n) +{ + gen_module_t * m; + gen_proc_t * p; + + m = ctx -> mod -> gen_mod; + p = m -> class -> p; + + push_expr(p, cond); + jvm_generate_push_int_size(p, n, 8); + jvm_generate(p, 1 + 2, 0, "invokestatic SYSTEM/ASSERT(ZJ)V"); +} + +void +oberon_generate_halt(oberon_context_t * ctx, int64_t n) +{ + gen_module_t * m; + gen_proc_t * p; + + m = ctx -> mod -> gen_mod; + p = m -> class -> p; + + jvm_generate_push_int_size(p, n, 8); + jvm_generate(p, 2, 0, "invokestatic SYSTEM/HALT(J)V"); +} + diff --git a/src/generator.h b/src/generator.h index a940dab..bc502cc 100644 --- a/src/generator.h +++ b/src/generator.h @@ -38,4 +38,8 @@ void oberon_generate_goto(oberon_context_t * ctx, gen_label_t * l); */ void oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst); +void oberon_generate_copy(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst); +void oberon_generate_assert_n(oberon_context_t * ctx, oberon_expr_t * cond, int64_t n); +void oberon_generate_assert(oberon_context_t * ctx, oberon_expr_t * cond); +void oberon_generate_halt(oberon_context_t * ctx, int64_t n); void oberon_generate_return(oberon_context_t * ctx, oberon_expr_t * expr); diff --git a/src/oberon.c b/src/oberon.c index 9738056..1f33a03 100644 --- a/src/oberon.c +++ b/src/oberon.c @@ -85,6 +85,9 @@ enum { // UTILS // ======================================================================= +static void +oberon_make_copy_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args); + static void oberon_error(oberon_context_t * ctx, const char * fmt, ...) { @@ -1055,6 +1058,11 @@ oberon_check_record_compatibility(oberon_context_t * ctx, oberon_type_t * from, static void oberon_check_dst(oberon_context_t * ctx, oberon_expr_t * dst) { + if(dst -> read_only) + { + oberon_error(ctx, "read-only destination"); + } + if(dst -> is_item == false) { oberon_error(ctx, "not variable"); @@ -3314,14 +3322,30 @@ oberon_statement_seq(oberon_context_t * ctx); static void oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst) { - if(dst -> read_only) + if(src -> is_item + && src -> item.mode == MODE_STRING + && src -> result -> class == OBERON_TYPE_STRING + && dst -> result -> class == OBERON_TYPE_ARRAY + && dst -> result -> base -> class == OBERON_TYPE_CHAR + && dst -> result -> size > 0) { - oberon_error(ctx, "read-only destination"); - } - oberon_check_dst(ctx, dst); - src = oberon_autocast_to(ctx, src, dst -> result); - oberon_generate_assign(ctx, src, dst); + if(strlen(src -> item.string) < dst -> result -> size) + { + src -> next = dst; + oberon_make_copy_call(ctx, 2, src); + } + else + { + oberon_error(ctx, "string too long for destination"); + } + } + else + { + oberon_check_dst(ctx, dst); + src = oberon_autocast_to(ctx, src, dst -> result); + oberon_generate_assign(ctx, src, dst); + } } static oberon_expr_t * @@ -4043,7 +4067,6 @@ oberon_make_new_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ oberon_error(ctx, "too few arguments"); } - oberon_expr_t * dst; dst = list_args; oberon_check_dst(ctx, dst); @@ -4119,6 +4142,110 @@ oberon_make_new_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_ oberon_assign(ctx, src, dst); } +static void +oberon_make_copy_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 * src; + src = list_args; + oberon_check_src(ctx, src); + + oberon_expr_t * dst; + dst = list_args -> next; + oberon_check_dst(ctx, dst); + + if(!oberon_is_string_type(src -> result)) + { + oberon_error(ctx, "source must be string or array of char"); + } + + if(!oberon_is_string_type(dst -> result)) + { + oberon_error(ctx, "dst must be array of char"); + } + + oberon_generate_copy(ctx, src, dst); +} + +static void +oberon_make_assert_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 * cond; + cond = list_args; + oberon_check_src(ctx, cond); + + if(cond -> result -> class != OBERON_TYPE_BOOLEAN) + { + oberon_error(ctx, "expected boolean"); + } + + if(num_args == 1) + { + oberon_generate_assert(ctx, cond); + } + else + { + oberon_expr_t * num; + num = list_args -> next; + oberon_check_src(ctx, num); + + if(num -> result -> class != OBERON_TYPE_INTEGER) + { + oberon_error(ctx, "expected integer"); + } + + oberon_check_const(ctx, num); + + oberon_generate_assert_n(ctx, cond, num -> item.integer); + } +} + +static void +oberon_make_halt_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 * num; + num = list_args; + oberon_check_src(ctx, num); + + if(num -> result -> class != OBERON_TYPE_INTEGER) + { + oberon_error(ctx, "expected integer"); + } + + oberon_check_const(ctx, num); + + oberon_generate_halt(ctx, num -> item.integer); +} + static void oberon_new_const(oberon_context_t * ctx, char * name, oberon_expr_t * expr) { @@ -4155,6 +4282,9 @@ oberon_create_context(ModuleImportCallback import_module) /* 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, "HALT", NULL, oberon_make_halt_call); return ctx; } -- 2.29.2