Добавлен NIL и автоматическое разыменование указателей

diff --git a/generator.c b/generator.c
index 673ac3381818c09270f17e002b26b8d1b29ad24c..24529e0e26add6f595560626773029ce65f903e6 100644 (file)
--- a/generator.c
+++ b/generator.c
@@ -336,12 +336,18 @@ lvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
        }
        else if(item -> mode == MODE_FIELD)
        {
+               printf("lvalue_from_item: %s\n", item -> var -> name);
                gen_var_t * gen_var = item -> var -> gen_var;
                gcc_jit_field * gcc_field = gen_var -> gcc_field;
 
                gcc_jit_lvalue * parent = lvalue_from_item(ctx, item -> parent);
                left = gcc_jit_lvalue_access_field(parent, NULL, gcc_field);
        }
+       else if(item -> mode == MODE_DEREF)
+       {
+               gcc_jit_rvalue * parent = rvalue_from_item(ctx, item -> parent);
+               left = gcc_jit_rvalue_dereference(parent, NULL);
+       }
        else
        {
                oberon_error(ctx, "invalid lvalue expression");
@@ -434,6 +440,16 @@ rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
                gcc_jit_rvalue * parent = rvalue_from_item(ctx, item -> parent);
                right = gcc_jit_rvalue_access_field(parent, NULL, gcc_field);
        }
+       else if(item -> mode == MODE_DEREF)
+       {
+               gcc_jit_lvalue * left = lvalue_from_item(ctx, item);
+               right = gcc_jit_lvalue_as_rvalue(left);
+       }
+       else if(item -> mode == MODE_NIL)
+       {
+               gcc_jit_type * type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_VOID_PTR);
+               right = gcc_jit_context_null(gcc_context, type);
+       }
        else
        {
                oberon_error(ctx, "rvalue_from_item: invalid mode %i", item -> mode);
@@ -536,6 +552,18 @@ oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_
        gcc_jit_rvalue * right;
        right = rvalue_from_expr(ctx, src);
 
+       if(src -> is_item)
+       {
+               if(src -> item.mode == MODE_NIL)
+               {
+                       gen_context_t * gen_context = ctx -> gen_context;
+                       gcc_jit_context * gcc_context = gen_context -> gcc_context;
+                       gen_type_t * gen_type = dst -> result -> gen_type;
+                       gcc_jit_type * cast_to_type = gen_type -> gcc_type;
+                       right = gcc_jit_context_new_cast(gcc_context, NULL, right, cast_to_type);
+               }
+       }
+
        gen_context_t * gen_context = ctx -> gen_context;
        gcc_jit_block * gcc_block = gen_context -> gcc_block;
        gcc_jit_block_add_assignment(gcc_block, NULL, left, right);

diff --git a/notes b/notes
index 3e23e6b973ffde1b6c92741b58b5938ea9949e5a..0dd194e9e6e6057ced4ec2518616dd9f63622934 100644 (file)
--- a/notes
+++ b/notes
@@ -1,15 +1,16 @@
+- хреновая проверка типов-указателей
 - нету процедуры NEW
 - не реализовано расширение типа record
-- не реализованы многомерные массивы
+- не реализована краткая форма многомерных массивов и краткой формы доступа к ним (* [1, 2, 3] - компилится, но вычисляется только первый аргумент *)
 
 - не реализованы локальные объявления в процедурах
 - не работает присваивание к переменным-процедурам.
 - не понятен результат присваивания статических структур (* reca := recb; *)
+- не понятен результат присваивания статических массивов (* arr1 := arr2; *)
 - не реализованы var-параметры в генераторе
 - не реализованы процедуры "наперёд"
 
+- нету типа set
 - не реализована свёртка констант
 - не реализован автокаст (libgccjit сам разруливает)
 - не протестированы типы разнных размеров
-
-- похоже record инициализируется дважды в некоторых случаях

diff --git a/oberon.c b/oberon.c
index f4a711f5da3156912e43afb4bc8887dd076936a3..dfed94a274ad3991d56ab8adf5223fabac446e38 100644 (file)
--- a/oberon.c
+++ b/oberon.c
@@ -50,7 +50,9 @@ enum {
        RBRACE,
        RECORD,
        POINTER,
-       TO
+       TO,
+       UPARROW,
+       NIL
 };
 
 // =======================================================================
@@ -395,6 +397,10 @@ oberon_read_ident(oberon_context_t * ctx)
        {
                ctx -> token = TO;
        }
+       else if(strcmp(ident, "NIL") == 0)
+       {
+               ctx -> token = NIL;
+       }
 }
 
 static void
