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