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

diff --git a/generator.c b/generator.c
index 21506b0626fe5db7cfbd117a444d2295de3448a2..07e7bc470ee1b1fb9a337810e695fce530bf16d3 100644 (file)
--- a/generator.c
+++ b/generator.c
@@ -11,9 +11,9 @@
 #include <libgccjit.h>
 
 /*
- * oberon_var_t -> gvar == gcc_jit_lvalue;
- * oberon_type_t -> gtype == gcc_jit_type;
- * oberon_context_t -> gctx == gen_context_t;
+ * oberon_object_t -> gen_var == gcc_jit_lvalue;
+ * oberon_type_t -> gen_type == gcc_jit_type;
+ * oberon_context_t -> gen_context == gen_context_t;
  */ 
 
 typedef struct
@@ -94,9 +94,10 @@ oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type)
 }
 
 void
-oberon_generator_init_var(oberon_context_t * ctx, oberon_var_t * var)
+oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
 {
        printcontext(ctx, "oberon_generator_init_var");
+       assert(var -> class == OBERON_CLASS_VAR);
 
        gen_context_t * gen_context = ctx -> gen_context;
        gcc_jit_context * gcc_context = gen_context -> gcc_context;
@@ -109,10 +110,33 @@ oberon_generator_init_var(oberon_context_t * ctx, oberon_var_t * var)
        var -> gen_var = gen_var;
 }
 
+void
+oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc)
+{
+       assert(proc -> class == OBERON_CLASS_PROC);
+
+       gen_context_t * gen_context = ctx -> gen_context;
+       gcc_jit_context * gcc_context = gen_context -> gcc_context;
+       //gcc_jit_type * gen_type = proc -> type -> gen_type;
+       const char * name = proc -> name;
+
+       gcc_jit_function * gen_proc;
+
+       // TODO make real signature
+       gcc_jit_type * void_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_VOID);
+       gen_proc = gcc_jit_context_new_function(
+               gcc_context, NULL, GCC_JIT_FUNCTION_EXPORTED, void_type, name, 0, NULL, 0
+       );
+
+       proc -> gen_proc = gen_proc;
+}
+
 // =======================================================================
 //   GENERATOR
 // ======================================================================= 
 
+static gcc_jit_rvalue * rvalue_from_expr(oberon_context_t * ctx, oberon_expr_t * expr);
+
 void
 oberon_generate_begin_module(oberon_context_t * ctx)
 {
@@ -143,6 +167,40 @@ oberon_generate_end_module(oberon_context_t * ctx)
        gen_context -> gcc_block = NULL;
 }
 
+void
+oberon_generate_begin_proc(oberon_context_t * ctx, oberon_object_t * proc)
+{
+       gen_context_t * gen_context = ctx -> gen_context;
+
+       gcc_jit_function * func = proc -> gen_proc;
+       gcc_jit_block * gcc_block = gcc_jit_function_new_block(func, NULL);
+
+       // TODO make stack for block
+       gen_context -> gcc_block = gcc_block;
+}
+
+void
+oberon_generate_call_proc(oberon_context_t * ctx, oberon_expr_t * desig)
+{
+       gen_context_t * gen_context = ctx -> gen_context;
+       gcc_jit_block * block = gen_context -> gcc_block;
+
+       gcc_jit_rvalue * return_value;
+       return_value = rvalue_from_expr(ctx, desig);
+       gcc_jit_block_add_eval(block, NULL, return_value);
+}
+
+void
+oberon_generate_end_proc(oberon_context_t * ctx)
+{
+       gen_context_t * gen_context = ctx -> gen_context;
+       gcc_jit_block * gcc_block = gen_context -> gcc_block;
+
+       gcc_jit_block_end_with_void_return(gcc_block, NULL);
+
+       gen_context -> gcc_block = NULL;
+}
+
 static gcc_jit_lvalue *
 lvalue_from_expr(oberon_context_t *ctx, oberon_expr_t * expr)
 {
@@ -166,8 +224,6 @@ lvalue_from_expr(oberon_context_t *ctx, oberon_expr_t * expr)
        return left;
 }
 
-static gcc_jit_rvalue * rvalue_from_expr(oberon_context_t * ctx, oberon_expr_t * expr);
-
 static gcc_jit_rvalue *
 rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
 {
@@ -177,6 +233,7 @@ 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);
                gcc_jit_lvalue * gen_var = item -> var -> gen_var;
                right = gcc_jit_lvalue_as_rvalue(gen_var);
        }
