Добавлены модули

diff --git a/generator.c b/generator.c
index 05873d1303fa9bb214a3add0bf3374a3b408196d..b7c24b3968cd780b14e47bc5a26c591179dc8f1a 100644 (file)
--- a/generator.c
+++ b/generator.c
@@ -8,21 +8,6 @@
 #include "oberon.h"
 #include "generator.h"
 
 #include "oberon.h"
 #include "generator.h"
 

-static void printcontext(oberon_context_t * ctx, char * s)
-{
-/*
-       gen_context_t * gen_context = ctx -> gen_context;
-       gcc_jit_context * gcc_context = gen_context -> gcc_context;
-       gcc_jit_block * gcc_block = gen_context -> gcc_block;
-
-       printf("%s:\n", s);
-       printf("  ctx     = %p:\n", ctx);
-       printf("  gctx    = %p:\n", gctx);
-       printf("  context = %p:\n", context);
-       printf("  block   = %p:\n", block);
-*/
-}
-

 // =======================================================================
 //   ALLOC
 // ======================================================================= 
 // =======================================================================
 //   ALLOC
 // ======================================================================= 


@@ -56,15 +41,11 @@ oberon_generator_init_context(oberon_context_t * ctx)
 
        ctx -> gen_context = gen_context;
        gen_context -> gcc_context = gcc_context;
 
        ctx -> gen_context = gen_context;
        gen_context -> gcc_context = gcc_context;

-
-       printcontext(ctx, "oberon_generator_init_context");

 }
 
 void
 oberon_generator_destroy_context(oberon_context_t * ctx)
 {
 }
 
 void
 oberon_generator_destroy_context(oberon_context_t * ctx)
 {

-       printcontext(ctx, "oberon_generator_destroy_context");
-

        gen_context_t * gen_context = ctx -> gen_context;
        gcc_jit_context * gcc_context = gen_context -> gcc_context;
 
        gen_context_t * gen_context = ctx -> gen_context;
        gcc_jit_context * gcc_context = gen_context -> gcc_context;
 


@@ -171,6 +152,38 @@ oberon_generator_init_record(oberon_context_t * ctx, oberon_type_t * type)
        //gcc_struct = gcc_jit_context_new_struct_type(gcc_context, NULL, "", num_fields, fields);
 }
 
        //gcc_struct = gcc_jit_context_new_struct_type(gcc_context, NULL, "", num_fields, fields);
 }
 

