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