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