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