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