@@ -197,6 +254,15 @@ rvalue_from_item(oberon_context_t * ctx, oberon_item_t * item)
                        right = gcc_jit_context_zero(gcc_context, bool_type);                   
                }
        }
+       else if(item -> mode == MODE_CALL)
+       {
+               assert(item -> var -> class == OBERON_CLASS_PROC);
+               /* TODO args */
+               gcc_jit_function * func = item -> var -> gen_proc;
+               right = gcc_jit_context_new_call(
+                       gcc_context, NULL, func, 0, NULL
+               );
+       }
        else
        {
                oberon_error(ctx, "oberon_generate_push: invalid mode %i", item -> mode);

diff --git a/generator.h b/generator.h
index 78ae8601771442915dcdaa1f8f416b58d016d3c1..6b97e0d53fe74962bb42c0f7189fd0526d417ce5 100644 (file)
--- a/generator.h
+++ b/generator.h
@@ -1,11 +1,36 @@
+/*
+ * Функции инициализации контекста и объектов
+ */
+
 void oberon_generator_init_context(oberon_context_t * ctx);
-void oberon_generator_destroy_context(oberon_context_t * ctx);
 void oberon_generator_init_type(oberon_context_t * ctx, oberon_type_t * type);
-void oberon_generator_init_var(oberon_context_t * ctx, oberon_var_t * var);
+void oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var);
+void oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc);
+void oberon_generator_destroy_context(oberon_context_t * ctx);
+
+/*
+ * Функции генерации тела модуля
+ */
 
 void oberon_generate_begin_module(oberon_context_t * ctx);
 void oberon_generate_end_module(oberon_context_t * ctx);
 
+/*
+ * Функции генерации и вызова процедур
+ */
+
+void oberon_generate_begin_proc(oberon_context_t * ctx, oberon_object_t * proc);
+void oberon_generate_end_proc(oberon_context_t * ctx);
+void oberon_generate_call_proc(oberon_context_t * ctx, oberon_expr_t * desig);
+
+/*
+ * Функции генерации операторов
+ */
+
 void oberon_generate_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst);
 
+/*
+ * Функции генерации кода
+ */
+
 void oberon_generate_code(oberon_context_t * ctx);

diff --git a/oberon.c b/oberon.c
index 440364361e45956f86091d3022fd50b3099f1026..0aa8d45bf1304f6a95fe211480359d30afa7c9ef 100644 (file)
--- a/oberon.c
+++ b/oberon.c
@@ -64,51 +64,137 @@ oberon_error(oberon_context_t * ctx, const char * fmt, ...)
 //   TABLE
 // ======================================================================= 
 
-static oberon_type_t *
-oberon_find_type(oberon_context_t * ctx, char * name)
+static oberon_scope_t *
+oberon_open_scope(oberon_context_t * ctx)
 {
-       oberon_type_t * x = ctx -> types;
+       oberon_scope_t * scope = malloc(sizeof *scope);
+       memset(scope, 0, sizeof *scope);
+
+       oberon_object_t * list = malloc(sizeof *list);
+       memset(list, 0, sizeof *list);
+
+       scope -> ctx = ctx;
+       scope -> list = list;
+       scope -> up = ctx -> decl;
+
+       ctx -> decl = scope;
+       return scope;
+}
+
+static void
+oberon_close_scope(oberon_scope_t * scope)
+{
+       oberon_context_t * ctx = scope -> ctx;
+       ctx -> decl = scope -> up;
+}
+
+static oberon_object_t *
+oberon_define_object(oberon_scope_t * scope, char * name, int class)
+{
+       oberon_object_t * x = scope -> list;
        while(x -> next && strcmp(x -> next -> name, name) != 0)
        {
                x = x -> next;
        }
 
-       return x -> next;
+       if(x -> next)
+       {
+               oberon_error(scope -> ctx, "already defined");
+       }
+
+       oberon_object_t * newvar = malloc(sizeof *newvar);
+       memset(newvar, 0, sizeof *newvar);
+       newvar -> name = name;
+       newvar -> class = class;
+
+       x -> next = newvar;
+
+       return newvar;
 }
 
-static oberon_var_t *
-oberon_find_var(oberon_context_t * ctx, char * name)
+static oberon_object_t *
+oberon_find_object_in_list(oberon_object_t * list, char * name)
 {
-       oberon_var_t * x = ctx -> mod -> vars;
+       oberon_object_t * x = list;
        while(x -> next && strcmp(x -> next -> name, name) != 0)
        {
                x = x -> next;
        }
-
        return x -> next;
 }
 
