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