test.c

   1 #include "oberon.h"
   2 #include "generator.h"
   3
   4 #include <string.h>
   5 #include <assert.h>
   6
   7 static char source_test[] =
   8         "(* Main module *)"
   9         "MODULE Test;"
  10         "IMPORT Out;"
  11         ""
  12         "VAR"
  13         "  nx- : INTEGER;"
  14         "  p : POINTER TO ARRAY 3 OF INTEGER;"
  15         ""
  16         "PROCEDURE ChParam(VAR i : INTEGER);"
  17         "BEGIN"
  18         "  i := 1234;"
  19         "END ChParam;"
  20         ""
  21         "BEGIN;"
  22         "  NEW(p);"
  23         "  p[0] := 1;"
  24         "  "
  25         "  Out.Open;"
  26         "  ChParam(nx);"
  27         "  Out.Int(nx, 0);"
  28         "  Out.Ln;"
  29         "END Test."
  30 ;
  31
  32 static char source_out[] =
  33         "MODULE Out;"
  34         "(* Interface to outer program ;) *)"
  35         "VAR"
  36         "  Open-     : PROCEDURE;"
  37 //      "  Char-     : PROCEDURE(ch : CHAR);"
  38 //      "  String-   : PROCEDURE(str : ARRAY OF CHAR)"
  39 //      "  Int-      : PROCEDURE(i, n : LONGINT);"
  40         "  Int-      : PROCEDURE(i, n : INTEGER);"
  41 //      "  Real-     : PROCEDURE(x : REAL; n : INTEGER);"
  42 //      "  LongReal- : PROCEDURE(x : LONGREAL; n : INTEGER);"
  43         "  Ln-       : PROCEDURE;"
  44         "END Out."
  45 ;
  46
  47 static oberon_context_t * ctx;
  48 static oberon_module_t * mod;
  49
  50 static const char *
  51 import_module(const char * name)
  52 {
  53         if(strcmp(name, "Test") == 0)
  54         {
  55                 return source_test;
  56         }
  57         else if(strcmp(name, "Out") == 0)
  58         {
  59                 return source_out;
  60         }
  61         else
  62         {
  63                 return NULL;
  64         }
  65 }
  66
  67 typedef void (*TOutOpen)();
  68 static TOutOpen * OutOpenPtr;
  69 void ImplOutOpen()
  70 {
  71 }
  72
  73 typedef void (*TOutInt)(int, int);
  74 static TOutInt * OutIntPtr;
  75 void ImplOutInt(int i, int n)
  76 {
  77         char number[22];
  78         snprintf(number, 22, "%i", i);
  79         int len = strlen(number);
  80         for(int i = 0; i < n - len; i++)
  81         {
  82                 putchar(' ');
  83         }
  84         printf("%s", number);
  85 }
  86
  87 typedef void (*TOutLn)();
  88 static TOutLn * OutLnPtr;
  89 void ImplOutLn()
  90 {
  91         putchar('\n');
  92 }
  93
  94 void init_system_modules()
  95 {
  96         OutOpenPtr = oberon_generator_get_var(ctx, "Out_Open");
  97         *OutOpenPtr = ImplOutOpen;
  98         OutIntPtr = oberon_generator_get_var(ctx, "Out_Int");
  99         *OutIntPtr = ImplOutInt;
 100         OutLnPtr = oberon_generator_get_var(ctx, "Out_Ln");
 101         *OutLnPtr = ImplOutLn;
 102 }
 103
 104 void start_module()
 105 {
 106         void (*begin)() = oberon_generator_get_procedure(ctx, "Test_BEGIN");
 107         begin();
 108 }
 109
 110 int
 111 main(int argc, char ** argv)
 112 {
 113         ctx = oberon_create_context(import_module);
 114         mod = oberon_compile_module(ctx, source_test);
 115
 116         oberon_generate_code(ctx);
 117
 118         init_system_modules();
 119
 120         oberon_generator_dump(ctx, "dump.txt");
 121
 122         start_module();
 123
 124         oberon_destroy_context(ctx);
 125         return 0;
 126 }