+static void
+oberon_generator_get_full_name(char * name, int max_len, oberon_object_t * o)
+{
+       if(!o)
+       {
+               name[0] = 0;
+               return;
+       }
+
+       char parent[256];
+       oberon_generator_get_full_name(parent, 256, o -> parent);
+
+       char * xname;
+//     if(o -> class == OBERON_CLASS_MODULE)
+//     {
+//             xname = o -> module -> name;
+//     }
+//     else
+//     {
+               xname = o -> name;
+//     }
+
+       if(strlen(parent) > 0)
+       {
+               snprintf(name, max_len, "%s_%s", parent, xname);
+       }
+       else
+       {
+               snprintf(name, max_len, "%s", xname);
+       }
+}
+

 void
 oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
 {
 void
 oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
 {


@@ -183,7 +196,9 @@ oberon_generator_init_var(oberon_context_t * ctx, oberon_object_t * var)
 
        gcc_jit_context * gcc_context = gen_context -> gcc_context;
        gcc_jit_type * gcc_type = gen_type -> gcc_type;
 
        gcc_jit_context * gcc_context = gen_context -> gcc_context;
        gcc_jit_type * gcc_type = gen_type -> gcc_type;

-       const char * name = var -> name;
+
+       char name[256];
+       oberon_generator_get_full_name(name, 256, var);

 
        gcc_jit_lvalue * gcc_lvalue = NULL;
        gcc_jit_param * gcc_param = NULL;
 
        gcc_jit_lvalue * gcc_lvalue = NULL;
        gcc_jit_param * gcc_param = NULL;


@@ -244,7 +259,9 @@ oberon_generator_init_proc(oberon_context_t * ctx, oberon_object_t * proc)
        memset(gen_proc, 0, sizeof *gen_proc);
        proc -> gen_proc = gen_proc;
 
        memset(gen_proc, 0, sizeof *gen_proc);
        proc -> gen_proc = gen_proc;
 

-       const char * name = proc -> name;
+       char name[256];
+       oberon_generator_get_full_name(name, 256, proc);
+

        gen_type_t * gen_result_type = proc -> type -> base -> gen_type;
        gcc_jit_type * result_type = gen_result_type -> gcc_type;
 
        gen_type_t * gen_result_type = proc -> type -> base -> gen_type;
        gcc_jit_type * result_type = gen_result_type -> gcc_type;
 


@@ -277,14 +294,15 @@ static gcc_jit_rvalue * rvalue_from_expr(oberon_context_t * ctx, oberon_expr_t *
 void
 oberon_generate_begin_module(oberon_context_t * ctx)
 {
 void
 oberon_generate_begin_module(oberon_context_t * ctx)
 {

-       printcontext(ctx, "oberon_generate_begin_module");
-

        gen_context_t * gen_context = ctx -> gen_context;
        gcc_jit_context * gcc_context = gen_context -> gcc_context;
 
        gen_context_t * gen_context = ctx -> gen_context;
        gcc_jit_context * gcc_context = gen_context -> gcc_context;
 

+       char name[256];
+       snprintf(name, 256, "%s_BEGIN", ctx -> mod -> name);
+

        gcc_jit_type * void_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_VOID);
        gcc_jit_function * func = gcc_jit_context_new_function(
        gcc_jit_type * void_type = gcc_jit_context_get_type(gcc_context, GCC_JIT_TYPE_VOID);
        gcc_jit_function * func = gcc_jit_context_new_function(

-               gcc_context, NULL, GCC_JIT_FUNCTION_EXPORTED, void_type, "BEGIN", 0, NULL, 0
+               gcc_context, NULL, GCC_JIT_FUNCTION_EXPORTED, void_type, name, 0, NULL, 0

        );
        gcc_jit_block * gcc_block = gcc_jit_function_new_block(func, NULL);
 
        );
        gcc_jit_block * gcc_block = gcc_jit_function_new_block(func, NULL);
 


@@ -294,8 +312,6 @@ oberon_generate_begin_module(oberon_context_t * ctx)
 void
 oberon_generate_end_module(oberon_context_t * ctx)
 {
 void
 oberon_generate_end_module(oberon_context_t * ctx)
 {

-       printcontext(ctx, "oberon_generate_end_module");
-

        gen_context_t * gen_context = ctx -> gen_context;
        gcc_jit_block * gcc_block = gen_context -> block -> gcc_block;
 
        gen_context_t * gen_context = ctx -> gen_context;
        gcc_jit_block * gcc_block = gen_context -> block -> gcc_block;
 


@@ -661,7 +677,8 @@ oberon_generate_code(oberon_context_t * ctx)
        gcc_result = gcc_jit_context_compile(gcc_context);
 
        gen_context -> gcc_result = gcc_result;
        gcc_result = gcc_jit_context_compile(gcc_context);
 
        gen_context -> gcc_result = gcc_result;

-       ctx -> mod -> begin = gcc_jit_result_get_code(gcc_result, "BEGIN");
+
+//     ctx -> mod -> begin = gcc_jit_result_get_code(gcc_result, "BEGIN");

 }
 
 void
 }
 
 void

diff --git a/notes b/notes
index c3e44ab1a381ec39ef20e8afb09b4ddb6311cb5e..819b45f135f2a5af03910849a15bbd9593aaa718 100644 (file)
--- a/notes
+++ b/notes
@@ -1,9 +1,11 @@
+- нету экспорта объектов (всё доступно для чтения и записи)
+- нету списков переменных/параметров. (* VAR x, y, z : INTEGER; *)
+- нету комментариев
+

 - нету тестовых процедур для ввода-вывода
 - нету процедуры NEW
 - нету открытых массивов
 
 - нету тестовых процедур для ввода-вывода
 - нету процедуры NEW
 - нету открытых массивов
 

-- нету секции import + identdef + qualident
-

 - нету операторов if, while и т.д.
 
 - нету типа set
 - нету операторов if, while и т.д.
 
 - нету типа set

diff --git a/oberon.c b/oberon.c
index 28a351a6fdbfd4e315d4b2959b40a3b440a85f1e..e12ee36174e9fd9cfd9a870225dea8528d46e8f8 100644 (file)
--- a/oberon.c
+++ b/oberon.c
@@ -52,7 +52,8 @@ enum {
        POINTER,
        TO,
        UPARROW,
        POINTER,
        TO,
        UPARROW,

-       NIL
+       NIL,
+       IMPORT

 };
 
 // =======================================================================
 };
 
 // =======================================================================


@@ -108,11 +109,8 @@ oberon_new_type_boolean(int size)
 static oberon_scope_t *
 oberon_open_scope(oberon_context_t * ctx)
 {
 static oberon_scope_t *
 oberon_open_scope(oberon_context_t * ctx)
 {

-       oberon_scope_t * scope = malloc(sizeof *scope);
-       memset(scope, 0, sizeof *scope);
-
-       oberon_object_t * list = malloc(sizeof *list);
-       memset(list, 0, sizeof *list);
+       oberon_scope_t * scope = calloc(1, sizeof *scope);
+       oberon_object_t * list = calloc(1, sizeof *list);

 
        scope -> ctx = ctx;
        scope -> list = list;
 
        scope -> ctx = ctx;
        scope -> list = list;


@@ -415,6 +413,10 @@ oberon_read_ident(oberon_context_t * ctx)
        {
                ctx -> token = NIL;
        }
        {
                ctx -> token = NIL;
        }

+       else if(strcmp(ident, "IMPORT") == 0)
+       {
+               ctx -> token = IMPORT;
+       }

 }
 
 static void
 }
 
 static void


@@ -985,6 +987,34 @@ oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char *
        || ((x) == DOT) \
        || ((x) == UPARROW))
 
        || ((x) == DOT) \
        || ((x) == UPARROW))
 

+static oberon_object_t *
+oberon_qualident(oberon_context_t * ctx, char ** xname, int check)
+{
+       char * name;
+       oberon_object_t * x;
+
+       name = oberon_assert_ident(ctx);
+       x = oberon_find_object(ctx -> decl, name, check);
+
+       if(x != NULL)
+       {
+               if(x -> class == OBERON_CLASS_MODULE)
+               {
+                       oberon_assert_token(ctx, DOT);
+                       name = oberon_assert_ident(ctx);
+                       /* Наличие объектов в левых модулях всегда проверяется */
+                       x = oberon_find_object(x -> module -> decl, name, 1);
+               }
+       }
+
+       if(xname)
+       {
+               *xname = name;
+       }
+
+       return x;
+}
+

 static oberon_expr_t *
 oberon_designator(oberon_context_t * ctx)
 {
 static oberon_expr_t *
 oberon_designator(oberon_context_t * ctx)
 {


@@ -992,8 +1022,7 @@ oberon_designator(oberon_context_t * ctx)
        oberon_object_t * var;
        oberon_expr_t * expr;
 
        oberon_object_t * var;
        oberon_expr_t * expr;
 

-       name = oberon_assert_ident(ctx);
-       var = oberon_find_object(ctx -> decl, name, 1);
+       var = oberon_qualident(ctx, NULL, 1);

 
        switch(var -> class)
        {
 
        switch(var -> class)
        {


@@ -1498,8 +1527,14 @@ oberon_formal_pars(oberon_context_t * ctx, oberon_type_t * signature)
        if(ctx -> token == COLON)
        {
                oberon_assert_token(ctx, COLON);
        if(ctx -> token == COLON)
        {
                oberon_assert_token(ctx, COLON);

-               // TODO get by qualident
-               oberon_type(ctx, &signature -> base);
+
+               oberon_object_t * typeobj;
+               typeobj = oberon_qualident(ctx, NULL, 1);
+               if(typeobj -> class != OBERON_CLASS_TYPE)
+               {
+                       oberon_error(ctx, "function result is not type");
+               }
+               signature -> base = typeobj -> type;

        }
 }
 
        }
 }
 


@@ -1734,8 +1769,10 @@ oberon_qualident_type(oberon_context_t * ctx, oberon_type_t ** type)
        char * name;
        oberon_object_t * to;
 
        char * name;
        oberon_object_t * to;
 

-       name = oberon_assert_ident(ctx);
-       to = oberon_find_object(ctx -> decl, name, 0);
+       to = oberon_qualident(ctx, &name, 0);
+
+       //name = oberon_assert_ident(ctx);
+       //to = oberon_find_object(ctx -> decl, name, 0);

 
        if(to != NULL)
        {
 
        if(to != NULL)
        {


@@ -2027,6 +2064,7 @@ oberon_prevent_recursive_object(oberon_context_t * ctx, oberon_object_t * x)
                        break;
                case OBERON_CLASS_CONST:
                case OBERON_CLASS_PROC:
                        break;
                case OBERON_CLASS_CONST:
                case OBERON_CLASS_PROC:

+               case OBERON_CLASS_MODULE:

                        break;
                default:
                        oberon_error(ctx, "oberon_prevent_recursive_object: wat");
                        break;
                default:
                        oberon_error(ctx, "oberon_prevent_recursive_object: wat");


@@ -2145,9 +2183,10 @@ oberon_initialize_object(oberon_context_t * ctx, oberon_object_t * x)
                        break;
                case OBERON_CLASS_CONST:
                case OBERON_CLASS_PROC:
                        break;
                case OBERON_CLASS_CONST:
                case OBERON_CLASS_PROC:

+               case OBERON_CLASS_MODULE:

                        break;
                default:
                        break;
                default:

-                       oberon_error(ctx, "oberon_prevent_recursive_object: wat");
+                       oberon_error(ctx, "oberon_initialize_object: wat");

                        break;
        }
 }
                        break;
        }
 }


@@ -2281,10 +2320,74 @@ oberon_statement_seq(oberon_context_t * ctx)
        }
 }
 
        }
 }
 