+static oberon_object_t *
+oberon_find_object(oberon_scope_t * scope, char * name)
+{
+       oberon_object_t * result = NULL;
+
+       oberon_scope_t * s = scope;
+       while(result == NULL && s != NULL)
+       {
+               result = oberon_find_object_in_list(s -> list, name);
+               s = s -> up;
+       }
+
+       if(result == NULL)
+       {
+               oberon_error(scope -> ctx, "undefined ident %s", name);
+       }
+
+       return result;
+}
+
 static void
-oberon_define_var(oberon_context_t * ctx, char * name, oberon_type_t * type)
+oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type)
 {
-       oberon_var_t * x = ctx -> mod -> vars;
-       while(x -> next && strcmp(x -> next -> name, name) != 0)
+       oberon_object_t * id;
+       id = oberon_define_object(scope, name, OBERON_CLASS_TYPE);
+       id -> type = type;
+       oberon_generator_init_type(scope -> ctx, type);
+}
+
+static oberon_type_t *
+oberon_find_type(oberon_scope_t * scope, char * name)
+{
+       oberon_object_t * x = oberon_find_object(scope, name);
+       if(x -> class != OBERON_CLASS_TYPE)
        {
-               x = x -> next;
+               oberon_error(scope -> ctx, "%s not a type", name);
        }
 
-       if(x -> next)
+       return x -> type;
+}
+
+static void
+oberon_define_var(oberon_scope_t * scope, char * name, oberon_type_t * type)
+{
+       oberon_object_t * var;
+       var = oberon_define_object(scope, name, OBERON_CLASS_VAR);
+       var -> type = type;
+       oberon_generator_init_var(scope -> ctx, var);
+}
+
+/*
+static oberon_object_t *
+oberon_find_var(oberon_scope_t * scope, char * name)
+{
+       oberon_object_t * x = oberon_find_object(scope, name);
+
+       if(x -> class != OBERON_CLASS_VAR)
        {
-               oberon_error(ctx, "already defined");
+               oberon_error(scope -> ctx, "%s not a var", name);
        }
 
-       oberon_var_t * newvar = malloc(sizeof *newvar);
-       memset(newvar, 0, sizeof *newvar);
-       newvar -> name = name;
-       newvar -> type = type;
-       oberon_generator_init_var(ctx, newvar);
+       return x;
+}
+*/
 
-       x -> next = newvar;
+static oberon_object_t *
+oberon_define_proc(oberon_scope_t * scope, char * name)
+{
+       oberon_object_t * proc;
+       proc = oberon_define_object(scope, name, OBERON_CLASS_PROC);
+       oberon_generator_init_proc(scope -> ctx, proc);
+       return proc;
 }
 
 // =======================================================================
@@ -416,19 +502,26 @@ static oberon_expr_t *
 oberon_factor(oberon_context_t * ctx)
 {
        char * name;
-       oberon_var_t * var;
+       oberon_object_t * var;
        oberon_expr_t * expr;
 
        switch(ctx -> token)
        {
                case IDENT:
                        name = oberon_assert_ident(ctx);
-                       var = oberon_find_var(ctx, name);
-                       if(var == NULL)
+                       var = oberon_find_object(ctx -> decl, name);
+                       if(var -> class == OBERON_CLASS_VAR)
+                       {
+                               expr = oberon_new_item(MODE_VAR, var -> type);
+                       }
+                       else if(var -> class == OBERON_CLASS_PROC)
                        {
-                               oberon_error(ctx, "undefined variable %s", name);
+                               expr = oberon_new_item(MODE_CALL, var -> type);
+                       }
+                       else
+                       {
+                               oberon_error(ctx, "invalid desinator");
                        }
-                       expr = oberon_new_item(MODE_VAR, var -> type);
                        expr -> item.var = var;
                        break;
                case INTEGER:
@@ -721,13 +814,7 @@ static oberon_type_t *
 oberon_type(oberon_context_t * ctx)
 {
        char * name = oberon_assert_ident(ctx);
-       oberon_type_t * type = oberon_find_type(ctx, name);
-
-       if(type == NULL)
-       {
-               oberon_error(ctx, "undefined type");
-       }
-
+       oberon_type_t * type = oberon_find_type(ctx -> decl, name);
        return type;
 }
 
@@ -737,19 +824,26 @@ oberon_var_decl(oberon_context_t * ctx)
        char * name = oberon_assert_ident(ctx);
        oberon_assert_token(ctx, COLON);
        oberon_type_t * type = oberon_type(ctx);
-       oberon_define_var(ctx, name, type);
+       oberon_define_var(ctx -> decl, name, type);
 }
 
 static void
 oberon_make_procedure_begin(oberon_context_t * ctx, char * name)
 {
-       
+       oberon_object_t * proc;
+       proc = oberon_define_proc(ctx -> decl, name);
+
+       oberon_open_scope(ctx);
+
+       oberon_generate_begin_proc(ctx, proc);
 }
 
 static void
 oberon_make_procedure_end(oberon_context_t * ctx)
 {
+       oberon_generate_end_proc(ctx);
 
+       oberon_close_scope(ctx -> decl);
 }
 
 static void
@@ -818,6 +912,29 @@ oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
        oberon_generate_assign(ctx, src, dst);
 }
 
