Добавлено получение указателей на сгенерированные процедуры и переменные

[dsw-obn.git] / oberon.c

diff --git a/oberon.c b/oberon.c
index 6dd84f16b6b9c3108973c087636865c661735bc3..28a351a6fdbfd4e315d4b2959b40a3b440a85f1e 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 *
@@ -2303,27 +2334,16 @@ register_default_types(oberon_context_t * ctx)
 }
 
 static void
-oberon_new_intrinsic_function(oberon_context_t * ctx, char * name, GenerateFuncCallback generate)
+oberon_new_intrinsic(oberon_context_t * ctx, char * name, GenerateFuncCallback f, GenerateProcCallback p)
 {
        oberon_object_t * proc;
        proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC);
        proc -> sysproc = 1;
-       proc -> genfunc = generate;
+       proc -> genfunc = f;
+       proc -> genproc = p;
        proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
 }
 
-/*
-static void
-oberon_new_intrinsic_procedure(oberon_context_t * ctx, char * name, GenerateProcCallback generate)
-{
-       oberon_object_t * proc;
-       proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC);
-       proc -> sysproc = 1;
-       proc -> genproc = generate;
-       proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
-}
-*/
-
 static oberon_expr_t *
 oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
 {
@@ -2367,7 +2387,7 @@ oberon_create_context()
        oberon_generator_init_context(ctx);
 
        register_default_types(ctx);
-       oberon_new_intrinsic_function(ctx, "ABS", oberon_make_abs_call);
+       oberon_new_intrinsic(ctx, "ABS", oberon_make_abs_call, NULL);
 
        return ctx;
 }