X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=test.c;h=1f440779e411b51f514c9409fddf97b033019685;hb=12ae486a18746b042fcc4ebbefc5449d4d3464af;hp=0837de4ef28f6ba05ca3dbe8f4c191e95fd0caa5;hpb=390a7e053165954865bc013a7c7057982c206453;p=dsw-obn.git diff --git a/test.c b/test.c index 0837de4..1f44077 100644 --- a/test.c +++ b/test.c @@ -1,27 +1,128 @@ #include "oberon.h" +#include "generator.h" + +#include #include -static const char source[] = +static char source_test[] = + "(* Main module *)" "MODULE Test;" + "IMPORT Out;" + "" "VAR" - " k : INTEGER;" - " i : INTEGER;" - " b : BOOLEAN;" + " nx- : INTEGER;" + " p : POINTER TO ARRAY 3 OF RECORD i, j, k : INTEGER END;" + " q : POINTER TO RECORD x, y, z : INTEGER END;" + "" + "PROCEDURE ChParam(VAR i : INTEGER);" "BEGIN" - " k := -10 + 1;" - " i := k;" - " b := ~TRUE OR FALSE;" + " i := 1234;" + "END ChParam;" + "" + "BEGIN;" + " NEW(p);" + " p[2].k := 1;" + " NEW(q);" + " " + " Out.Open;" + " ChParam(nx);" + " Out.Int(nx, 0);" + " Out.Ln;" "END Test." ; +static char source_out[] = + "MODULE Out;" + "(* Interface to outer program ;) *)" + "VAR" + " Open- : PROCEDURE;" +// " Char- : PROCEDURE(ch : CHAR);" +// " String- : PROCEDURE(str : ARRAY OF CHAR)" +// " Int- : PROCEDURE(i, n : LONGINT);" + " Int- : PROCEDURE(i, n : INTEGER);" +// " Real- : PROCEDURE(x : REAL; n : INTEGER);" +// " LongReal- : PROCEDURE(x : LONGREAL; n : INTEGER);" + " Ln- : PROCEDURE;" + "END Out." +; + 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, "Out") == 0) + { + return source_out; + } + else + { + return NULL; + } +} + +typedef void (*TOutOpen)(); +static TOutOpen * OutOpenPtr; +void ImplOutOpen() +{ +} + +typedef void (*TOutInt)(int, int); +static TOutInt * OutIntPtr; +void ImplOutInt(int i, int n) +{ + char number[22]; + snprintf(number, 22, "%i", i); + int len = strlen(number); + for(int i = 0; i < n - len; i++) + { + putchar(' '); + } + printf("%s", number); +} + +typedef void (*TOutLn)(); +static TOutLn * OutLnPtr; +void ImplOutLn() +{ + putchar('\n'); +} + +void init_system_modules() +{ + OutOpenPtr = oberon_generator_get_var(ctx, "Out_Open"); + *OutOpenPtr = ImplOutOpen; + OutIntPtr = oberon_generator_get_var(ctx, "Out_Int"); + *OutIntPtr = ImplOutInt; + OutLnPtr = oberon_generator_get_var(ctx, "Out_Ln"); + *OutLnPtr = ImplOutLn; +} + +void start_module() +{ + void (*begin)() = oberon_generator_get_procedure(ctx, "Test_BEGIN"); + begin(); +} + int main(int argc, char ** argv) { - ctx = oberon_create_context(); - mod = oberon_compile_module(ctx, source); + ctx = oberon_create_context(import_module); + mod = oberon_compile_module(ctx, source_test); + + oberon_generate_code(ctx); + + init_system_modules(); + + oberon_generator_dump(ctx, "dump.txt"); + + start_module(); + oberon_destroy_context(ctx); return 0; }