+static void
+oberon_make_call(oberon_context_t * ctx, oberon_expr_t * desig)
+{
+       if(desig -> is_item == 0)
+       {
+               oberon_error(ctx, "expected item");
+       }
+
+       if(desig -> item.mode != MODE_CALL)
+       {
+               oberon_error(ctx, "expected mode CALL");
+       }
+
+       if(desig -> item.var -> class != OBERON_CLASS_PROC)
+       {
+               oberon_error(ctx, "only procedures can be called");
+       }
+
+       // TODO check arguments
+
+       oberon_generate_call_proc(ctx, desig);
+}
+
 static void
 oberon_statement(oberon_context_t * ctx)
 {
@@ -827,9 +944,16 @@ oberon_statement(oberon_context_t * ctx)
        if(ctx -> token == IDENT)
        {
                item1 = oberon_expr(ctx);
-               oberon_assert_token(ctx, ASSIGN);
-               item2 = oberon_expr(ctx);
-               oberon_assign(ctx, item2, item1);
+               if(ctx -> token == ASSIGN)
+               {
+                       oberon_assert_token(ctx, ASSIGN);
+                       item2 = oberon_expr(ctx);
+                       oberon_assign(ctx, item2, item1);
+               }
+               else
+               {
+                       oberon_make_call(ctx, item1);
+               }
        }
 }
 
@@ -880,43 +1004,40 @@ oberon_parse_module(oberon_context_t * ctx)
 // =======================================================================
 
 static oberon_type_t *
-oberon_register_global_type_ret(oberon_context_t * ctx, oberon_type_t * type)
+oberon_new_type_ptr(int class)
 {
-       oberon_type_t * x = ctx -> types;
-       while(x -> next && strcmp(x -> next -> name, type -> name) != 0)
-       {
-               x = x -> next;
-       }
-
-       if(x -> next)
-       {
-               oberon_error(ctx, "already defined");
-       }
+       oberon_type_t * x = malloc(sizeof *x);
+       memset(x, 0, sizeof *x);
+       x -> class = class;
+       return x;
+}
 
-       // TODO: copy type name (not a pointer)
-       oberon_type_t * newtype = malloc(sizeof *newtype);
-       memcpy(newtype, type, sizeof *newtype);
-       newtype -> next = NULL;
-       oberon_generator_init_type(ctx, newtype);
+static oberon_type_t *
+oberon_new_type_integer(int size)
+{
+       oberon_type_t * x;
+       x = oberon_new_type_ptr(OBERON_TYPE_INTEGER);
+       x -> size = size;
+       return x;
+}
 
-       x -> next = newtype;
-       return newtype; 
+static oberon_type_t *
+oberon_new_type_boolean(int size)
+{
+       oberon_type_t * x;
+       x = oberon_new_type_ptr(OBERON_TYPE_BOOLEAN);
+       x -> size = size;
+       return x;
 }
 
 static void
 register_default_types(oberon_context_t * ctx)
 {
-       static oberon_type_t integer = { "INTEGER", OBERON_TYPE_INTEGER, sizeof(int) };
-       static oberon_type_t boolean = { "BOOLEAN", OBERON_TYPE_BOOLEAN, sizeof(int) };
-
-       ctx -> int_type = oberon_register_global_type_ret(ctx, &integer);
-       ctx -> bool_type = oberon_register_global_type_ret(ctx, &boolean);
-}
+       ctx -> int_type = oberon_new_type_integer(sizeof(int));
+       ctx -> bool_type = oberon_new_type_boolean(sizeof(int));
 
-void
-oberon_register_global_type(oberon_context_t * ctx, oberon_type_t * type)
-{
-       oberon_register_global_type_ret(ctx, type);
+       oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type);
+       oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type);
 }
 
 oberon_context_t *
@@ -925,9 +1046,9 @@ oberon_create_context()
        oberon_context_t * ctx = malloc(sizeof *ctx);
        memset(ctx, 0, sizeof *ctx);
 
