Реализован вызов процедуры-переменной

diff --git a/generator.c b/generator.c
index 709e5a65cbfb513cd502e2bf7d70383b89468449..244296228ae3335b5de1b12047c3d90a8c7777b3 100644 (file)
--- a/generator.c
+++ b/generator.c
@@ -363,6 +363,11 @@ lvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
 
        if(item -> mode == MODE_VAR)
        {
+               if(item -> var -> class == OBERON_CLASS_PROC)
+               {
+                       oberon_error(ctx, "casting static procedure to pointer not supported by generator");
+               }
+
                gen_var_t * gen_var = item -> var -> gen_var;
                left = gen_var -> gcc_lvalue;
                if(item -> var -> class == OBERON_CLASS_VAR_PARAM)
@@ -450,8 +455,6 @@ rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
        }
        else if(item -> mode == MODE_CALL)
        {
-               assert(item -> var -> class == OBERON_CLASS_PROC);
-
                oberon_type_t * signature = item -> var -> type;
                gen_proc_t * gen_proc = item -> var -> gen_proc;
 
@@ -475,10 +478,28 @@ rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
                        arg_param = arg_param -> next;
                }
 
-               gcc_jit_function * func = gen_proc -> gcc_func;
-               right = gcc_jit_context_new_call(
-                       gcc_context, NULL, func, num_args, args
-               );
+               gcc_jit_rvalue * fnptr;
+               gcc_jit_function * func;
+               switch(item -> var -> class)
+               {
+                       case OBERON_CLASS_PROC:
+                               func = gen_proc -> gcc_func;
+                               right = gcc_jit_context_new_call(
+                                       gcc_context, NULL, func, num_args, args
+                               );
+                               break;
+                       case OBERON_CLASS_VAR:
+                       case OBERON_CLASS_VAR_PARAM:
+                       case OBERON_CLASS_PARAM:
+                               fnptr = gcc_jit_lvalue_as_rvalue(item -> var -> gen_var -> gcc_lvalue);
+                               right = gcc_jit_context_new_call_through_ptr(
+                                       gcc_context, NULL, fnptr, num_args, args
+                               );
+                               break;
+                       default:
+                               assert(0);
+                               break;
+               }
        }
        else if(item -> mode == MODE_INDEX)
        {
@@ -622,6 +643,8 @@ oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_
                }
        }
 
+       printf("oberon_generate_assign: class %i := class %i\n", dst -> result -> class, src -> result -> class);
+
        gen_context_t * gen_context = ctx -> gen_context;
        gen_block_t * gen_block = gen_context -> block;
        gcc_jit_block * gcc_block = gen_block -> gcc_block;

diff --git a/notes b/notes
index 3c1b0db19f698c2c42cf661374a9d10e55dff6d3..c3e44ab1a381ec39ef20e8afb09b4ddb6311cb5e 100644 (file)
--- a/notes
+++ b/notes
@@ -10,12 +10,18 @@
 - не реализована свёртка констант
 - не протестированы типы разнных размеров
 
-- не реализовано расширение типа record (libgccjit не умеет в классы)
-- не работает присваивание к переменным-процедурам.
-- не реализован автокаст (libgccjit сам разруливает)
-- libgccjit не умеет в локальные функции (опять пилить костыли как в jvm)
+- не реализовано присваивание к переменным-процедурам:
+    в libgccjit нет средств получения указателя на функцию.
+    Как решение - получение указателя в основной программе.
+- не реализовано расширение типа record:
+    libgccjit не умеет в классы. Проверки в рантайме надо делать вручную.
+- не реализован автокаст:
+    Не критично: libgccjit сам разруливает типы разных размеров.
+- не реализованы локальные процедуры:
+    libgccjit не умеет в локальные функции.
+    Обойти можно костылём как в jvm.
 - не понятен результат присваивания статических/разыменованных структур (* reca := recb; *)
 - не понятен результат присваивания статических/разыменованных массивов (* arr1 := arr2; *)
 
-- нету счёта строк
+- нету счёта строк / столбцов
 - любая ошибка фатальна

diff --git a/oberon.c b/oberon.c
index 6dd84f16b6b9c3108973c087636865c661735bc3..b0bb6aa6fa3ba13a60fe7f956fc8dc820d683501 100644 (file)
--- a/oberon.c
+++ b/oberon.c
@@ -731,7 +731,7 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
                oberon_error(ctx, "expected mode CALL");
        }
 
-       if(desig -> item.var -> class != OBERON_CLASS_PROC)
+       if(desig -> item.var -> type -> class != OBERON_TYPE_PROCEDURE)
        {
                oberon_error(ctx, "only procedures can be called");
        }
