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