@@ -527,6 +533,10 @@ oberon_read_symbol(oberon_context_t * ctx)
                        ctx -> token = RBRACE;
                        oberon_get_char(ctx);
                        break;
+               case '^':
+                       ctx -> token = UPARROW;
+                       oberon_get_char(ctx);
+                       break;
                default:
                        oberon_error(ctx, "invalid char");
                        break;
@@ -726,45 +736,42 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
        || ((x) == TRUE) \
        || ((x) == FALSE))
 
-#define ISSELECTOR(x) \
-       (((x) == LBRACE) \
-       || ((x) == DOT))
-
 static oberon_expr_t *
-oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int num_indexes, oberon_expr_t * indexes)
+oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
 {
-       assert(desig -> is_item == 1);
-
-       if(desig -> item.mode != MODE_VAR)
+       if(expr -> result -> class != OBERON_TYPE_POINTER)
        {
-               oberon_error(ctx, "not MODE_VAR");
+               oberon_error(ctx, "not a pointer");
        }
 
-       int class = desig -> item.var -> class;
-       switch(class)
+       assert(expr -> is_item);
+
+       oberon_expr_t * selector;
+       selector = oberon_new_item(MODE_DEREF, expr -> result -> base);
+       selector -> item.parent = (oberon_item_t *) expr;
+
+       return selector;
+}
+
+static oberon_expr_t *
+oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int num_indexes, oberon_expr_t * indexes)
+{
+       if(desig -> result -> class == OBERON_TYPE_POINTER)
        {
-               case OBERON_CLASS_VAR:
-               case OBERON_CLASS_VAR_PARAM:
-               case OBERON_CLASS_PARAM:
-                       break;
-               default:
-                       oberon_error(ctx, "not variable");
-                       break;
+               desig = oberno_make_dereferencing(ctx, desig);
        }
 
-       oberon_type_t * type = desig -> item.var -> type;
-       if(type -> class != OBERON_TYPE_ARRAY)
+       assert(desig -> is_item);
+
+       if(desig -> result -> class != OBERON_TYPE_ARRAY)
        {
                oberon_error(ctx, "not array");
        }
 
-//     int dim = desig -> item.var -> type -> dim;
-//     if(num_indexes != dim)
-//     {
-//             oberon_error(ctx, "dimesions not matched");
-//     }
+       oberon_type_t * base;
+       base = desig -> result -> base;
 
-       oberon_type_t * base = desig -> item.var -> type -> base;
+       // TODO check ranges
 
        oberon_expr_t * selector;
        selector = oberon_new_item(MODE_INDEX, base);
@@ -778,10 +785,14 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, int nu
 static oberon_expr_t *
 oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * name)
 {
+       if(expr -> result -> class == OBERON_TYPE_POINTER)
+       {
+               expr = oberno_make_dereferencing(ctx, expr);
+       }
+
        assert(expr -> is_item == 1);
 
-       int class = expr -> result -> class;
-       if(class != OBERON_TYPE_RECORD)
+       if(expr -> result -> class != OBERON_TYPE_RECORD)
        {
                oberon_error(ctx, "not record");
        }
@@ -799,6 +810,11 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
        return selector;
 }
 
