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