Реализованы VAR-параметры в генераторе

diff --git a/generator.c b/generator.c
index 24529e0e26add6f595560626773029ce65f903e6..4c3a984a6b226d5377ffb5fdcfa0ca5979ffd212 100644 (file)
--- a/generator.c
+++ b/generator.c
@@ -165,7 +165,6 @@ oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
        gcc_jit_type * gcc_type = gen_type -> gcc_type;
        const char * name = var -> name;
 
-       // TODO var param
        gcc_jit_lvalue * gcc_lvalue = NULL;
        gcc_jit_param * gcc_param = NULL;
        gcc_jit_field * gcc_field = NULL;
@@ -180,6 +179,12 @@ oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
                gcc_param = gcc_jit_context_new_param(gcc_context, NULL, gcc_type, name);
                gcc_lvalue = gcc_jit_param_as_lvalue(gcc_param);
        }
+       else if(var -> class == OBERON_CLASS_VAR_PARAM)
+       {
+               gcc_type = gcc_jit_type_get_pointer(gcc_type);
+               gcc_param = gcc_jit_context_new_param(gcc_context, NULL, gcc_type, name);
+               gcc_lvalue = gcc_jit_param_as_lvalue(gcc_param);
+       }
        else if(var -> class == OBERON_CLASS_FIELD)
        {
                gcc_field = gcc_jit_context_new_field(gcc_context, NULL, gcc_type, name);
@@ -326,6 +331,11 @@ lvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
        {
                gen_var_t * gen_var = item -> var -> gen_var;
                left = gen_var -> gcc_lvalue;
+               if(item -> var -> class == OBERON_CLASS_VAR_PARAM)
+               {
+                       gcc_jit_rvalue * r = gcc_jit_lvalue_as_rvalue(left);
+                       left = gcc_jit_rvalue_dereference(r, NULL);
+               }
        }
        else if(item -> mode == MODE_INDEX)
        {
@@ -384,10 +394,8 @@ rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
        gcc_jit_rvalue * right;
        if(item -> mode == MODE_VAR)
        {
-               assert(item -> var -> class == OBERON_CLASS_VAR
-                       || item -> var -> class == OBERON_CLASS_PARAM);
-               gen_var_t * gen_var = item -> var -> gen_var;
-               right = gcc_jit_lvalue_as_rvalue(gen_var -> gcc_lvalue);
+               gcc_jit_lvalue * left = lvalue_from_item(ctx, item);
+               right = gcc_jit_lvalue_as_rvalue(left);
        }
        else if(item -> mode == MODE_INTEGER)
        {
@@ -410,16 +418,27 @@ rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
        {
                assert(item -> var -> class == OBERON_CLASS_PROC);
 
+               oberon_type_t * signature = item -> var -> type;
                gen_proc_t * gen_proc = item -> var -> gen_proc;
 
                int num_args = item -> num_args;
                gcc_jit_rvalue *args[num_args];
 
                oberon_expr_t * expr = item -> args;
+               oberon_object_t * arg_param = signature -> decl;
                for(int i = 0; i < num_args; i++)
                {
-                       args[i] = rvalue_from_expr(ctx, expr);
+                       if(arg_param -> class == OBERON_CLASS_VAR_PARAM)
+                       {
+                               gcc_jit_lvalue * left = lvalue_from_expr(ctx, expr);
+                               args[i] = gcc_jit_lvalue_get_address(left, NULL);
+                       }
+                       else
+                       {
+                               args[i] = rvalue_from_expr(ctx, expr);
+                       }
                        expr = expr -> next;
+                       arg_param = arg_param -> next;
                }
 
                gcc_jit_function * func = gen_proc -> gcc_func;

diff --git a/notes b/notes
index c7324d2ec5175d84d4bd80e989d0f85e5daddbaa..0ef7b20ae1b632af55248eb774680568c2cc43c0 100644 (file)
--- a/notes
+++ b/notes
@@ -1,10 +1,10 @@
-- не реализованы var-параметры в генераторе
+- локальные переменные создаются как глобальные
+- сегфолт при создании локальной процедуры
 
 - нету процедуры NEW
 - не реализовано расширение типа record
 - нету открытых массивов
 
-- не реализованы локальные объявления в процедурах
 - не работает присваивание к переменным-процедурам.
 - не понятен результат присваивания статических структур (* reca := recb; *)
 - не понятен результат присваивания статических массивов (* arr1 := arr2; *)

diff --git a/oberon.c b/oberon.c
index b7ffd0ea73ab2b9cd366a04d96a2b1e16a80a94d..3837bf5b92702c744bcf7b883ff73395826063a8 100644 (file)
--- a/oberon.c
+++ b/oberon.c
@@ -739,6 +739,24 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
        oberon_object_t * param = fn -> decl;
        for(int i = 0; i < num_args; i++)
        {
+               if(param -> class == OBERON_CLASS_VAR_PARAM)
+               {
+                       if(arg -> is_item)
+                       {
+                               switch(arg -> item.mode)
+                               {
+                                       case MODE_VAR:
+                                       case MODE_INDEX:
+                                       case MODE_FIELD:
+                                       // Допустимо разыменование?
+                                       //case MODE_DEREF:
+                                               break;
+                                       default:
+                                               oberon_error(ctx, "var-parameter accept only variables");
+                                               break;
+                               }
+                       }
+               }
                oberon_autocast_to(ctx, arg, param -> type);
                arg = arg -> next;
                param = param -> next;
@@ -790,14 +808,12 @@ oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon
        oberon_type_t * base;
        base = desig -> result -> base;
 
-       // TODO check ranges
-
-       printf("oberon_make_array_selector: index class %i\n", index -> result -> class);
        if(index -> result -> class != OBERON_TYPE_INTEGER)
        {
                oberon_error(ctx, "index must be integer");
        }
 
+       // Статическая проверка границ массива
        if(index -> is_item)
        {
                if(index -> item.mode == MODE_INTEGER)
@@ -1241,6 +1257,7 @@ oberon_const_expr(oberon_context_t * ctx)
 //   PARSER
 // =======================================================================
 
+static void oberon_decl_seq(oberon_context_t * ctx);
 static void oberon_statement_seq(oberon_context_t * ctx);
 
 static void
@@ -1350,6 +1367,7 @@ oberon_formal_pars(oberon_context_t * ctx, oberon_type_t * signature)
        if(ctx -> token == COLON)
        {
                oberon_assert_token(ctx, COLON);
+               // TODO get by qualident
                oberon_type(ctx, &signature -> base);
        }
 }
@@ -1418,9 +1436,11 @@ oberon_proc_decl(oberon_context_t * ctx)
 
        oberon_assert_token(ctx, SEMICOLON);
 
-       oberon_generate_begin_proc(ctx, proc);
+       oberon_decl_seq(ctx);
+       oberon_generator_init_type(ctx, signature);
+       oberon_generator_init_proc(ctx, proc);
 
-       // TODO declarations
+       oberon_generate_begin_proc(ctx, proc);
 
        if(ctx -> token == BEGIN)
        {
@@ -1984,6 +2004,11 @@ oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 static void
 oberon_make_call(oberon_context_t * ctx, oberon_expr_t * desig)
 {
+       if(desig -> result -> class != OBERON_TYPE_VOID)
+       {
+               oberon_error(ctx, "procedure with result");
+       }
+
        oberon_autocast_call(ctx, desig);
        oberon_generate_call_proc(ctx, desig);
 }

diff --git a/test.c b/test.c
index d8f108377c2fa5299bc8460109e59289ea280c61..2c2966752c60839008da78f4ce6eec82f9154e3a 100644 (file)
--- a/test.c
+++ b/test.c
@@ -4,12 +4,18 @@
 
 static const char source[] =
        "MODULE Test;"
-       "TYPE"
-       "       Matrix = ARRAY 3, 4 OF INTEGER;"
        "VAR"
-       "       m : Matrix;"
+       "       i : INTEGER;"
+       "       j : INTEGER;"
+       ""
+       "PROCEDURE Tier(VAR x : INTEGER);"
        "BEGIN;"
-       "       m[2, 3] := 0;"
+       "       x := i;"
+       "END Tier;"
+       ""
+       "BEGIN;"
+       "       i := 666;"
+       "       Tier(j);"
        "END Test."
 ;