#include "oberon.h" #include "generator.h" #include #include static char source_test[] = "(* Main module *)" "MODULE Test;" "IMPORT Out;" "" "VAR" " nx- : INTEGER;" " p : POINTER TO ARRAY 3 OF INTEGER;" "" "PROCEDURE ChParam(VAR i : INTEGER);" "BEGIN" " i := 1234;" "END ChParam;" "" "BEGIN;" " NEW(p);" " p[0] := 1;" " " " 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(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; }