+static void
+oberon_import_module(oberon_context_t * ctx, char * alias, char * name)
+{
+       oberon_module_t * m = ctx -> module_list;
+       while(m && strcmp(m -> name, name) != 0)
+       {
+               m = m -> next;
+       }
+
+       if(m == NULL)
+       {
+               const char * code;
+               code = ctx -> import_module(name);
+               if(code == NULL)
+               {
+                       oberon_error(ctx, "no such module");
+               }
+
+               m = oberon_compile_module(ctx, code);
+               assert(m);
+       }
+
+       if(m -> ready == 0)
+       {
+               oberon_error(ctx, "cyclic module import");
+       }
+
+       oberon_object_t * ident;
+       ident = oberon_define_object(ctx -> decl, alias, OBERON_CLASS_MODULE);
+       ident -> module = m;
+}
+
+static void
+oberon_import_decl(oberon_context_t * ctx)
+{
+       char * alias;
+       char * name;
+
+       alias = name = oberon_assert_ident(ctx);
+       if(ctx -> token == ASSIGN)
+       {
+               oberon_assert_token(ctx, ASSIGN);
+               name = oberon_assert_ident(ctx);
+       }
+
+       oberon_import_module(ctx, alias, name);
+}
+
+static void
+oberon_import_list(oberon_context_t * ctx)
+{
+       oberon_assert_token(ctx, IMPORT);
+
+       oberon_import_decl(ctx);
+       while(ctx -> token == COMMA)
+       {
+               oberon_assert_token(ctx, COMMA);
+               oberon_import_decl(ctx);
+       }
+
+       oberon_assert_token(ctx, SEMICOLON);
+}
+

 static void
 oberon_parse_module(oberon_context_t * ctx)
 {
 static void
 oberon_parse_module(oberon_context_t * ctx)
 {

-       char *name1, *name2;
+       char * name1;
+       char * name2;

        oberon_read_token(ctx);
 
        oberon_assert_token(ctx, MODULE);
        oberon_read_token(ctx);
 
        oberon_assert_token(ctx, MODULE);


@@ -2292,12 +2395,24 @@ oberon_parse_module(oberon_context_t * ctx)
        oberon_assert_token(ctx, SEMICOLON);
        ctx -> mod -> name = name1;
 
        oberon_assert_token(ctx, SEMICOLON);
        ctx -> mod -> name = name1;
 

+       oberon_object_t * this_module;
+       this_module = oberon_define_object(ctx -> decl, name1, OBERON_CLASS_MODULE);
+       this_module -> module = ctx -> mod;
+
+       if(ctx -> token == IMPORT)
+       {
+               oberon_import_list(ctx);
+       }
+
+       ctx -> decl -> parent = this_module;
+

        oberon_decl_seq(ctx);
 
        oberon_decl_seq(ctx);
 

+       oberon_generate_begin_module(ctx);
+

        if(ctx -> token == BEGIN)
        {
                oberon_assert_token(ctx, BEGIN);
        if(ctx -> token == BEGIN)
        {
                oberon_assert_token(ctx, BEGIN);

-               oberon_generate_begin_module(ctx);

                oberon_statement_seq(ctx);
                oberon_generate_end_module(ctx);
        }
                oberon_statement_seq(ctx);
                oberon_generate_end_module(ctx);
        }


@@ -2375,15 +2490,16 @@ oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_
 }
 
 oberon_context_t *
 }
 
 oberon_context_t *