+#define ISSELECTOR(x) \
+       (((x) == LBRACE) \
+       || ((x) == DOT) \
+       || ((x) == UPARROW))
+
 static oberon_expr_t *
 oberon_designator(oberon_context_t * ctx)
 {
@@ -846,6 +862,10 @@ oberon_designator(oberon_context_t * ctx)
                                oberon_assert_token(ctx, RBRACE);
                                expr = oberon_make_array_selector(ctx, expr, num_indexes, indexes);
                                break;
+                       case UPARROW:
+                               oberon_assert_token(ctx, UPARROW);
+                               expr = oberno_make_dereferencing(ctx, expr);
+                               break;
                        default:
                                oberon_error(ctx, "oberon_designator: wat");
                                break;
@@ -924,6 +944,10 @@ oberon_factor(oberon_context_t * ctx)
                        expr = oberon_factor(ctx);
                        expr = oberon_make_unary_op(ctx, NOT, expr);
                        break;
+               case NIL:
+                       oberon_assert_token(ctx, NIL);
+                       expr = oberon_new_item(MODE_NIL, ctx -> void_ptr_type);
+                       break;
                default:
                        oberon_error(ctx, "invalid expression");
        }
@@ -1773,16 +1797,8 @@ oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type)
 
        if(type -> class == OBERON_TYPE_POINTER)
        {
-               if(type -> base -> class == OBERON_TYPE_RECORD)
-               {
-                       oberon_generator_init_type(ctx, type -> base);
-                       oberon_generator_init_type(ctx, type);
-               }
-               else
-               {
-                       oberon_initialize_type(ctx, type -> base);
-                       oberon_generator_init_type(ctx, type);
-               }
+               oberon_initialize_type(ctx, type -> base);
+               oberon_generator_init_type(ctx, type);
        }
        else if(type -> class == OBERON_TYPE_ARRAY)
        {
@@ -1995,6 +2011,10 @@ register_default_types(oberon_context_t * ctx)
        ctx -> void_type = oberon_new_type_ptr(OBERON_TYPE_VOID);
        oberon_generator_init_type(ctx, ctx -> void_type);
 
+       ctx -> void_ptr_type = oberon_new_type_ptr(OBERON_TYPE_POINTER);
+       ctx -> void_ptr_type -> base = ctx -> void_type;
+       oberon_generator_init_type(ctx, ctx -> void_ptr_type);
+
        ctx -> int_type = oberon_new_type_integer(sizeof(int));
        oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type);
 

diff --git a/oberon.h b/oberon.h
index 93f80a8e78dc3fc2ccb5ea306ed26ce54a7c74f6..02547cd70be76f7ffdaeb60097fa5fe89cc5dd87 100644 (file)
--- a/oberon.h
+++ b/oberon.h
@@ -204,6 +204,7 @@ struct oberon_context_s
        oberon_type_t * int_type;
        oberon_type_t * bool_type;
        oberon_type_t * void_type;
+       oberon_type_t * void_ptr_type;
        oberon_scope_t * world_scope;
 
        gen_context_t * gen_context;
@@ -216,7 +217,9 @@ enum
        MODE_BOOLEAN,
        MODE_CALL,
        MODE_INDEX,
-       MODE_FIELD
+       MODE_FIELD,
+       MODE_DEREF,
+       MODE_NIL
 };
 
 enum

diff --git a/test.c b/test.c
index 432307f51ba6e983b25400f43e593e2e8e555fdf..b934af876ca2bde9d44397015f95c7ce70953bd5 100644 (file)
--- a/test.c
+++ b/test.c
@@ -5,28 +5,15 @@
 static const char source[] =
        "MODULE Test;"
        "TYPE"
