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