-oberon_create_context()
+oberon_create_context(ModuleImportCallback import_module)

 {
 {

-       oberon_context_t * ctx = malloc(sizeof *ctx);
-       memset(ctx, 0, sizeof *ctx);
+       oberon_context_t * ctx = calloc(1, sizeof *ctx);

 
        oberon_scope_t * world_scope;
        world_scope = oberon_open_scope(ctx);
        ctx -> world_scope = world_scope;
 
 
        oberon_scope_t * world_scope;
        world_scope = oberon_open_scope(ctx);
        ctx -> world_scope = world_scope;
 

+       ctx -> import_module = import_module;
+

        oberon_generator_init_context(ctx);
 
        register_default_types(ctx);
        oberon_generator_init_context(ctx);
 
        register_default_types(ctx);


@@ -2400,21 +2516,41 @@ oberon_destroy_context(oberon_context_t * ctx)
 }
 
 oberon_module_t *
 }
 
 oberon_module_t *

-oberon_compile_module(oberon_context_t * ctx, const char * code)
+oberon_compile_module(oberon_context_t * ctx, const char * newcode)

 {
 {

-       oberon_module_t * mod = malloc(sizeof *mod);
-       memset(mod, 0, sizeof *mod);
-       ctx -> mod = mod;
+       const char * code = ctx -> code;
+       int code_index = ctx -> code_index;
+       char c = ctx -> c;
+       int token = ctx -> token;
+       char * string = ctx -> string;
+       int integer = ctx -> integer;
+       oberon_scope_t * decl = ctx -> decl;
+       oberon_module_t * mod = ctx -> mod;

 
        oberon_scope_t * module_scope;
        module_scope = oberon_open_scope(ctx);
 
        oberon_scope_t * module_scope;
        module_scope = oberon_open_scope(ctx);

-       mod -> decl = module_scope;

 
 

-       oberon_init_scaner(ctx, code);
+       oberon_module_t * module;
+       module = calloc(1, sizeof *module);
+       module -> decl = module_scope;
+       module -> next = ctx -> module_list;
+
+       ctx -> mod = module;
+       ctx -> module_list = module;
+
+       oberon_init_scaner(ctx, newcode);

        oberon_parse_module(ctx);
 
        oberon_parse_module(ctx);
 

-       oberon_generate_code(ctx);
+       module -> ready = 1;
+
+       ctx -> code = code;
+       ctx -> code_index = code_index;
+       ctx -> c = c;
+       ctx -> token = token;
+       ctx -> string = string;
+       ctx -> integer = integer;
+       ctx -> decl = decl;
+       ctx -> mod = mod;

 
 

-       ctx -> mod = NULL;
-       return mod;
+       return module;

 }
 }

