Исправлено присваивание и синхронизация сравнений со стандартом

diff --git a/Test.obn b/Test.obn
index b80d7a15c3a490308c7b343ab2843e710f22efde..4f539100d6439b048d2ea9800b769c3be98a24a2 100644 (file)
--- a/Test.obn
+++ b/Test.obn
@@ -1,22 +1,14 @@
 MODULE Test;
 
-TYPE
-  R1 = RECORD END;
-  R2 = RECORD (R1) END;
-  R3 = RECORD END;
-
-  P1 = POINTER TO R1;
-  P2 = POINTER TO R2;
+IMPORT Out;
 
 VAR
-  a : R1;
-  b : R2;
-  c : R3;
-  p1 : P1;
-  p2 : P2;
+  f : BOOLEAN;
+  r, e : POINTER TO RECORD END;
 
 BEGIN
-  a := b;
-  p2 := p1(P2);
-  p1 := p2(P2);
+  f := r = e;
+  IF f THEN
+    Out.String('Yes'); Out.Ln;
+  END;
 END Test.

diff --git a/notes b/notes
index 762ef894f1f8438fe3aa1206d83fdf65fdd832ad..ab857f4b5589f1a2b8d27238ce1e4fea2116990f 100644 (file)
--- a/notes
+++ b/notes
@@ -1,4 +1,6 @@
 - Уточнить как должна работать проверка импорта на чтение. (8.1)
+- Уточнить результат оператора "/" (8.2.2)
+- Примеры -5 DIV 3 и -5 MOD 3 работают не так как в (8.2.2)
 
 - Нет модуля SYSTEM
 - Нет функций ASH CAP CHR ENTIER LEN LONG ODD ORD SHORT
@@ -8,10 +10,9 @@
 - Нужно пробежаться по стандарту и всё перепроверить.
 
 - JVM: Импортируемые модули не инициализируются
-- JVM: Не реализовано полное сранение массивов.
-- JVM: Не реализовано полное сранение записей.
+- JVM: Не реализовано сравнение строк.
 - JVM: Не достаточно средств для реализации рефлексии на уровне локальных процедур.
-    (Как минимум нужно каждой функции добавлять фрейм к параметрам)
+    Как минимум нужно каждой функции добавлять фрейм к параметрам (динамическая связь?)
 
 - Нужны средства создания биндингов. На данный момент реализуемо как заглушки для модулей.
 - Любая ошибка фатальна

