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