src/test.c

   1 #include <stdio.h>
   2 #include <string.h>
   3 #include <assert.h>
   4
   5 #include "../include/oberon.h"
   6
   7 static char source_test[] =
   8         "(* Main module *)"
   9         "MODULE Test;"
  10         "VAR"
  11         "  g : ARRAY 4 OF INTEGER;"
  12         "  r : RECORD x : INTEGER; END;"
  13         "BEGIN"
  14         "  g[3] := 4;"
  15         "  r.x := 4546;"
  16         "END Test."
  17 ;
  18
  19 static char source_out[] =
  20         "MODULE Out;"
  21 //      "(* Interface to outer program ;) *)"
  22 //      "VAR"
  23 //      "  Open-     : PROCEDURE;"
  24 //      "  Char-     : PROCEDURE(ch : CHAR);"
  25 //      "  String-   : PROCEDURE(str : ARRAY OF CHAR)"
  26 //      "  Int-      : PROCEDURE(i, n : LONGINT);"
  27 //      "  Int-      : PROCEDURE(i, n : INTEGER);"
  28 //      "  Real-     : PROCEDURE(x : REAL; n : INTEGER);"
  29 //      "  LongReal- : PROCEDURE(x : LONGREAL; n : INTEGER);"
  30 //      "  Ln-       : PROCEDURE;"
  31         "END Out."
  32 ;
  33
  34 static oberon_context_t * ctx;
  35 static oberon_module_t * mod;
  36
  37 static const char *
  38 import_module(const char * name)
  39 {
  40         if(strcmp(name, "Test") == 0)
  41         {
  42                 return source_test;
  43         }
  44         else if(strcmp(name, "Out") == 0)
  45         {
  46                 return source_out;
  47         }
  48         else
  49         {
  50                 return NULL;
  51         }
  52 }
  53
  54 typedef void (*TOutOpen)();
  55 static TOutOpen * OutOpenPtr;
  56 void ImplOutOpen()
  57 {
  58 }
  59
  60 typedef void (*TOutInt)(int, int);
  61 static TOutInt * OutIntPtr;
  62 void ImplOutInt(int i, int n)
  63 {
  64         char number[22];
  65         snprintf(number, 22, "%d", i);
  66         int len = strlen(number);
  67         for(int i = 0; i < n - len; i++)
  68         {
  69                 putchar(' ');
  70         }
  71         printf("%s", number);
  72 }
  73
  74 typedef void (*TOutReal)(float, int);
  75 static TOutReal * OutRealPtr;
  76 void ImplOutReal(float i, int n)
  77 {
  78         char number[32];
  79         snprintf(number, 32, "%F", i);
  80         int len = strlen(number);
  81         for(int i = 0; i < n - len; i++)
  82         {
  83                 putchar(' ');
  84         }
  85         printf("%s", number);
  86 }
  87
  88 typedef void (*TOutLn)();
  89 static TOutLn * OutLnPtr;
  90 void ImplOutLn()
  91 {
  92         putchar('\n');
  93 }
  94
  95 void init_system_modules()
  96 {
  97         OutOpenPtr = oberon_generator_get_var(ctx, "Out_Open");
  98         *OutOpenPtr = ImplOutOpen;
  99         OutIntPtr = oberon_generator_get_var(ctx, "Out_Int");
 100         *OutIntPtr = ImplOutInt;
 101         OutRealPtr = oberon_generator_get_var(ctx, "Out_Real");
 102         *OutRealPtr = ImplOutReal;
 103         OutLnPtr = oberon_generator_get_var(ctx, "Out_Ln");
 104         *OutLnPtr = ImplOutLn;
 105 }
 106
 107 void start_module()
 108 {
 109         void (*begin)() = oberon_generator_get_procedure(ctx, "Test_BEGIN");
 110         begin();
 111 }
 112
 113 int
 114 main(int argc, char ** argv)
 115 {
 116         ctx = oberon_create_context(import_module);
 117         mod = oberon_compile_module(ctx, source_test);
 118
 119         oberon_generate_code(ctx);
 120
 121 //      init_system_modules();
 122
 123 //      oberon_generator_dump(ctx, "dump.txt");
 124
 125 //      start_module();
 126
 127         oberon_destroy_context(ctx);
 128         return 0;
 129 }