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