diff --git a/src/backends/jvm/generator-jvm-abi.c b/src/backends/jvm/generator-jvm-abi.c
index ddaf45f77cfe6e9e66b535adef6e1413ee5144fa..d0dabd2d914edf2f7b7168725b6f5730845b14a2 100644 (file)
--- a/src/backends/jvm/generator-jvm-abi.c
+++ b/src/backends/jvm/generator-jvm-abi.c
@@ -69,6 +69,7 @@ void
 jvm_generate_load(gen_proc_t * p, gen_var_t * src)
 {
        char prefix = src -> type -> prefix;
+       char postfix = src -> type -> postfix;
        int cell_size = src -> type -> cell_size;
        char * full_name = src -> full_name;
        char * desc = src -> type -> desc;
@@ -94,7 +95,7 @@ jvm_generate_load(gen_proc_t * p, gen_var_t * src)
                case JVM_STORAGE_FRAME_PARAM_VAR:
                case JVM_STORAGE_FRAME_PARAM_VARPTR:
                        jvm_generate_ldst_prepare(p, src);
-                       jvm_generate(p, 1 + 1, cell_size, "%caload", prefix);
+                       jvm_generate(p, 1 + 1, cell_size, "%caload", postfix);
                        break;
                case JVM_STORAGE_FRAME:
                case JVM_STORAGE_FRAME_PARAM:
@@ -111,6 +112,7 @@ void
 jvm_generate_store(gen_proc_t * p, gen_var_t * dst)
 {
        char prefix = dst -> type -> prefix;
+       char postfix = dst -> type -> postfix;
        int cell_size = dst -> type -> cell_size;
        char * full_name = dst -> full_name;
        char * desc = dst -> type -> desc;
@@ -135,7 +137,7 @@ jvm_generate_store(gen_proc_t * p, gen_var_t * dst)
                case JVM_STORAGE_FRAME_VAR:
                case JVM_STORAGE_FRAME_PARAM_VAR:
                case JVM_STORAGE_FRAME_PARAM_VARPTR:
-                       jvm_generate(p, 1 + 1 + cell_size, 0, "%castore", prefix);
+                       jvm_generate(p, 1 + 1 + cell_size, 0, "%castore", postfix);
                        break;
                case JVM_STORAGE_FRAME:
                case JVM_STORAGE_FRAME_PARAM:
@@ -295,6 +297,7 @@ jvm_generate_param_initialization(gen_proc_t * p, gen_var_t * v)
        int old_reg = v -> reg;
        int cell_size = v -> type -> cell_size;
        char prefix = v -> type -> prefix;
+       char postfix = v -> type -> postfix;
        char * name = v -> name;
        char * desc = v -> type -> desc;
 
@@ -308,7 +311,7 @@ jvm_generate_param_initialization(gen_proc_t * p, gen_var_t * v)
 
        jvm_generate(p, 0, 1, "iconst_0");
        jvm_generate(p, 0, cell_size, "%cload %i", prefix, old_reg);
-       jvm_generate(p, 1 + 1 + cell_size, 0, "%castore", prefix);
+       jvm_generate(p, 1 + 1 + cell_size, 0, "%castore", postfix);
 }
 
 void

diff --git a/src/oberon.c b/src/oberon.c
index ece881fc44366290a324ac54b55def84b1c9804b..9738056b94124b347e771b1bb541364e83859ae6 100644 (file)
--- a/src/oberon.c
+++ b/src/oberon.c
@@ -1573,17 +1573,9 @@ oberon_qualident_expr(oberon_context_t * ctx)
        return expr;
 }
 
-static oberon_expr_t *
-oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_object_t * objtype)
+static void
+oberon_check_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * type)
 {
-       oberon_type_t * type;
-
-       if(objtype -> class != OBERON_CLASS_TYPE)
-       {
-               oberon_error(ctx, "must be type");
-       }
-       type = objtype -> type;
-
        /* Охрана типа применима, если */
        /*   1. v - параметр-переменная типа запись, или v - указатель, и если */
        /*   2. T - расширение статического типа v */
@@ -1594,7 +1586,8 @@ oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_obje
        {
                // accept
        }
-       else if(expr -> result -> class == OBERON_TYPE_POINTER)
+       else if(expr -> result -> class == OBERON_TYPE_POINTER
+               || expr -> result -> class == OBERON_TYPE_RECORD)
        {
                // accept
        }
@@ -1604,6 +1597,20 @@ oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_obje
        }
 
        oberon_check_record_compatibility(ctx, type, expr -> result);
+}
+
+static oberon_expr_t *
+oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_object_t * objtype)
+{
+       oberon_type_t * type;
+
+       if(objtype -> class != OBERON_CLASS_TYPE)
+       {
+               oberon_error(ctx, "must be type");
+       }
+       type = objtype -> type;
+
+       oberon_check_type_guard(ctx, expr, type);
        return oberno_make_record_cast(ctx, expr, objtype -> type);
 }
 
@@ -1858,15 +1865,6 @@ oberon_factor(oberon_context_t * ctx)
        return expr;
 }
 
-#define ITMAKESBOOLEAN(x) \
-       (((x) >= EQUAL && (x) <= GEQ) || ((x) == OR) || ((x) == AND))
-
-#define ITUSEONLYINTEGER(x) \
-       ((x) >= LESS && (x) <= GEQ)
-
-#define ITUSEONLYBOOLEAN(x) \
-       (((x) == OR) || ((x) == AND))
-
 static void
 oberon_autocast_to_real(oberon_context_t * ctx, oberon_expr_t ** e)
 {
@@ -1888,6 +1886,49 @@ oberon_autocast_to_real(oberon_context_t * ctx, oberon_expr_t ** e)
        }
 }
 