-       oberon_type_t * types = malloc(sizeof *types);
-       memset(types, 0, sizeof *types);
-       ctx -> types = types;
+       oberon_scope_t * world_scope;
+       world_scope = oberon_open_scope(ctx);
+       ctx -> world_scope = world_scope;
 
        oberon_generator_init_context(ctx);
 
@@ -948,15 +1069,17 @@ oberon_compile_module(oberon_context_t * ctx, const char * code)
 {
        oberon_module_t * mod = malloc(sizeof *mod);
        memset(mod, 0, sizeof *mod);
-       oberon_var_t * vars = malloc(sizeof *vars);
-       memset(vars, 0, sizeof *vars);
        ctx -> mod = mod;
-       ctx -> mod -> vars = vars;
+
+       oberon_scope_t * module_scope;
+       module_scope = oberon_open_scope(ctx);
+       mod -> decl = module_scope;
 
        oberon_init_scaner(ctx, code);
        oberon_parse_module(ctx);
 
        oberon_generate_code(ctx);
+
+       ctx -> mod = NULL;
        return mod;
 }
-

diff --git a/oberon.h b/oberon.h
index b2f0965f3c6acadd009dd22e99d4e5a1df8bc270..f29aa4d4a780b18af1a526bcbc9556580f3d94ff 100644 (file)
--- a/oberon.h
+++ b/oberon.h
@@ -1,51 +1,58 @@
 #ifndef EMBEDED_OBERON_SCRIPT_H
 #define EMBEDED_OBERON_SCRIPT_H
 
-typedef struct oberon_var_s oberon_var_t;
 typedef struct oberon_type_s oberon_type_t;
-typedef struct oberon_proc_s oberon_proc_t;
+typedef struct oberon_object_s oberon_object_t;
 typedef struct oberon_module_s oberon_module_t;
 typedef struct oberon_context_s oberon_context_t;
+typedef struct oberon_scope_s oberon_scope_t;
 
-enum {
+struct oberon_scope_s
+{
+       oberon_context_t * ctx;
+       oberon_object_t * list;
+       oberon_scope_t * up;
+};
+
+enum
+{
        OBERON_TYPE_INTEGER,
        OBERON_TYPE_BOOLEAN,
 };
 
 struct oberon_type_s
 {
-       char * name;
        int class;
        int size;
-       oberon_type_t * next;
 
        void * gen_type;
 };
 
-struct oberon_var_s
+enum
 {
-        char * name;
-        oberon_type_t * type;
-        oberon_var_t * next;
-
-       void * gen_var;
+       OBERON_CLASS_VAR,
+       OBERON_CLASS_TYPE,
+       OBERON_CLASS_PROC
 };
 
-struct oberon_proc_s
+struct oberon_object_s
 {
        char * name;
+       int class;
 
-       oberon_proc_t * next;
+       oberon_type_t * type;
 
+       void * gen_var;
        void * gen_proc;
+
+       oberon_object_t * next;
 };
 
 struct oberon_module_s
 {
        char * name;
 
-       oberon_var_t * vars;
-       oberon_proc_t * procs;
+       oberon_scope_t * decl;
 
        void (* begin)();
 };
@@ -60,11 +67,12 @@ struct oberon_context_s
        char * string;
        int integer;
 
+       oberon_scope_t * decl;
        oberon_module_t * mod;
-       oberon_type_t * types;
 
        oberon_type_t * int_type;
        oberon_type_t * bool_type;
+       oberon_scope_t * world_scope;
 
        void * gen_context;
 };
@@ -72,7 +80,8 @@ struct oberon_context_s
 enum {
        MODE_VAR,
        MODE_INTEGER,
-       MODE_BOOLEAN
+       MODE_BOOLEAN,
+       MODE_CALL
 };
 
 enum {
@@ -105,7 +114,7 @@ struct oberon_item_s
        int mode;
        int integer;
        int boolean;
-       oberon_var_t * var;
+       oberon_object_t * var;
 };
 
 struct oberon_oper_s

diff --git a/test.c b/test.c
index 2bea391195d42f982cbaf1688e999242ee771586..da6a8041e833c307ff423b8411513067390e8c53 100644 (file)
--- a/test.c
+++ b/test.c
@@ -10,13 +10,14 @@ static const char source[] =
        ""
        "PROCEDURE Tier;"
        "BEGIN"
-       "       "
+       "       k := 314;"
        "END Tier;"
        ""
        "BEGIN"
        "       k := 1;"
        "       i := k;"
        "       b := TRUE;"
+       "       Tier;"
        "END Test."
 ;