diff --git a/oberon.h b/oberon.h
index d481e130b6e89c06e8b3227cc882e2be2339ecbc..9956fdc09d0a9bc77edff1d295ce48b7d4f35ee5 100644 (file)
--- a/oberon.h
+++ b/oberon.h
@@ -136,12 +136,8 @@ enum
        OBERON_CLASS_PARAM,
        OBERON_CLASS_VAR_PARAM,
        OBERON_CLASS_CONST,
        OBERON_CLASS_PARAM,
        OBERON_CLASS_VAR_PARAM,
        OBERON_CLASS_CONST,

-       OBERON_CLASS_FIELD
-};
-
-enum
-{
-       OBERON_SYSPROC_ABS
+       OBERON_CLASS_FIELD,
+       OBERON_CLASS_MODULE

 };
 
 /*
 };
 
 /*


@@ -178,6 +174,8 @@ struct oberon_object_s
        oberon_item_t * value;
        oberon_object_t * next;
 
        oberon_item_t * value;
        oberon_object_t * next;
 

+       oberon_module_t * module;
+

        gen_var_t * gen_var;
        gen_proc_t * gen_proc;
 };
        gen_var_t * gen_var;
        gen_proc_t * gen_proc;
 };


@@ -193,10 +191,11 @@ struct oberon_object_s
 struct oberon_module_s
 {
        char * name;
 struct oberon_module_s
 {
        char * name;

+       int ready;

 
        oberon_scope_t * decl;
 
 
        oberon_scope_t * decl;
 

-       void (* begin)();
+       oberon_module_t * next;

 };
 
 /*
 };
 
 /*


@@ -216,8 +215,11 @@ struct oberon_module_s
  *   world_scope -- область видимости "мир" - выше модуля.
  */
 
  *   world_scope -- область видимости "мир" - выше модуля.
  */
 

