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