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