Переделано присваивание строк и добавлены процедуры COPY, ASSERT и HALT

diff --git a/System.obn b/System.obn
deleted file mode 100644 (file)
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 4f539100d6439b048d2ea9800b769c3be98a24a2..8c3a8d1458efc80ddf4837c106b664b70a3abfae 100644 (file)
--- 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 (file)
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 072a37d62285032ed0146ec950b713f235fe0074..ce31365148ecc7ab65d5dc428e6953540148651d 100644 (file)
--- 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 2c7dbec0d4db0896ccb65078e38721830575d20a..d809c75a049eba6821cf82b0fbe0a4ef2be4e278 100755 (executable)
--- 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 ef0185c27928f96c1b3f10e1d1f9ce868b8d7563..9514a22a4b2d741e8f1fcb7fd5d80d3e2605b50c 100755 (executable)
--- 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 (file)
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 (file)
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 d0dabd2d914edf2f7b7168725b6f5730845b14a2..b404fca454e4d62bd85c1ba6471bce291c0abe1b 100644 (file)
--- 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 5e74d18a0acfdf31d609959415e0d7a92ecdfc5a..401196595b08b739401d9e39e82ec6d80c9d2ace 100644 (file)
--- 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 a940dab046fb25f2376e91bc754f53b4100fa920..bc502cc1a784b4de25845e97549e971df26ae362 100644 (file)
--- 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 9738056b94124b347e771b1bb541364e83859ae6..1f33a03c9d82bc084e3ffb1b38777b6750bc9c2f 100644 (file)
--- 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;
 }