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