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