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