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