src/test.c

   1 #include <stdio.h>
   2 #include <string.h>
   3 #include <assert.h>
   4
   5 #include "../include/oberon.h"
   6
   7 /*
   8 static char source_test[] =
   9         "(* Main module *)"
  10         "MODULE Test;"
  11         "IMPORT Out;"
  12         "VAR"
  13         "  msg : ARRAY 20 OF CHAR;"
  14         "BEGIN"
  15         "  msg := ''"
  16         "END Test."
  17 ;
  18 */
  19
  20 static char source_test[] =
  21         "(* Main module *)"
  22         "MODULE Test;"
  23         "IMPORT Out;"
  24         "CONST"
  25         "  helloworld = 'Hello World!';"
  26         "  null = 0X;"
  27         "  space = 020X;"
  28         "  bang = 021X;"
  29         "  h = 048X;"
  30         "  e = 045X;"
  31         "  l = 04CX;"
  32         "  o = 04FX;"
  33         "  w = 057X;"
  34         "  r = 052X;"
  35         "  d = 044X;"
  36         ""
  37         "TYPE"
  38         "  Ident = ARRAY 20 OF CHAR;"
  39         "  PrintString = PROCEDURE (str : ARRAY OF CHAR);"
  40         ""
  41         "VAR"
  42         "  msg   : Ident;"
  43         "  print : PrintString;"
  44         ""
  45         "BEGIN"
  46         "  msg := helloworld;"
  47         "  print := Out.String;"
  48         "  Out.Open;"
  49         "  print(msg);"
  50         "  Out.Ln;"
  51         "  print(\"It's works!\");"
  52         "  Out.Ln;"
  53         "END Test."
  54 ;
  55
  56 static char source_out[] =
  57         "MODULE Out;"
  58         "  PROCEDURE Open*;"
  59         "  END Open;"
  60         ""
  61         "  PROCEDURE Char* (ch : CHAR);"
  62         "  END Char;"
  63         ""
  64         "  PROCEDURE String* (str : ARRAY OF CHAR);"
  65         "  END String;"
  66         ""
  67         "  PROCEDURE Int*(i, n : LONGINT);"
  68         "  END Int;"
  69         ""
  70         "  PROCEDURE Real*(x : REAL; n : INTEGER);"
  71         "  END Real;"
  72         ""
  73         "  PROCEDURE LongReal*(x : LONGREAL; n : INTEGER);"
  74         "  END LongReal;"
  75         ""
  76         "  PROCEDURE Ln*;"
  77         "  END Ln;"
  78         ""
  79         "END Out."
  80 ;
  81
  82 static oberon_context_t * ctx;
  83 static oberon_module_t * mod;
  84
  85 static const char *
  86 import_module(const char * name)
  87 {
  88         if(strcmp(name, "Test") == 0)
  89         {
  90                 return source_test;
  91         }
  92         else if(strcmp(name, "Out") == 0)
  93         {
  94                 return source_out;
  95         }
  96         else
  97         {
  98                 return NULL;
  99         }
 100 }
 101
 102 typedef void (*TOutOpen)();
 103 static TOutOpen * OutOpenPtr;
 104 void ImplOutOpen()
 105 {
 106 }
 107
 108 typedef void (*TOutInt)(int, int);
 109 static TOutInt * OutIntPtr;
 110 void ImplOutInt(int i, int n)
 111 {
 112         char number[22];
 113         snprintf(number, 22, "%d", i);
 114         int len = strlen(number);
 115         for(int i = 0; i < n - len; i++)
 116         {
 117                 putchar(' ');
 118         }
 119         printf("%s", number);
 120 }
 121
 122 typedef void (*TOutReal)(float, int);
 123 static TOutReal * OutRealPtr;
 124 void ImplOutReal(float i, int n)
 125 {
 126         char number[32];
 127         snprintf(number, 32, "%F", i);
 128         int len = strlen(number);
 129         for(int i = 0; i < n - len; i++)
 130         {
 131                 putchar(' ');
 132         }
 133         printf("%s", number);
 134 }
 135
 136 typedef void (*TOutLn)();
 137 static TOutLn * OutLnPtr;
 138 void ImplOutLn()
 139 {
 140         putchar('\n');
 141 }
 142
 143 void init_system_modules()
 144 {
 145         OutOpenPtr = oberon_generator_get_var(ctx, "Out_Open");
 146         *OutOpenPtr = ImplOutOpen;
 147         OutIntPtr = oberon_generator_get_var(ctx, "Out_Int");
 148         *OutIntPtr = ImplOutInt;
 149         OutRealPtr = oberon_generator_get_var(ctx, "Out_Real");
 150         *OutRealPtr = ImplOutReal;
 151         OutLnPtr = oberon_generator_get_var(ctx, "Out_Ln");
 152         *OutLnPtr = ImplOutLn;
 153 }
 154
 155 void start_module()
 156 {
 157         void (*begin)() = oberon_generator_get_procedure(ctx, "Test_BEGIN");
 158         begin();
 159 }
 160
 161 int
 162 main(int argc, char ** argv)
 163 {
 164         ctx = oberon_create_context(import_module);
 165         mod = oberon_compile_module(ctx, source_test);
 166
 167         oberon_generate_code(ctx);
 168
 169 //      init_system_modules();
 170
 171 //      oberon_generator_dump(ctx, "dump.txt");
 172
 173 //      start_module();
 174
 175         oberon_destroy_context(ctx);
 176         return 0;
 177 }