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