@@ -780,9 +780,25 @@ oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
 static oberon_expr_t *
 oberon_make_call_func(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args)
 {
-       if(proc -> class != OBERON_CLASS_PROC)
+       switch(proc -> class)
        {
-               oberon_error(ctx, "not a procedure");
+               case OBERON_CLASS_PROC:
+                       if(proc -> class != OBERON_CLASS_PROC)
+                       {
+                               oberon_error(ctx, "not a procedure");
+                       }
+                       break;
+               case OBERON_CLASS_VAR:
+               case OBERON_CLASS_VAR_PARAM:
+               case OBERON_CLASS_PARAM:
+                       if(proc -> type -> class != OBERON_TYPE_PROCEDURE)
+                       {
+                               oberon_error(ctx, "not a procedure");
+                       }
+                       break;
+               default:
+                       oberon_error(ctx, "not a procedure");
+                       break;
        }
 
        oberon_expr_t * call;
@@ -816,9 +832,25 @@ oberon_make_call_func(oberon_context_t * ctx, oberon_object_t * proc, int num_ar
 static void
 oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args)
 {
-       if(proc -> class != OBERON_CLASS_PROC)
+       switch(proc -> class)
        {
-               oberon_error(ctx, "not a procedure");
+               case OBERON_CLASS_PROC:
+                       if(proc -> class != OBERON_CLASS_PROC)
+                       {
+                               oberon_error(ctx, "not a procedure");
+                       }
+                       break;
+               case OBERON_CLASS_VAR:
+               case OBERON_CLASS_VAR_PARAM:
+               case OBERON_CLASS_PARAM:
+                       if(proc -> type -> class != OBERON_TYPE_PROCEDURE)
+                       {
+                               oberon_error(ctx, "not a procedure");
+                       }
+                       break;
+               default:
+                       oberon_error(ctx, "not a procedure");
+                       break;
        }
 
        if(proc -> sysproc)
@@ -972,11 +1004,8 @@ oberon_designator(oberon_context_t * ctx)
                case OBERON_CLASS_VAR:
                case OBERON_CLASS_VAR_PARAM:
                case OBERON_CLASS_PARAM:
-                       expr = oberon_new_item(MODE_VAR, var -> type);
-                       break;
                case OBERON_CLASS_PROC:
-                       //expr = oberon_make_call_expr(var, 0, NULL);
-                       expr = oberon_new_item(MODE_CALL, var -> type);
+                       expr = oberon_new_item(MODE_VAR, var -> type);
                        break;
                default:
                        oberon_error(ctx, "invalid designator");
@@ -1023,6 +1052,7 @@ oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 {
        assert(expr -> is_item == 1);
 
+       /* Если есть скобки - значит вызов. Если нет, то передаём указатель. */
        if(ctx -> token == LPAREN)
        {
                oberon_assert_token(ctx, LPAREN);
@@ -1048,22 +1078,23 @@ oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
 {
        assert(expr -> is_item == 1);
 
+       int num_args = 0;
+       oberon_expr_t * arguments = NULL;
+
        if(ctx -> token == LPAREN)
        {
                oberon_assert_token(ctx, LPAREN);
 
-               int num_args = 0;
-               oberon_expr_t * arguments = NULL;
-
                if(ISEXPR(ctx -> token))
                {
                        oberon_expr_list(ctx, &num_args, &arguments, 0);
                }
 
-               oberon_make_call_proc(ctx, expr -> item.var, num_args, arguments);
-
                oberon_assert_token(ctx, RPAREN);
        }
+
+       /* Вызов происходит даже без скобок */
+       oberon_make_call_proc(ctx, expr -> item.var, num_args, arguments);
 }
 
 static oberon_expr_t *

diff --git a/test.c b/test.c
index 914764e39d2d3c25382be63f5fe5dada0b9aa4b9..d828f4a2e855adbbd24d2852738453892614f634 100644 (file)
--- a/test.c
+++ b/test.c
@@ -5,25 +5,21 @@
 static const char source[] =
        "MODULE Test;"
        "TYPE"
-       "       Rec = RECORD i : INTEGER; END;"
+       "       Callback = PROCEDURE() : INTEGER;"
+       ""
        "VAR"
+       "       cb : Callback;"
        "       i : INTEGER;"
-       "       j : INTEGER;"
-       ""
-       "PROCEDURE ^ Tier(x : INTEGER);"
-       ""
-       "PROCEDURE Tier(x : INTEGER);"
-       "VAR a : INTEGER;"
-       "BEGIN;"
-       "       a := 1;"
-       "END Tier;"
        ""
-       "PROCEDURE ^ Tier(x : INTEGER);"
+       "PROCEDURE RelBack;"
+       "BEGIN"
+       "       i := 666;"
+       "END RelBack;"
        ""
        "BEGIN;"
-       "       i := ABS(-666);"
-       "       Tier(i);"
-       "       ABS(1);"
+       "       i := 1;"
+       "       i := cb();"
+       "       RelBack;"
        "END Test."
 ;