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