oberon.c

   1 #include <stdio.h>
   2 #include <stdlib.h>
   3 #include <stdarg.h>
   4 #include <ctype.h>
   5 #include <string.h>
   6
   7 #include "oberon.h"
   8 #include "generator.h"
   9
  10 enum {
  11         EOF_ = 0,
  12         IDENT,
  13         MODULE,
  14         SEMICOLON,
  15         END,
  16         DOT,
  17         VAR,
  18         COLON,
  19         BEGIN,
  20         ASSIGN,
  21         INTEGER,
  22         TRUE,
  23         FALSE,
  24         LPAREN,
  25         RPAREN,
  26         EQUAL,
  27         NEQ,
  28         LESS,
  29         LEQ,
  30         GREAT,
  31         GEQ,
  32         PLUS,
  33         MINUS,
  34         OR,
  35         STAR,
  36         SLASH,
  37         DIV,
  38         MOD,
  39         AND,
  40         NOT,
  41         PROCEDURE
  42 };
  43
  44 // =======================================================================
  45 //   UTILS
  46 // =======================================================================
  47
  48 void
  49 oberon_error(oberon_context_t * ctx, const char * fmt, ...)
  50 {
  51         va_list ptr;
  52         va_start(ptr, fmt);
  53         fprintf(stderr, "error: ");
  54         vfprintf(stderr, fmt, ptr);
  55         fprintf(stderr, "\n");
  56         fprintf(stderr, "  code_index = %i\n", ctx -> code_index);
  57         fprintf(stderr, "  c          = %c\n", ctx -> c);
  58         fprintf(stderr, "  token      = %i\n", ctx -> token);
  59         va_end(ptr);
  60         exit(1);
  61 }
  62
  63 // =======================================================================
  64 //   TABLE
  65 // =======================================================================
  66
  67 static oberon_type_t *
  68 oberon_find_type(oberon_context_t * ctx, char * name)
  69 {
  70         oberon_type_t * x = ctx -> types;
  71         while(x -> next && strcmp(x -> next -> name, name) != 0)
  72         {
  73                 x = x -> next;
  74         }
  75
  76         return x -> next;
  77 }
  78
  79 static oberon_var_t *
  80 oberon_find_var(oberon_context_t * ctx, char * name)
  81 {
  82         oberon_var_t * x = ctx -> mod -> vars;
  83         while(x -> next && strcmp(x -> next -> name, name) != 0)
  84         {
  85                 x = x -> next;
  86         }
  87
  88         return x -> next;
  89 }
  90
  91 static void
  92 oberon_define_var(oberon_context_t * ctx, char * name, oberon_type_t * type)
  93 {
  94         oberon_var_t * x = ctx -> mod -> vars;
  95         while(x -> next && strcmp(x -> next -> name, name) != 0)
  96         {
  97                 x = x -> next;
  98         }
  99
 100         if(x -> next)
 101         {
 102                 oberon_error(ctx, "already defined");
 103         }
 104
 105         oberon_var_t * newvar = malloc(sizeof *newvar);
 106         memset(newvar, 0, sizeof *newvar);
 107         newvar -> name = name;
 108         newvar -> type = type;
 109         oberon_generator_init_var(ctx, newvar);
 110
 111         x -> next = newvar;
 112 }
 113
 114 // =======================================================================
 115 //   SCANER
 116 // =======================================================================
 117
 118 static void
 119 oberon_get_char(oberon_context_t * ctx)
 120 {
 121         ctx -> code_index += 1;
 122         ctx -> c = ctx -> code[ctx -> code_index];
 123 }
 124
 125 static void
 126 oberon_init_scaner(oberon_context_t * ctx, const char * code)
 127 {
 128         ctx -> code = code;
 129         ctx -> code_index = 0;
 130         ctx -> c = ctx -> code[ctx -> code_index];
 131 }
 132
 133 static void
 134 oberon_read_ident(oberon_context_t * ctx)
 135 {
 136         int len = 0;
 137         int i = ctx -> code_index;
 138
 139         int c = ctx -> code[i];
 140         while(isalnum(c))
 141         {
 142                 i += 1;
 143                 len += 1;
 144                 c = ctx -> code[i];
 145         }
 146
 147         char * ident = malloc(len + 1);
 148         memcpy(ident, &ctx->code[ctx->code_index], len);
 149         ident[len] = 0;
 150
 151         ctx -> code_index = i;
 152         ctx -> c = ctx -> code[i];
 153         ctx -> string = ident;
 154         ctx -> token = IDENT;
 155
 156         if(strcmp(ident, "MODULE") == 0)
 157         {
 158                 ctx -> token = MODULE;
 159         }
 160         else if(strcmp(ident, "END") == 0)
 161         {
 162                 ctx -> token = END;
 163         }
 164         else if(strcmp(ident, "VAR") == 0)
 165         {
 166                 ctx -> token = VAR;
 167         }
 168         else if(strcmp(ident, "BEGIN") == 0)
 169         {
 170                 ctx -> token = BEGIN;
 171         }
 172         else if(strcmp(ident, "TRUE") == 0)
 173         {
 174                 ctx -> token = TRUE;
 175         }
 176         else if(strcmp(ident, "FALSE") == 0)
 177         {
 178                 ctx -> token = FALSE;
 179         }
 180         else if(strcmp(ident, "OR") == 0)
 181         {
 182                 ctx -> token = OR;
 183         }
 184         else if(strcmp(ident, "DIV") == 0)
 185         {
 186                 ctx -> token = DIV;
 187         }
 188         else if(strcmp(ident, "MOD") == 0)
 189         {
 190                 ctx -> token = MOD;
 191         }
 192         else if(strcmp(ident, "PROCEDURE") == 0)
 193         {
 194                 ctx -> token = PROCEDURE;
 195         }
 196 }
 197
 198 static void
 199 oberon_read_integer(oberon_context_t * ctx)
 200 {
 201         int len = 0;
 202         int i = ctx -> code_index;
 203
 204         int c = ctx -> code[i];
 205         while(isdigit(c))
 206         {
 207                 i += 1;
 208                 len += 1;
 209                 c = ctx -> code[i];
 210         }
 211
 212         char * ident = malloc(len + 2);
 213         memcpy(ident, &ctx->code[ctx->code_index], len);
 214         ident[len + 1] = 0;
 215
 216         ctx -> code_index = i;
 217         ctx -> c = ctx -> code[i];
 218         ctx -> string = ident;
 219         ctx -> integer = atoi(ident);
 220         ctx -> token = INTEGER;
 221 }
 222
 223 static void
 224 oberon_skip_space(oberon_context_t * ctx)
 225 {
 226         while(isspace(ctx -> c))
 227         {
 228                 oberon_get_char(ctx);
 229         }
 230 }
 231
 232 static void
 233 oberon_read_symbol(oberon_context_t * ctx)
 234 {
 235         int c = ctx -> c;
 236         switch(c)
 237         {
 238                 case 0:
 239                         ctx -> token = EOF_;
 240                         break;
 241                 case ';':
 242                         ctx -> token = SEMICOLON;
 243                         oberon_get_char(ctx);
 244                         break;
 245                 case ':':
 246                         ctx -> token = COLON;
 247                         oberon_get_char(ctx);
 248                         if(ctx -> c == '=')
 249                         {
 250                                 ctx -> token = ASSIGN;
 251                                 oberon_get_char(ctx);
 252                         }
 253                         break;
 254                 case '.':
 255                         ctx -> token = DOT;
 256                         oberon_get_char(ctx);
 257                         break;
 258                 case '(':
 259                         ctx -> token = LPAREN;
 260                         oberon_get_char(ctx);
 261                         break;
 262                 case ')':
 263                         ctx -> token = RPAREN;
 264                         oberon_get_char(ctx);
 265                         break;
 266                 case '=':
 267                         ctx -> token = EQUAL;
 268                         oberon_get_char(ctx);
 269                         break;
 270                 case '#':
 271                         ctx -> token = NEQ;
 272                         oberon_get_char(ctx);
 273                         break;
 274                 case '<':
 275                         ctx -> token = LESS;
 276                         oberon_get_char(ctx);
 277                         if(ctx -> c == '=')
 278                         {
 279                                 ctx -> token = LEQ;
 280                                 oberon_get_char(ctx);
 281                         }
 282                         break;
 283                 case '>':
 284                         ctx -> token = GREAT;
 285                         oberon_get_char(ctx);
 286                         if(ctx -> c == '=')
 287                         {
 288                                 ctx -> token = GEQ;
 289                                 oberon_get_char(ctx);
 290                         }
 291                         break;
 292                 case '+':
 293                         ctx -> token = PLUS;
 294                         oberon_get_char(ctx);
 295                         break;
 296                 case '-':
 297                         ctx -> token = MINUS;
 298                         oberon_get_char(ctx);
 299                         break;
 300                 case '*':
 301                         ctx -> token = STAR;
 302                         oberon_get_char(ctx);
 303                         break;
 304                 case '/':
 305                         ctx -> token = SLASH;
 306                         oberon_get_char(ctx);
 307                         break;
 308                 case '&':
 309                         ctx -> token = AND;
 310                         oberon_get_char(ctx);
 311                         break;
 312                 case '~':
 313                         ctx -> token = NOT;
 314                         oberon_get_char(ctx);
 315                         break;
 316                 default:
 317                         oberon_error(ctx, "invalid char");
 318                         break;
 319         }
 320 }
 321
 322 static void
 323 oberon_read_token(oberon_context_t * ctx)
 324 {
 325         oberon_skip_space(ctx);
 326
 327         int c = ctx -> c;
 328         if(isalpha(c))
 329         {
 330                 oberon_read_ident(ctx);
 331         }
 332         else if(isdigit(c))
 333         {
 334                 oberon_read_integer(ctx);
 335         }
 336         else
 337         {
 338                 oberon_read_symbol(ctx);
 339         }
 340 }
 341
 342 // =======================================================================
 343 //   EXPRESSION
 344 // =======================================================================
 345
 346 static void oberon_expect_token(oberon_context_t * ctx, int token);
 347 static oberon_expr_t * oberon_expr(oberon_context_t * ctx);
 348 static void oberon_assert_token(oberon_context_t * ctx, int token);
 349 static char * oberon_assert_ident(oberon_context_t * ctx);
 350
 351 static oberon_expr_t *
 352 oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right)
 353 {
 354         oberon_oper_t * operator;
 355         operator = malloc(sizeof *operator);
 356         memset(operator, 0, sizeof *operator);
 357
 358         operator -> is_item = 0;
 359         operator -> result = result;
 360         operator -> op = op;
 361         operator -> left = left;
 362         operator -> right = right;
 363
 364         return (oberon_expr_t *) operator;
 365 }
 366
 367 static oberon_expr_t *
 368 oberon_new_item(int mode, oberon_type_t * result)
 369 {
 370         oberon_item_t * item;
 371         item = malloc(sizeof *item);
 372         memset(item, 0, sizeof *item);
 373
 374         item -> is_item = 1;
 375         item -> result = result;
 376         item -> mode = mode;
 377
 378         return (oberon_expr_t *)item;
 379 }
 380
 381 static oberon_expr_t *
 382 oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a)
 383 {
 384         oberon_expr_t * expr;
 385         oberon_type_t * result;
 386
 387         result = a -> result;
 388
 389         if(token == MINUS)
 390         {
 391                 if(result -> class != OBERON_TYPE_INTEGER)
 392                 {
 393                         oberon_error(ctx, "incompatible operator type");
 394                 }
 395
 396                 expr = oberon_new_operator(OP_UNARY_MINUS, result, a, NULL);
 397         }
 398         else if(token == NOT)
 399         {
 400                 if(result -> class != OBERON_TYPE_BOOLEAN)
 401                 {
 402                         oberon_error(ctx, "incompatible operator type");
 403                 }
 404
 405                 expr = oberon_new_operator(OP_LOGIC_NOT, result, a, NULL);
 406         }
 407         else
 408         {
 409                 oberon_error(ctx, "oberon_make_unary_op: wat");
 410         }
 411
 412         return expr;
 413 }
 414
 415 static oberon_expr_t *
 416 oberon_factor(oberon_context_t * ctx)
 417 {
 418         char * name;
 419         oberon_var_t * var;
 420         oberon_expr_t * expr;
 421
 422         switch(ctx -> token)
 423         {
 424                 case IDENT:
 425                         name = oberon_assert_ident(ctx);
 426                         var = oberon_find_var(ctx, name);
 427                         if(var == NULL)
 428                         {
 429                                 oberon_error(ctx, "undefined variable %s", name);
 430                         }
 431                         expr = oberon_new_item(MODE_VAR, var -> type);
 432                         expr -> item.var = var;
 433                         break;
 434                 case INTEGER:
 435                         expr = oberon_new_item(MODE_INTEGER, ctx -> int_type);
 436                         expr -> item.integer = ctx -> integer;
 437                         oberon_assert_token(ctx, INTEGER);
 438                         break;
 439                 case TRUE:
 440                         expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type);
 441                         expr -> item.boolean = 1;
 442                         oberon_assert_token(ctx, TRUE);
 443                         break;
 444                 case FALSE:
 445                         expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type);
 446                         expr -> item.boolean = 0;
 447                         oberon_assert_token(ctx, FALSE);
 448                         break;
 449                 case LPAREN:
 450                         oberon_assert_token(ctx, LPAREN);
 451                         expr = oberon_expr(ctx);
 452                         oberon_assert_token(ctx, RPAREN);
 453                         break;
 454                 case NOT:
 455                         oberon_assert_token(ctx, NOT);
 456                         expr = oberon_factor(ctx);
 457                         expr = oberon_make_unary_op(ctx, NOT, expr);
 458                         break;
 459                 default:
 460                         oberon_error(ctx, "invalid expression");
 461         }
 462
 463         return expr;
 464 }
 465
 466 /*
 467  * oberon_autocast_binary_op автоматически переобразовывеат тип по след. правилам:
 468  *   1. Классы обоих типов должны быть одинаковы
 469  *   2. В качестве результата должен быть выбран больший тип.
 470  *   3. Если размер результат не должен быть меньше чем базовый int
 471  */
 472
 473 static void
 474 oberon_autocast_binary_op(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t * b, oberon_type_t ** result)
 475 {
 476         if((a -> class) != (b -> class))
 477         {
 478                 oberon_error(ctx, "incompatible types");
 479         }
 480
 481         if((a -> size) > (b -> size))
 482         {
 483                 *result = a;
 484         }
 485         else
 486         {
 487                 *result = b;
 488         }
 489
 490         if(((*result) -> class) == OBERON_TYPE_INTEGER)
 491         {
 492                 if(((*result) -> size) < (ctx -> int_type -> size))
 493                 {
 494                         *result = ctx -> int_type;
 495                 }
 496         }
 497
 498         /* TODO: cast types */
 499 }
 500
 501 #define ITMAKESBOOLEAN(x) \
 502         (((x) >= EQUAL && (x) <= GEQ) || ((x) == OR) || ((x) == AND))
 503
 504 #define ITUSEONLYINTEGER(x) \
 505         ((x) >= LESS && (x) <= GEQ)
 506
 507 #define ITUSEONLYBOOLEAN(x) \
 508         (((x) == OR) || ((x) == AND))
 509
 510 static oberon_expr_t *
 511 oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
 512 {
 513         oberon_expr_t * expr;
 514         oberon_type_t * result;
 515
 516         oberon_autocast_binary_op(ctx, a -> result, b -> result, &result);
 517
 518         if(ITMAKESBOOLEAN(token))
 519         {
 520                 if(ITUSEONLYINTEGER(token))
 521                 {
 522                         if(a -> result -> class != OBERON_TYPE_INTEGER
 523                                 && b -> result -> class != OBERON_TYPE_INTEGER)
 524                         {
 525                                 oberon_error(ctx, "used only with integer types");
 526                         }
 527                 }
 528                 else if(ITUSEONLYBOOLEAN(token))
 529                 {
 530                         if(a -> result -> class != OBERON_TYPE_BOOLEAN
 531                                 && b -> result -> class != OBERON_TYPE_BOOLEAN)
 532                         {
 533                                 oberon_error(ctx, "used only with boolean type");
 534                         }
 535                 }
 536
 537                 if(token == EQUAL)
 538                 {
 539                         expr = oberon_new_operator(OP_EQ, result, a, b);
 540                 }
 541                 else if(token == NEQ)
 542                 {
 543                         expr = oberon_new_operator(OP_NEQ, result, a, b);
 544                 }
 545                 else if(token == LESS)
 546                 {
 547                         expr = oberon_new_operator(OP_LSS, result, a, b);
 548                 }
 549                 else if(token == LEQ)
 550                 {
 551                         expr = oberon_new_operator(OP_LEQ, result, a, b);
 552                 }
 553                 else if(token == GREAT)
 554                 {
 555                         expr = oberon_new_operator(OP_GRT, result, a, b);
 556                 }
 557                 else if(token == GEQ)
 558                 {
 559                         expr = oberon_new_operator(OP_GEQ, result, a, b);
 560                 }
 561                 else if(token == OR)
 562                 {
 563                         expr = oberon_new_operator(OP_LOGIC_OR, result, a, b);
 564                 }
 565                 else if(token == AND)
 566                 {
 567                         expr = oberon_new_operator(OP_LOGIC_AND, result, a, b);
 568                 }
 569                 else
 570                 {
 571                         oberon_error(ctx, "oberon_make_bin_op: bool wat");
 572                 }
 573         }
 574         else
 575         {
 576                 if(token == PLUS)
 577                 {
 578                         expr = oberon_new_operator(OP_ADD, result, a, b);
 579                 }
 580                 else if(token == MINUS)
 581                 {
 582                         expr = oberon_new_operator(OP_SUB, result, a, b);
 583                 }
 584                 else if(token == STAR)
 585                 {
 586                         expr = oberon_new_operator(OP_MUL, result, a, b);
 587                 }
 588                 else if(token == SLASH)
 589                 {
 590                         expr = oberon_new_operator(OP_DIV, result, a, b);
 591                 }
 592                 else if(token == DIV)
 593                 {
 594                         expr = oberon_new_operator(OP_DIV, result, a, b);
 595                 }
 596                 else if(token == MOD)
 597                 {
 598                         expr = oberon_new_operator(OP_MOD, result, a, b);
 599                 }
 600                 else
 601                 {
 602                         oberon_error(ctx, "oberon_make_bin_op: bin wat");
 603                 }
 604         }
 605
 606         return expr;
 607 }
 608
 609 #define ISMULOP(x) \
 610         ((x) >= STAR && (x) <= AND)
 611
 612 static oberon_expr_t *
 613 oberon_term_expr(oberon_context_t * ctx)
 614 {
 615         oberon_expr_t * expr;
 616
 617         expr = oberon_factor(ctx);
 618         while(ISMULOP(ctx -> token))
 619         {
 620                 int token = ctx -> token;
 621                 oberon_read_token(ctx);
 622
 623                 oberon_expr_t * inter = oberon_factor(ctx);
 624                 expr = oberon_make_bin_op(ctx, token, expr, inter);
 625         }
 626
 627         return expr;
 628 }
 629
 630 #define ISADDOP(x) \
 631         ((x) >= PLUS && (x) <= OR)
 632
 633 static oberon_expr_t *
 634 oberon_simple_expr(oberon_context_t * ctx)
 635 {
 636         oberon_expr_t * expr;
 637
 638         int minus = 0;
 639         if(ctx -> token == PLUS)
 640         {
 641                 minus = 0;
 642                 oberon_assert_token(ctx, PLUS);
 643         }
 644         else if(ctx -> token == MINUS)
 645         {
 646                 minus = 1;
 647                 oberon_assert_token(ctx, MINUS);
 648         }
 649
 650         expr = oberon_term_expr(ctx);
 651         while(ISADDOP(ctx -> token))
 652         {
 653                 int token = ctx -> token;
 654                 oberon_read_token(ctx);
 655
 656                 oberon_expr_t * inter = oberon_term_expr(ctx);
 657                 expr = oberon_make_bin_op(ctx, token, expr, inter);
 658         }
 659
 660         if(minus)
 661         {
 662                 expr = oberon_make_unary_op(ctx, MINUS, expr);
 663         }
 664
 665         return expr;
 666 }
 667
 668 #define ISRELATION(x) \
 669         ((x) >= EQUAL && (x) <= GEQ)
 670
 671 static oberon_expr_t *
 672 oberon_expr(oberon_context_t * ctx)
 673 {
 674         oberon_expr_t * expr;
 675
 676         expr = oberon_simple_expr(ctx);
 677         while(ISRELATION(ctx -> token))
 678         {
 679                 int token = ctx -> token;
 680                 oberon_read_token(ctx);
 681
 682                 oberon_expr_t * inter = oberon_simple_expr(ctx);
 683                 expr = oberon_make_bin_op(ctx, token, expr, inter);
 684         }
 685
 686         return expr;
 687 }
 688
 689 // =======================================================================
 690 //   PARSER
 691 // =======================================================================
 692
 693 static void oberon_statement_seq(oberon_context_t * ctx);
 694
 695 static void
 696 oberon_expect_token(oberon_context_t * ctx, int token)
 697 {
 698         if(ctx -> token != token)
 699         {
 700                 oberon_error(ctx, "unexpected token %i (%i)", ctx -> token, token);
 701         }
 702 }
 703
 704 static void
 705 oberon_assert_token(oberon_context_t * ctx, int token)
 706 {
 707         oberon_expect_token(ctx, token);
 708         oberon_read_token(ctx);
 709 }
 710
 711 static char *
 712 oberon_assert_ident(oberon_context_t * ctx)
 713 {
 714         oberon_expect_token(ctx, IDENT);
 715         char * ident = ctx -> string;
 716         oberon_read_token(ctx);
 717         return ident;
 718 }
 719
 720 static oberon_type_t *
 721 oberon_type(oberon_context_t * ctx)
 722 {
 723         char * name = oberon_assert_ident(ctx);
 724         oberon_type_t * type = oberon_find_type(ctx, name);
 725
 726         if(type == NULL)
 727         {
 728                 oberon_error(ctx, "undefined type");
 729         }
 730
 731         return type;
 732 }
 733
 734 static void
 735 oberon_var_decl(oberon_context_t * ctx)
 736 {
 737         char * name = oberon_assert_ident(ctx);
 738         oberon_assert_token(ctx, COLON);
 739         oberon_type_t * type = oberon_type(ctx);
 740         oberon_define_var(ctx, name, type);
 741 }
 742
 743 static void
 744 oberon_make_procedure_begin(oberon_context_t * ctx, char * name)
 745 {
 746
 747 }
 748
 749 static void
 750 oberon_make_procedure_end(oberon_context_t * ctx)
 751 {
 752
 753 }
 754
 755 static void
 756 oberon_proc_decl(oberon_context_t * ctx)
 757 {
 758         oberon_assert_token(ctx, PROCEDURE);
 759
 760         char * name;
 761         name = oberon_assert_ident(ctx);
 762
 763         oberon_assert_token(ctx, SEMICOLON);
 764
 765         oberon_make_procedure_begin(ctx, name);
 766         if(ctx -> token == BEGIN)
 767         {
 768                 oberon_assert_token(ctx, BEGIN);
 769                 oberon_statement_seq(ctx);
 770         }
 771         oberon_make_procedure_end(ctx);
 772
 773         oberon_assert_token(ctx, END);
 774         char * name2 = oberon_assert_ident(ctx);
 775
 776         if(strcmp(name2, name) != 0)
 777         {
 778                 oberon_error(ctx, "procedure name not matched");
 779         }
 780 }
 781
 782 static void
 783 oberon_decl_seq(oberon_context_t * ctx)
 784 {
 785         if(ctx -> token == VAR)
 786         {
 787                 oberon_assert_token(ctx, VAR);
 788                 while(ctx -> token == IDENT)
 789                 {
 790                         oberon_var_decl(ctx);
 791                         oberon_assert_token(ctx, SEMICOLON);
 792                 }
 793         }
 794
 795         if(ctx -> token == PROCEDURE)
 796         {
 797                 oberon_proc_decl(ctx);
 798                 oberon_assert_token(ctx, SEMICOLON);
 799         }
 800 }
 801
 802 static void
 803 oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 804 {
 805         if(src -> result -> class != dst -> result -> class)
 806         {
 807                 oberon_error(ctx, "incompatible assignment types");
 808         }
 809
 810         if(dst -> result -> class == OBERON_TYPE_INTEGER)
 811         {
 812                 if((dst -> result -> size) < (src -> result -> size))
 813                 {
 814                         oberon_error(ctx, "incompatible assignment type size");
 815                 }
 816         }
 817
 818         oberon_generate_assign(ctx, src, dst);
 819 }
 820
 821 static void
 822 oberon_statement(oberon_context_t * ctx)
 823 {
 824         oberon_expr_t * item1;
 825         oberon_expr_t * item2;
 826
 827         if(ctx -> token == IDENT)
 828         {
 829                 item1 = oberon_expr(ctx);
 830                 oberon_assert_token(ctx, ASSIGN);
 831                 item2 = oberon_expr(ctx);
 832                 oberon_assign(ctx, item2, item1);
 833         }
 834 }
 835
 836 static void
 837 oberon_statement_seq(oberon_context_t * ctx)
 838 {
 839         oberon_statement(ctx);
 840         while(ctx -> token == SEMICOLON)
 841         {
 842                 oberon_assert_token(ctx, SEMICOLON);
 843                 oberon_statement(ctx);
 844         }
 845 }
 846
 847 static void
 848 oberon_parse_module(oberon_context_t * ctx)
 849 {
 850         char *name1, *name2;
 851         oberon_read_token(ctx);
 852
 853         oberon_assert_token(ctx, MODULE);
 854         name1 = oberon_assert_ident(ctx);
 855         oberon_assert_token(ctx, SEMICOLON);
 856         ctx -> mod -> name = name1;
 857
 858         oberon_decl_seq(ctx);
 859
 860         if(ctx -> token == BEGIN)
 861         {
 862                 oberon_assert_token(ctx, BEGIN);
 863                 oberon_generate_begin_module(ctx);
 864                 oberon_statement_seq(ctx);
 865                 oberon_generate_end_module(ctx);
 866         }
 867
 868         oberon_assert_token(ctx, END);
 869         name2 = oberon_assert_ident(ctx);
 870         oberon_assert_token(ctx, DOT);
 871
 872         if(strcmp(name1, name2) != 0)
 873         {
 874                 oberon_error(ctx, "module name not matched");
 875         }
 876 }
 877
 878 // =======================================================================
 879 //   LIBRARY
 880 // =======================================================================
 881
 882 static oberon_type_t *
 883 oberon_register_global_type_ret(oberon_context_t * ctx, oberon_type_t * type)
 884 {
 885         oberon_type_t * x = ctx -> types;
 886         while(x -> next && strcmp(x -> next -> name, type -> name) != 0)
 887         {
 888                 x = x -> next;
 889         }
 890
 891         if(x -> next)
 892         {
 893                 oberon_error(ctx, "already defined");
 894         }
 895
 896         // TODO: copy type name (not a pointer)
 897         oberon_type_t * newtype = malloc(sizeof *newtype);
 898         memcpy(newtype, type, sizeof *newtype);
 899         newtype -> next = NULL;
 900         oberon_generator_init_type(ctx, newtype);
 901
 902         x -> next = newtype;
 903         return newtype;
 904 }
 905
 906 static void
 907 register_default_types(oberon_context_t * ctx)
 908 {
 909         static oberon_type_t integer = { "INTEGER", OBERON_TYPE_INTEGER, sizeof(int) };
 910         static oberon_type_t boolean = { "BOOLEAN", OBERON_TYPE_BOOLEAN, sizeof(int) };
 911
 912         ctx -> int_type = oberon_register_global_type_ret(ctx, &integer);
 913         ctx -> bool_type = oberon_register_global_type_ret(ctx, &boolean);
 914 }
 915
 916 void
 917 oberon_register_global_type(oberon_context_t * ctx, oberon_type_t * type)
 918 {
 919         oberon_register_global_type_ret(ctx, type);
 920 }
 921
 922 oberon_context_t *
 923 oberon_create_context()
 924 {
 925         oberon_context_t * ctx = malloc(sizeof *ctx);
 926         memset(ctx, 0, sizeof *ctx);
 927
 928         oberon_type_t * types = malloc(sizeof *types);
 929         memset(types, 0, sizeof *types);
 930         ctx -> types = types;
 931
 932         oberon_generator_init_context(ctx);
 933
 934         register_default_types(ctx);
 935
 936         return ctx;
 937 }
 938
 939 void
 940 oberon_destroy_context(oberon_context_t * ctx)
 941 {
 942         oberon_generator_destroy_context(ctx);
 943         free(ctx);
 944 }
 945
 946 oberon_module_t *
 947 oberon_compile_module(oberon_context_t * ctx, const char * code)
 948 {
 949         oberon_module_t * mod = malloc(sizeof *mod);
 950         memset(mod, 0, sizeof *mod);
 951         oberon_var_t * vars = malloc(sizeof *vars);
 952         memset(vars, 0, sizeof *vars);
 953         ctx -> mod = mod;
 954         ctx -> mod -> vars = vars;
 955
 956         oberon_init_scaner(ctx, code);
 957         oberon_parse_module(ctx);
 958
 959         oberon_generate_code(ctx);
 960         return mod;
 961 }
 962