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