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