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