+typedef const char * (*ModuleImportCallback)(const char * name);
+

 struct oberon_context_s
 {
 struct oberon_context_s
 {

+       /*** SCANER DATA ***/

        const char * code;
        int code_index;
 
        const char * code;
        int code_index;
 


@@ -225,16 +227,20 @@ struct oberon_context_s
        int token;
        char * string;
        int integer;
        int token;
        char * string;
        int integer;

+       /*** END SCANER DATA ***/

 
 

+       /*** PARSER DATA ***/

        oberon_scope_t * decl;
        oberon_module_t * mod;
        oberon_scope_t * decl;
        oberon_module_t * mod;

+       /*** END PARSER DATA ***/

 
        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;
 
        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;

-
+       oberon_module_t * module_list;
+       ModuleImportCallback import_module;

        gen_context_t * gen_context;
 };
 
        gen_context_t * gen_context;
 };
 


@@ -316,7 +322,7 @@ union oberon_expr_u
        oberon_oper_t oper;
 };
 
        oberon_oper_t oper;
 };
 

-oberon_context_t * oberon_create_context();
+oberon_context_t * oberon_create_context(ModuleImportCallback import_module);

 void oberon_destroy_context(oberon_context_t * ctx);
 void oberon_register_global_type(oberon_context_t * ctx, oberon_type_t * type);
 oberon_module_t * oberon_compile_module(oberon_context_t * ctx, const char * code);
 void oberon_destroy_context(oberon_context_t * ctx);
 void oberon_register_global_type(oberon_context_t * ctx, oberon_type_t * type);
 oberon_module_t * oberon_compile_module(oberon_context_t * ctx, const char * code);

diff --git a/test.c b/test.c
index 6b6d335760a57a4fd9e5ca68af3c95b849c96d38..297da8de9a9c9d21c05fe7db43989753f35613cb 100644 (file)
--- a/test.c
+++ b/test.c
@@ -1,15 +1,19 @@
 #include "oberon.h"
 #include "generator.h"
 #include "oberon.h"
 #include "generator.h"

+
+#include <string.h>

 #include <assert.h>
 
 #include <assert.h>
 

-static const char source[] =
+static char source_test[] =

        "MODULE Test;"
        "MODULE Test;"

+       "IMPORT I := Imported;"

        "TYPE"
        "       Callback = PROCEDURE() : INTEGER;"
        ""
        "VAR"
        "       cb : Callback;"
        "       i : INTEGER;"
        "TYPE"
        "       Callback = PROCEDURE() : INTEGER;"
        ""
        "VAR"
        "       cb : Callback;"
        "       i : INTEGER;"

+       "       r : I.Rider;"

        ""
        "PROCEDURE RelBack;"
        "BEGIN"
        ""
        "PROCEDURE RelBack;"
        "BEGIN"


@@ -20,18 +24,48 @@ static const char source[] =
        "       i := ABS(-1);"
        "       i := cb();"
        "       RelBack;"
        "       i := ABS(-1);"
        "       i := cb();"
        "       RelBack;"

+       "       I.Ln;"

        "END Test."
 ;
 
        "END Test."
 ;
 

+static char source_imported[] =
+       "MODULE Imported;"
+       "TYPE"
+       "       Rider = RECORD i : INTEGER; END;"
+       ""
+       "PROCEDURE Ln;"
+       "END Ln;"
+       ""
+       "BEGIN;"
+       "END Imported."
+;
+

 static oberon_context_t * ctx;
 static oberon_module_t * mod;
 
 static oberon_context_t * ctx;
 static oberon_module_t * mod;
 

+static const char *
+import_module(const char * name)
+{
+       if(strcmp(name, "Test") == 0)
+       {
+               return source_test;
+       }
+       else if(strcmp(name, "Imported") == 0)
+       {
+               return source_imported;
+       }
+       else
+       {
+               return NULL;
+       }
+}
+

 int
 main(int argc, char ** argv)
 {
 int
 main(int argc, char ** argv)
 {

-       ctx = oberon_create_context();
-       mod = oberon_compile_module(ctx, source);
-       //mod -> begin();
+       ctx = oberon_create_context(import_module);
+       mod = oberon_compile_module(ctx, source_test);
+       oberon_generate_code(ctx);

        oberon_generator_dump(ctx, "dump.txt");
        oberon_destroy_context(ctx);
        return 0;
        oberon_generator_dump(ctx, "dump.txt");
        oberon_destroy_context(ctx);
        return 0;

diff --git a/test/.gitignore b/test/.gitignore
new file mode 100644 (file)
index 0000000..345e6ae
--- /dev/null
+++ b/test/.gitignore
@@ -0,0 +1 @@
+Test