test.c

   1 #include "oberon.h"
   2 #include "generator.h"
   3
   4 #include <string.h>
   5 #include <assert.h>
   6
   7 static char source_test[] =
   8         "(* Main module *)"
   9         "MODULE Test;"
  10         "IMPORT Out;"
  11         "BEGIN;"
  12         "  Out.Open;"
  13         "  Out.Int(666, 0);"
  14         "  Out.Ln;"
  15         "END Test."
  16 ;
  17
  18 static char source_out[] =
  19         "MODULE Out;"
  20         "VAR"
  21         "  Open-     : PROCEDURE;"
  22 //      "  Char-     : PROCEDURE(ch : CHAR);"
  23 //      "  String-   : PROCEDURE(str : ARRAY OF CHAR)"
  24 //      "  Int-      : PROCEDURE(i, n : LONGINT);"
  25         "  Int-      : PROCEDURE(i, n : INTEGER);"
  26 //      "  Real-     : PROCEDURE(x : REAL; n : INTEGER);"
  27 //      "  LongReal- : PROCEDURE(x : LONGREAL; n : INTEGER);"
  28         "  Ln-       : PROCEDURE;"
  29         "END Out."
  30 ;
  31
  32 static oberon_context_t * ctx;
  33 static oberon_module_t * mod;
  34
  35 static const char *
  36 import_module(const char * name)
  37 {
  38         if(strcmp(name, "Test") == 0)
  39         {
  40                 return source_test;
  41         }
  42         else if(strcmp(name, "Out") == 0)
  43         {
  44                 return source_out;
  45         }
  46         else
  47         {
  48                 return NULL;
  49         }
  50 }
  51
  52 typedef void (*TOutOpen)();
  53 static TOutOpen * OutOpenPtr;
  54 void ImplOutOpen()
  55 {
  56 }
  57
  58 typedef void (*TOutInt)(int, int);
  59 static TOutInt * OutIntPtr;
  60 void ImplOutInt(int i, int n)
  61 {
  62         printf("%i", i);
  63 }
  64
  65 typedef void (*TOutLn)();
  66 static TOutLn * OutLnPtr;
  67 void ImplOutLn()
  68 {
  69         printf("\n");
  70 }
  71
  72 void init_system_modules()
  73 {
  74         OutOpenPtr = oberon_generator_get_var(ctx, "Out_Open");
  75         *OutOpenPtr = ImplOutOpen;
  76         OutIntPtr = oberon_generator_get_var(ctx, "Out_Int");
  77         *OutIntPtr = ImplOutInt;
  78         OutLnPtr = oberon_generator_get_var(ctx, "Out_Ln");
  79         *OutLnPtr = ImplOutLn;
  80 }
  81
  82 void start_module()
  83 {
  84         void (*begin)() = oberon_generator_get_procedure(ctx, "Test_BEGIN");
  85         begin();
  86 }
  87
  88 int
  89 main(int argc, char ** argv)
  90 {
  91         ctx = oberon_create_context(import_module);
  92         mod = oberon_compile_module(ctx, source_test);
  93
  94         oberon_generate_code(ctx);
  95
  96         init_system_modules();
  97
  98         oberon_generator_dump(ctx, "dump.txt");
  99
 100         start_module();
 101
 102         oberon_destroy_context(ctx);
 103         return 0;
 104 }