src/test.c

   1 #include <stdio.h>
   2 #include <string.h>
   3 #include <assert.h>
   4
   5 #include "../include/oberon.h"
   6
   7 /*
   8 static char source_test[] =
   9         "(* Main module *)"
  10         "MODULE Test;"
  11         "IMPORT Out;"
  12         ""
  13         "TYPE"
  14         "  R = LONGINT;"
  15         ""
  16         "PROCEDURE Factorial(n : R) : R;"
  17         "BEGIN"
  18         "  IF n <= 1 THEN"
  19         "    RETURN 1;"
  20         "  ELSE"
  21         "    RETURN n * Factorial(n - 1);"
  22         "  END;"
  23         "  RETURN 0; (* Детектор ретурнов - дерьмо *)"
  24         "END Factorial;"
  25         ""
  26         "BEGIN"
  27         "  Out.Open();"
  28         "  Out.Int(Factorial(0), 0); Out.Ln;"
  29         "  Out.Int(Factorial(1), 0); Out.Ln;"
  30         "  Out.Int(Factorial(2), 0); Out.Ln;"
  31         "  Out.Int(Factorial(3), 0); Out.Ln;"
  32         "  Out.Int(Factorial(4), 0); Out.Ln;"
  33         "  Out.Int(Factorial(5), 0); Out.Ln;"
  34         "  Out.Int(Factorial(6), 0); Out.Ln;"
  35         "  Out.Int(Factorial(7), 0); Out.Ln;"
  36         "  Out.Int(Factorial(8), 0); Out.Ln;"
  37         "  Out.Int(Factorial(9), 0); Out.Ln;"
  38         "  Out.Int(Factorial(10), 0); Out.Ln;"
  39         "  Out.Int(Factorial(11), 0); Out.Ln;"
  40         "  Out.Int(Factorial(12), 0); Out.Ln;"
  41         "  Out.Int(Factorial(13), 0); Out.Ln;"
  42         "  Out.Int(Factorial(14), 0); Out.Ln;"
  43         "  Out.Int(Factorial(15), 0); Out.Ln;"
  44         "  Out.Int(Factorial(16), 0); Out.Ln;"
  45         "  Out.Int(Factorial(17), 0); Out.Ln;"
  46         "  Out.Int(Factorial(18), 0); Out.Ln;"
  47         "  Out.Int(Factorial(19), 0); Out.Ln;"
  48         "  Out.Int(Factorial(20), 0); Out.Ln;"
  49         "END Test."
  50 ;
  51 */
  52
  53 static char source_test[] =
  54         "(* Main module *)"
  55         "MODULE Test;"
  56         "IMPORT Out;"
  57         ""
  58         "TYPE"
  59         "  R = LONGREAL;"
  60         ""
  61         "PROCEDURE Factorial(n : R) : R;"
  62         "BEGIN"
  63         "  IF n <= 1 THEN"
  64         "    RETURN 1;"
  65         "  ELSE"
  66         "    RETURN n * Factorial(n - 1);"
  67         "  END;"
  68         "  RETURN 0; (* Детектор ретурнов - дерьмо *)"
  69         "END Factorial;"
  70         ""
  71         "BEGIN"
  72         "  Out.Open();"
  73         "  Out.LongReal(Factorial(0), 0); Out.Ln;"
  74         "  Out.LongReal(Factorial(1), 0); Out.Ln;"
  75         "  Out.LongReal(Factorial(2), 0); Out.Ln;"
  76         "  Out.LongReal(Factorial(3), 0); Out.Ln;"
  77         "  Out.LongReal(Factorial(4), 0); Out.Ln;"
  78         "  Out.LongReal(Factorial(5), 0); Out.Ln;"
  79         "  Out.LongReal(Factorial(6), 0); Out.Ln;"
  80         "  Out.LongReal(Factorial(7), 0); Out.Ln;"
  81         "  Out.LongReal(Factorial(8), 0); Out.Ln;"
  82         "  Out.LongReal(Factorial(9), 0); Out.Ln;"
  83         "  Out.LongReal(Factorial(10), 0); Out.Ln;"
  84         "  Out.LongReal(Factorial(11), 0); Out.Ln;"
  85         "  Out.LongReal(Factorial(12), 0); Out.Ln;"
  86         "  Out.LongReal(Factorial(13), 0); Out.Ln;"
  87         "  Out.LongReal(Factorial(14), 0); Out.Ln;"
  88         "  Out.LongReal(Factorial(15), 0); Out.Ln;"
  89         "  Out.LongReal(Factorial(16), 0); Out.Ln;"
  90         "  Out.LongReal(Factorial(17), 0); Out.Ln;"
  91         "  Out.LongReal(Factorial(18), 0); Out.Ln;"
  92         "  Out.LongReal(Factorial(19), 0); Out.Ln;"
  93         "  Out.LongReal(Factorial(20), 0); Out.Ln;"
  94         "  Out.LongReal(Factorial(170), 0); Out.Ln;"
  95         "END Test."
  96 ;
  97
  98 static char source_out[] =
  99         "MODULE Out;"
 100         "  PROCEDURE Open*;"
 101         "  END Open;"
 102         ""
 103         "  PROCEDURE Char* (ch : CHAR);"
 104         "  END Char;"
 105         ""
 106         "  PROCEDURE String* (str : ARRAY OF CHAR);"
 107         "  END String;"
 108         ""
 109         "  PROCEDURE Int*(i, n : LONGINT);"
 110         "  END Int;"
 111         ""
 112         "  PROCEDURE Real*(x : REAL; n : INTEGER);"
 113         "  END Real;"
 114         ""
 115         "  PROCEDURE LongReal*(x : LONGREAL; n : INTEGER);"
 116         "  END LongReal;"
 117         ""
 118         "  PROCEDURE Ln*;"
 119         "  END Ln;"
 120         ""
 121         "END Out."
 122 ;
 123
 124 static oberon_context_t * ctx;
 125 static oberon_module_t * mod;
 126
 127 static const char *
 128 import_module(const char * name)
 129 {
 130         if(strcmp(name, "Test") == 0)
 131         {
 132                 return source_test;
 133         }
 134         else if(strcmp(name, "Out") == 0)
 135         {
 136                 return source_out;
 137         }
 138         else
 139         {
 140                 return NULL;
 141         }
 142 }
 143
 144 typedef void (*TOutOpen)();
 145 static TOutOpen * OutOpenPtr;
 146 void ImplOutOpen()
 147 {
 148 }
 149
 150 typedef void (*TOutInt)(int, int);
 151 static TOutInt * OutIntPtr;
 152 void ImplOutInt(int i, int n)
 153 {
 154         char number[22];
 155         snprintf(number, 22, "%d", i);
 156         int len = strlen(number);
 157         for(int i = 0; i < n - len; i++)
 158         {
 159                 putchar(' ');
 160         }
 161         printf("%s", number);
 162 }
 163
 164 typedef void (*TOutReal)(float, int);
 165 static TOutReal * OutRealPtr;
 166 void ImplOutReal(float i, int n)
 167 {
 168         char number[32];
 169         snprintf(number, 32, "%F", i);
 170         int len = strlen(number);
 171         for(int i = 0; i < n - len; i++)
 172         {
 173                 putchar(' ');
 174         }
 175         printf("%s", number);
 176 }
 177
 178 typedef void (*TOutLn)();
 179 static TOutLn * OutLnPtr;
 180 void ImplOutLn()
 181 {
 182         putchar('\n');
 183 }
 184
 185 void init_system_modules()
 186 {
 187         OutOpenPtr = oberon_generator_get_var(ctx, "Out_Open");
 188         *OutOpenPtr = ImplOutOpen;
 189         OutIntPtr = oberon_generator_get_var(ctx, "Out_Int");
 190         *OutIntPtr = ImplOutInt;
 191         OutRealPtr = oberon_generator_get_var(ctx, "Out_Real");
 192         *OutRealPtr = ImplOutReal;
 193         OutLnPtr = oberon_generator_get_var(ctx, "Out_Ln");
 194         *OutLnPtr = ImplOutLn;
 195 }
 196
 197 void start_module()
 198 {
 199         void (*begin)() = oberon_generator_get_procedure(ctx, "Test_BEGIN");
 200         begin();
 201 }
 202
 203 int
 204 main(int argc, char ** argv)
 205 {
 206         ctx = oberon_create_context(import_module);
 207         mod = oberon_compile_module(ctx, source_test);
 208
 209         oberon_generate_code(ctx);
 210
 211 //      init_system_modules();
 212
 213 //      oberon_generator_dump(ctx, "dump.txt");
 214
 215 //      start_module();
 216
 217         oberon_destroy_context(ctx);
 218         return 0;
 219 }