-       "       Int = INTEGER;"
-       "       PArray2D = POINTER TO Array2D;"
-       "       Array2D = ARRAY 3 OF ARRAY 3 OF INTEGER;"
-       "       PAP2D = ARRAY 4 OF POINTER TO ARRAY 5 OF INTEGER;"
-       "       Object = POINTER TO ObjectDesc;"
-       "       ObjectDesc = RECORD"
-       "               value : Array2D;"
-       "               value2 : PArray2D;"
-       "               doStuff : Proc;"
-       "               next : Object;"
+       "       MyRec = POINTER TO MyRecDesc;"
+       "       MyRecDesc = RECORD"
+       "               a : INTEGER;"
        "       END;"
-       "       Proc = PROCEDURE(self : Object; i : Int);"
        "VAR"
-       "       i : Int;"
-       "       a2 : Array2D;"
-       "       p2 : PArray2D;"
-       "       po : Object;"
-       "       do : ObjectDesc;"
-       "       stuffProc : Proc;"
-       "       pap2 : PAP2D;"
-       "       "
+       "       r : MyRec;"
        "BEGIN;"
+       "       r := NIL;"
+       "       r.a := 1;"
        "END Test."
 ;
 

diff --git a/test/Test b/test/Test
index 2c0d9836ae6b2a1da66ff6035c51c769e557a57c..09dbea89f6a56f7f03fd224992382247908ac664 100755 (executable)
Binary files a/test/Test and b/test/Test differ

diff --git a/test/Test.Mod b/test/Test.Mod
index 5454854a7ecfcc81ec3c6b7e53a5d4de297173f3..41e1faeb099b8b10a52e4abd8a4822de32c9c08e 100644 (file)
--- a/test/Test.Mod
+++ b/test/Test.Mod
@@ -1,6 +1,20 @@
 MODULE Test;
 
+IMPORT Out;
+
 TYPE
-       MyArr = POINTER TO ARRAY OF MyArr;
+       MyArr = ARRAY 3 OF POINTER TO ARRAY 6 OF INTEGER;
+
+VAR
+       a : MyArr;
+
+BEGIN
+       Out.Open;
+
+       NEW(a[0]);
+       a[0][0] := 1;
+       Out.Int(a[0][0], 0);
 
+       Out.Ln;
+       Out.Flush;
 END Test.

diff --git a/test/Test.c b/test/Test.c
index c1cde1214ebe48b9550515f502d30fb6f1aff2ab..22b0e5bd3ff0cbc2179f75cfe1da48159b9fb4b6 100644 (file)
--- a/test/Test.c
+++ b/test/Test.c
@@ -1,4 +1,4 @@
-/* voc 2.1.0 [2017/06/08] for gcc LP64 on arch xtpam */
+/* voc 2.1.0 [2017/07/17] for gcc LP64 on arch xtpam */
 
 #define SHORTINT INT8
 #define INTEGER  INT16
@@ -6,27 +6,34 @@
 #define SET      UINT32
 
 #include "SYSTEM.h"
-
-struct Test__1 {
-       char _prvt0[1];
-};
+#include "Out.h"
 
 typedef
-       struct Test__1 *Test_MyRecDesc;
+       INT16 (*Test_MyArr[3])[6];
+
 
+static Test_MyArr Test_a;
 
 
-export ADDRESS *Test__1__typ;
 
 
+static void EnumPtrs(void (*P)(void*))
+{
+       __ENUMP(Test_a, 3, P);
+}
 
-__TDESC(Test__1, 1, 0) = {__TDFLDS("", 1), {-8}};
 
 export int main(int argc, char **argv)
 {
        __INIT(argc, argv);
-       __REGMAIN("Test", 0);
-       __INITYP(Test__1, Test__1, 0);
+       __MODULE_IMPORT(Out);
+       __REGMAIN("Test", EnumPtrs);
 /* BEGIN */
+       Out_Open();
+       Test_a[0] = __NEWARR(NIL, 2, 2, 1, 0, ((INT64)(6)));
+       (*Test_a[0])[0] = 1;
+       Out_Int((*Test_a[0])[0], 0);
+       Out_Ln();
+       Out_Flush();
        __FINI;
 }