+static bool
+oberon_is_numeric_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_INTEGER) || (t -> class == OBERON_TYPE_REAL);
+}
+
+static bool
+oberon_is_char_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_CHAR);
+}
+
+static bool
+oberon_is_string_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_STRING)
+               || (t -> class == OBERON_TYPE_ARRAY && t -> base -> class == OBERON_TYPE_CHAR);
+}
+
+static bool
+oberon_is_boolean_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_BOOLEAN);
+}
+
+static bool
+oberon_is_set_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_SET);
+}
+
+static bool
+oberon_is_pointer_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_POINTER) || (t -> class == OBERON_TYPE_NIL);
+}
+
+static bool
+oberon_is_procedure_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_POINTER) || (t -> class == OBERON_TYPE_NIL);
+}
+
 static oberon_expr_t *
 oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
 {
@@ -1912,66 +1953,82 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
        }
        else if(token == IS)
        {
-               oberon_type_t * v = a -> result;
-               if(v -> class == OBERON_TYPE_POINTER)
-               {
-                       v = v -> base;
-                       if(v -> class != OBERON_TYPE_RECORD)
-                       {
-                               oberon_error(ctx, "must be record");
-                       }
-               }
-               else if(v -> class != OBERON_TYPE_RECORD)
-               {
-                       oberon_error(ctx, "must be record");
-               }               
-
                if(b -> is_item == false || b -> item.mode != MODE_TYPE)
                {
                        oberon_error(ctx, "requires type");
                }
 
-               oberon_type_t * t = b -> result;
-               if(t -> class == OBERON_TYPE_POINTER)
-               {
-                       t = t -> base;
-                       if(t -> class != OBERON_TYPE_RECORD)
-                       {
-                               oberon_error(ctx, "must be record");
-                       }
-               }
-               else if(t -> class != OBERON_TYPE_RECORD)
-               {
-                       oberon_error(ctx, "must be record");
-               }
-
                result = ctx -> bool_type;
+               oberon_check_type_guard(ctx, a, b -> result);
                expr = oberon_new_operator(OP_IS, result, a, b);
        }
-       else if(ITMAKESBOOLEAN(token))
+       else if((token >= EQUAL && token <= GEQ) || token == OR || token == AND)
        {
-               if(ITUSEONLYINTEGER(token))
+               if(token >= LESS && token <= GEQ)
+               {
+                       if(oberon_is_numeric_type(a -> result) && oberon_is_numeric_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_char_type(a -> result) && oberon_is_char_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_string_type(a -> result) && oberon_is_string_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else
+                       {
+                               oberon_error(ctx, "invalid comparation");
+                       }
+               }
+               else if(token == EQUAL || token == NEQ)
                {
-                       if(a -> result -> class == OBERON_TYPE_INTEGER
-                               || b -> result -> class == OBERON_TYPE_INTEGER
-                               || a -> result -> class == OBERON_TYPE_REAL
-                               || b -> result -> class == OBERON_TYPE_REAL)
+                       if(oberon_is_numeric_type(a -> result) && oberon_is_numeric_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_char_type(a -> result) && oberon_is_char_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_string_type(a -> result) && oberon_is_string_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_boolean_type(a -> result) && oberon_is_boolean_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_set_type(a -> result) && oberon_is_set_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_pointer_type(a -> result) && oberon_is_pointer_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_procedure_type(a -> result) && oberon_is_procedure_type(b -> result))
                        {
                                // accept
                        }
                        else
                        {
-                               oberon_error(ctx, "used only with numeric types");
+                               oberon_error(ctx, "invalid comparation");
                        }
                }
-               else if(ITUSEONLYBOOLEAN(token))
+               else if(token == AND || token == OR)
                {
-                       if(a -> result -> class != OBERON_TYPE_BOOLEAN
-                               || b -> result -> class != OBERON_TYPE_BOOLEAN)
+                       if(!oberon_is_boolean_type(a -> result) || !oberon_is_boolean_type(b -> result))
                        {
-                               oberon_error(ctx, "used only with boolean type");
+                               oberon_error(ctx, "invalid comparation");
                        }
                }
+               else
+               {
+                       oberon_error(ctx, "wat");
+               }
 
                oberon_autocast_binary_op(ctx, &a, &b);
                result = ctx -> bool_type;