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