#include #include #include #include "../include/oberon.h" static char source_test[] = "(* Main module *)" "MODULE Test;" "TYPE" " P = PROCEDURE;" " F = PROCEDURE (x : INTEGER) : INTEGER;" "" "VAR" " p : P;" " f : F;" " i : INTEGER;" "" "PROCEDURE Pow(x : INTEGER) : INTEGER;" "BEGIN" " RETURN x * x;" "END Pow;" "" "PROCEDURE Do;" "END Do;" "" "BEGIN;" " p := Do;" " f := Pow;" " i := f(7);" " p;" "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, "%d", i); int len = strlen(number); for(int i = 0; i < n - len; i++) { putchar(' '); } printf("%s", number); } typedef void (*TOutReal)(float, int); static TOutReal * OutRealPtr; void ImplOutReal(float i, int n) { char number[32]; snprintf(number, 32, "%F", 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; OutRealPtr = oberon_generator_get_var(ctx, "Out_Real"); *OutRealPtr = ImplOutReal; 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; }