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